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

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