Merged changes from feature/scl to master.

[simantics/platform.git] / tests / org.simantics.scl.compiler.tests / src / org / simantics / scl / compiler / tests / scl / CHR1.scl

diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR1.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR1.scl
new file mode 100644 (file)
index 0000000..90ea90a
--- /dev/null
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR1.scl
@@ -0,0 +1,159 @@
+import "Prelude"\r
+\r
+slowSum :: [Integer] -> <Proc> Integer\r
+slowSum list = getRef answer\r
+  where\r
+    answer = ref 0\r
+    \r
+    constraint El Integer\r
+    \r
+    ?x <- list => El ?x\r
+    -El ?x, -El ?y => El (?x + ?y)\r
+    El ?x => answer := ?x\r
+    \r
+main = slowSum [1,6,9]\r
+--\r
+16\r
+--\r
+import "Prelude"\r
+\r
+slowGcd :: [Integer] -> <Proc> Integer\r
+slowGcd list = getRef answer\r
+  where\r
+    answer = ref 0\r
+  \r
+    constraint Gcd Integer\r
+    \r
+    ?x <- list                => Gcd ?x\r
+    -Gcd 0                    => True\r
+    -Gcd ?m, Gcd ?n, ?n <= ?m => Gcd (?m `mod` ?n)\r
+    Gcd ?answer               => answer := ?answer\r
+    \r
+main = slowGcd [12,20]\r
+--\r
+4\r
+--\r
+import "Prelude"\r
+\r
+isReachable :: [(Integer,Integer)] -> Integer -> Integer -> <Proc> Boolean\r
+isReachable edges a b = getRef answer\r
+  where\r
+    answer = ref False\r
+    \r
+    constraint Edge Integer Integer\r
+    constraint Reachable Integer\r
+    \r
+    (?x,?y) <- edges => Edge ?x ?y\r
+    True => Reachable a\r
+    Reachable ?x, Edge ?x ?y => Reachable ?y\r
+    Reachable b => answer := True\r
+\r
+graph :: [(Integer, Integer)]\r
+graph = [(0,1), (1,2), (2,3), (4,5)]\r
+\r
+main = (isReachable graph 0 3, isReachable graph 0 5)\r
+--\r
+(true,false)\r
+--\r
+import "StandardLibrary"\r
+\r
+primes1 limit = MList.freeze answer\r
+  where\r
+    answer = MList.create ()\r
+    MList.add answer 2\r
+    \r
+    constraint Prime Integer\r
+    constraint PrimeCandidate Integer\r
+    \r
+    True => PrimeCandidate 3\r
+    -PrimeCandidate ?x, ?x > limit => True\r
+    -PrimeCandidate ?x, Prime ?y, ?x `mod` ?y = 0 => PrimeCandidate (?x + 2)\r
+    -PrimeCandidate ?x => MList.add answer ?x, Prime ?x, PrimeCandidate (?x + 2)\r
+\r
+main = primes1 30\r
+--\r
+[2, 3, 5, 7, 11, 13, 17, 19, 23, 29]\r
+--\r
+import "StandardLibrary"\r
+\r
+powersOfTwo n = sort (MList.freeze answer)\r
+  where\r
+    answer = MList.create ()\r
+  \r
+    constraint N Integer\r
+    \r
+    ?i <- [1..n] => N 1\r
+    -N ?x, -N ?x => N (2*?x)\r
+    N ?x => MList.add answer ?x\r
+    \r
+main = powersOfTwo 25\r
+--\r
+[1, 8, 16]\r
+--\r
+import "StandardLibrary"\r
+\r
+main = MList.freeze answer\r
+  where\r
+    answer = MList.create ()\r
+    add = MList.add answer\r
+  \r
+    constraint A\r
+    constraint B\r
+    constraint C\r
+  \r
+    A => add "A1"\r
+    B => add "B1"\r
+    C => add "C1"\r
+    A => add "A2"\r
+    B => add "B2"\r
+    C => add "C2"\r
+    \r
+    True => A\r
+    -A => B\r
+    -B => C\r
+--\r
+[A1, A2, B1, B2, C1, C2] \r
+--\r
+import "StandardLibrary"\r
+\r
+graph = [("1","2"), ("2","3"), ("3","4"), ("3","5"), ("1","4"), ("5","5")]\r
+\r
+main = sort (MList.freeze answer)\r
+  where\r
+    answer = MList.create ()\r
+  \r
+    constraint Init\r
+    constraint Edge String String\r
+    constraint Degree String Integer\r
+  \r
+    True => Init\r
+    (?x, ?y) <- graph => Edge ?x ?y\r
+  \r
+    Init, Edge ?x ?y => Degree ?x 1, Degree ?y 1\r
+    Init, -Degree ?x ?a, -Degree ?x ?b => Degree ?x (?a + ?b)\r
+    -Init => True\r
+\r
+    -Degree ?x 0 => print "Remove node \(?x)"\r
+    -Degree ?x ?a, -Edge ?x ?x => Degree ?x (?a - 2), print "Remove loop (\(?x),\(?x))"\r
+    -Degree ?x ?a, -Edge ?x ?y, -Degree ?y ?b, (?a==1 || ?b==1) => Degree ?x (?a - 1), Degree ?y (?b - 1), print "Remove dangling edge (\(?x),\(?y))"\r
+    -Degree ?y 2, -Edge ?x ?y, -Edge ?y ?z => Edge ?x ?z, print "Simplify path (\(?x),\(?y),\(?z))"\r
+    \r
+    Edge ?x ?y => MList.add answer (?x, ?y)\r
+--\r
+[(1,4), (1,4)]\r
+--\r
+import "StandardLibrary"\r
+\r
+uniq :: [a] -> <Proc> [a]\r
+uniq l = MList.freeze answer\r
+  where\r
+    answer = MList.create ()\r
+    \r
+    constraint El a\r
+    ?x <- l => El ?x\r
+    -El ?x, El ?x => True\r
+    El ?x => MList.add answer ?x\r
+    \r
+main = sort $ uniq [1,1,2,2,3]\r
+--\r
+[1, 2, 3]
\ No newline at end of file