tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR1.scl

   1 import "Prelude"\r
   2 \r
   3 slowSum :: [Integer] -> <Proc> Integer\r
   4 slowSum list = getRef answer\r
   5   where\r
   6     answer = ref 0\r
   7     \r
   8     constraint El Integer\r
   9     \r
  10     ?x <- list => El ?x\r
  11     -El ?x, -El ?y => El (?x + ?y)\r
  12     El ?x => answer := ?x\r
  13     \r
  14 main = slowSum [1,6,9]\r
  15 --\r
  16 16\r
  17 --\r
  18 import "Prelude"\r
  19 \r
  20 slowGcd :: [Integer] -> <Proc> Integer\r
  21 slowGcd list = getRef answer\r
  22   where\r
  23     answer = ref 0\r
  24   \r
  25     constraint Gcd Integer\r
  26     \r
  27     ?x <- list                => Gcd ?x\r
  28     -Gcd 0                    => True\r
  29     -Gcd ?m, Gcd ?n, ?n <= ?m => Gcd (?m `mod` ?n)\r
  30     Gcd ?answer               => answer := ?answer\r
  31     \r
  32 main = slowGcd [12,20]\r
  33 --\r
  34 4\r
  35 --\r
  36 import "Prelude"\r
  37 \r
  38 isReachable :: [(Integer,Integer)] -> Integer -> Integer -> <Proc> Boolean\r
  39 isReachable edges a b = getRef answer\r
  40   where\r
  41     answer = ref False\r
  42     \r
  43     constraint Edge Integer Integer\r
  44     constraint Reachable Integer\r
  45     \r
  46     (?x,?y) <- edges => Edge ?x ?y\r
  47     True => Reachable a\r
  48     Reachable ?x, Edge ?x ?y => Reachable ?y\r
  49     Reachable b => answer := True\r
  50 \r
  51 graph :: [(Integer, Integer)]\r
  52 graph = [(0,1), (1,2), (2,3), (4,5)]\r
  53 \r
  54 main = (isReachable graph 0 3, isReachable graph 0 5)\r
  55 --\r
  56 (true,false)\r
  57 --\r
  58 import "StandardLibrary"\r
  59 \r
  60 primes1 limit = MList.freeze answer\r
  61   where\r
  62     answer = MList.create ()\r
  63     MList.add answer 2\r
  64     \r
  65     constraint Prime Integer\r
  66     constraint PrimeCandidate Integer\r
  67     \r
  68     True => PrimeCandidate 3\r
  69     -PrimeCandidate ?x, ?x > limit => True\r
  70     -PrimeCandidate ?x, Prime ?y, ?x `mod` ?y = 0 => PrimeCandidate (?x + 2)\r
  71     -PrimeCandidate ?x => MList.add answer ?x, Prime ?x, PrimeCandidate (?x + 2)\r
  72 \r
  73 main = primes1 30\r
  74 --\r
  75 [2, 3, 5, 7, 11, 13, 17, 19, 23, 29]\r
  76 --\r
  77 import "StandardLibrary"\r
  78 \r
  79 powersOfTwo n = sort (MList.freeze answer)\r
  80   where\r
  81     answer = MList.create ()\r
  82   \r
  83     constraint N Integer\r
  84     \r
  85     ?i <- [1..n] => N 1\r
  86     -N ?x, -N ?x => N (2*?x)\r
  87     N ?x => MList.add answer ?x\r
  88     \r
  89 main = powersOfTwo 25\r
  90 --\r
  91 [1, 8, 16]\r
  92 --\r
  93 import "StandardLibrary"\r
  94 \r
  95 main = MList.freeze answer\r
  96   where\r
  97     answer = MList.create ()\r
  98     add = MList.add answer\r
  99   \r
 100     constraint A\r
 101     constraint B\r
 102     constraint C\r
 103   \r
 104     A => add "A1"\r
 105     B => add "B1"\r
 106     C => add "C1"\r
 107     A => add "A2"\r
 108     B => add "B2"\r
 109     C => add "C2"\r
 110     \r
 111     True => A\r
 112     -A => B\r
 113     -B => C\r
 114 --\r
 115 [A1, A2, B1, B2, C1, C2] \r
 116 --\r
 117 import "StandardLibrary"\r
 118 \r
 119 graph = [("1","2"), ("2","3"), ("3","4"), ("3","5"), ("1","4"), ("5","5")]\r
 120 \r
 121 main = sort (MList.freeze answer)\r
 122   where\r
 123     answer = MList.create ()\r
 124   \r
 125     constraint Init\r
 126     constraint Edge String String\r
 127     constraint Degree String Integer\r
 128   \r
 129     True => Init\r
 130     (?x, ?y) <- graph => Edge ?x ?y\r
 131   \r
 132     Init, Edge ?x ?y => Degree ?x 1, Degree ?y 1\r
 133     Init, -Degree ?x ?a, -Degree ?x ?b => Degree ?x (?a + ?b)\r
 134     -Init => True\r
 135 \r
 136     -Degree ?x 0 => print "Remove node \(?x)"\r
 137     -Degree ?x ?a, -Edge ?x ?x => Degree ?x (?a - 2), print "Remove loop (\(?x),\(?x))"\r
 138     -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
 139     -Degree ?y 2, -Edge ?x ?y, -Edge ?y ?z => Edge ?x ?z, print "Simplify path (\(?x),\(?y),\(?z))"\r
 140     \r
 141     Edge ?x ?y => MList.add answer (?x, ?y)\r
 142 --\r
 143 [(1,4), (1,4)]\r
 144 --\r
 145 import "StandardLibrary"\r
 146 \r
 147 uniq :: [a] -> <Proc> [a]\r
 148 uniq l = MList.freeze answer\r
 149   where\r
 150     answer = MList.create ()\r
 151     \r
 152     constraint El a\r
 153     ?x <- l => El ?x\r
 154     -El ?x, El ?x => True\r
 155     El ?x => MList.add answer ?x\r
 156     \r
 157 main = sort $ uniq [1,1,2,2,3]\r
 158 --\r
 159 [1, 2, 3]