Commit 42dd5dcb authored by Michael Hanus 's avatar Michael Hanus
Browse files

CHR library and examples packaged

parents
*~
.cpm
.curry
Copyright (c) 2017, Michael Hanus
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the names of the copyright holders nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
chr-curry
=========
This package contains a library `CHR` which provides an implementation of
Constraint Handling Rules in Curry, an interpreter for CHR rules based
on the refined operational semantics of Duck et al. (ICLP 2004),
and a compiler into CHR(Prolog).
To use CHR(Curry), specify the CHR(Curry) rules in a Curry program,
load it, add module `CHR` and interpret or compile the rules
with `runCHR` or `compileCHR`, respectively. This can be done
in one shot with
> cpm curry :l MyRules :add CHR :eval 'compileCHR "MyCHR" [rule1,rule2]' :q
The directory `examples` contains various CHR(Curry) example programs.
Documentation
-------------
The structure and implementation of the CHR library is described
in the following paper:
M. Hanus:
CHR(Curry): Interpretation and Compilation of Constraint Handling Rules in Curry
Proc. of the 17th International Symposium on Practical Aspects of
Declarative Languages (PADL 2015)
Springer LNCS 9131, pp. 74-89, 2015
[Online](http://dx.doi.org/10.1007/978-3-319-19686-2_6)
----------------------------------------------------------------------
--- CHR(Curry): Boolean constraint solver
---
--- @author Michael Hanus
--- @version February 2015
----------------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns -Wno-missing-signatures #-}
import CHR
----------------------------------------------------------------------
-- Boolean constraints:
data BoolCHR = And Bool Bool Bool | Or Bool Bool Bool | Neg Bool Bool
and = toGoal3 And
or = toGoal3 Or
neg = toGoal2 Neg
andRules =
[\[x,y,z] -> and x y z <=> x .=. False |> z .=. False
,\[x,y,z] -> and x y z <=> y .=. False |> z .=. False
,\[x,y,z] -> and x y z <=> x .=. True |> y .=. z
,\[x,y,z] -> and x y z <=> y .=. True |> x .=. z
,\[x,y,z] -> and x y z <=> z .=. True |> x .=. True /\ y .=. True
,\[x,y,z] -> and x y z <=> x .=. y |> y .=. z
]
orRules =
[\[x,y,z] -> or x y z <=> x .=. False |> z .=. y
,\[x,y,z] -> or x y z <=> y .=. False |> z .=. x
,\[x,y,z] -> or x y z <=> x .=. True |> z .=. True
,\[x,y,z] -> or x y z <=> y .=. True |> z .=. True
,\[x,y,z] -> or x y z <=> z .=. False |> x .=. False /\ y .=. False
,\[x,y,z] -> or x y z <=> x .=. y |> y .=. z]
negRules =
[\[x] -> neg False x <=> x .=. True
,\[x] -> neg x False <=> x .=. True
,\[x] -> neg True x <=> x .=. False
,\[x] -> neg x True <=> x .=. False
,\[x] -> neg x x <=> fail
]
boolRules = andRules ++ orRules ++ negRules
main20 x y z = runCHR boolRules $ and x y z /\ neg False z --> x=y=z=True
-- Application: half adder:
halfAdder a b s c = andCHR [or a b ab, and a b c, neg c nc, and ab nc s]
where ab,nc free
-- Analyze inputs for carry bit:
main21 a b s c = runCHR boolRules (halfAdder a b s c /\ c .=. True)
main22 a b s c = runCHR boolRules (halfAdder a b s c /\ c .=. False)
----------------------------------------------------------------------
----------------------------------------------------------------------
--- CHR(Curry): finite domain constraints
---
--- This example also shows how operations defined in Curry can be used
--- as primitive constraints in CHR(Curry)
---
--- @author Michael Hanus
--- @version February 2015
----------------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns -Wno-missing-signatures #-}
import CHR
import qualified List
----------------------------------------------------------------------
-- Finite domain constraints in CHR (influence from SWI-Prolog manual)
data FDom = Dom Int [Int] | Diff Int Int
dom = toGoal2 Dom
diff = toGoal2 Diff
intersect xs ys zs = anyPrim (\() -> zs =:= List.intersect xs ys)
delete x ys zs = anyPrim $ \() -> zs =:= List.delete x ys
member x xs = anyPrim $ \() -> contains x xs
where contains z (y:ys) = z=:=y ? contains z ys
-- Rules for `dom` constraint:
dom1 [x] = dom x [] <=> fail
dom2 [x,y] = dom x [y] <=> x .=. y
dom3 [x] = dom x xs <=> nonvar x |> member x xs where xs free
dom4 [x] = dom x d1 /\ dom x d2 <=> intersect d1 d2 d3 /\ dom x d3
where d1,d2,d3 free
-- Rules for `diff` constraint:
diff1 [x] = diff x x <=> fail
diff2 [x,y] = diff x y <=> nonvar x /\ nonvar y |> x ./=. y
diff3 [x,y] = diff x y /\ dom x d1 <=> nonvar y |> delete y d1 d2 /\ dom x d2
where d1,d2 free
diff4 [x,y] = diff y x /\ dom x d1 <=> nonvar y |> delete y d1 d2 /\ dom x d2
where d1,d2 free
-- Define domains for a list of variables:
domain :: [Int] -> Int -> Int -> Goal Int FDom
domain xs a b = allCHR (\x -> dom x [a .. b]) xs
-- Define allDifferent constraint for list of arguments:
allDifferent :: [Int] -> Goal Int FDom
allDifferent = andCHR . allDiff
where
allDiff [] = []
allDiff (x:xs) = map (diff x) xs ++ allDiff xs
-- Labeling: if constraints contain (Dom x d), then add the disjunction
-- of (x .=. v), for all values v in d, and solve again.
labeling :: (Goal Int FDom -> [FDom]) -> Goal Int FDom -> [FDom]
labeling solver goal = tryLabeling model
where
model = solver goal -- compute model without labeling
tryLabeling [] = model
tryLabeling (y:ys) = case y of
Dom x d -> labeling solver (eqDom x d /\ chrsToGoal model)
_ -> tryLabeling ys
eqDom x xs = foldr1 (?) (map (\d -> x .=. d) xs)
runFD1 = runCHR [dom1,dom2,dom3,dom4]
runFD2 = runCHR [dom1,dom2,dom3,dom4,diff1,diff2,diff3,diff4]
main50 x y = runFD1 $ dom x [1] /\ dom y [1,2] /\ x .=. y --> x=y=1
main51 x = runFD1 $ dom x [1,2,3] /\ dom x [3,4,5] --> x=3
main52 [x,y,z] = runFD1 $ domain [x,y,z] 1 3 /\ x .=. y /\ y .=. z /\ y .=. 2
main53 [x,y,z] = labeling runFD2 $ domain [x,y,z] 1 3 /\ allDifferent [x,y,z]
-- Map coloring:
{-
This is our actual map:
--------------------------
| | |
| |--------| |
| | L2 | |
| L1 |--------| L4 |
| | | |
| | L3 | |
| | | |
--------------------------
-}
main55 [l1,l2,l3,l4] = labeling runFD2 $
domain [l1,l2,l3,l4] 1 4 /\
diff l1 l4 /\ diff l1 l2 /\ diff l1 l3 /\ diff l2 l3 /\
diff l2 l4 /\ diff l3 l4 /\ l2 .=. 3 -- fix color of L2
compileFD = compileCHR "FDCHR" [dom1,dom2,dom3,dom4,diff1,diff2,diff3,diff4]
----------------------------------------------------------------------
--- CHR(Curry): using CHR to compute Fibonacci numbers with tabling
---
--- @author Michael Hanus
--- @version February 2015
----------------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns -Wno-missing-signatures #-}
import CHR
----------------------------------------------------------------------
-- Fibonacci constraints (from Duck et al, ICLP 2004)
-- Note that we use an explicit addition constraint for adding
-- the result when smaller Fibonacci numbers are computed.
data Fib = Fib Int Int
| Add Int Int Int -- for adding results when available
fib = toGoal2 Fib
add = toGoal3 Add
fibo1 [n,f] = fib n f <=> n .<=. 1 |> f .=. 1
fibo2 [n,f0,f] = fib n f0 \\ fib n f <=> n .>=. 2 |> f .=. f0
fibo3 [n,f,f1,f2] = fib n f ==> n .>=. 2 |>
fib (n-2) f1 /\ fib (n-1) f2 /\ add f1 f2 f
addrule [x,y,z] = add x y z <=> ground x /\ ground y |> z .=. x+y
runFib1 = runCHR [fibo1,fibo2,fibo3,addrule]
main40 x = runFib1 $ fib 7 x --> x=21
dup [n,f1,f2] = fib n f1 \\ fib n f2 <=> f1 .=. f2
fib1 [n,f] = fib n f <=> n .<=. 1 |> f .=. 1
fibn [n,f,f1,f2] = fib n f ==> n .>=. 2 |>
fib (n-2) f1 /\ fib (n-1) f2 /\ add f1 f2 f
runFib2 = runCHR [dup,fib1,fibn,addrule]
main41 x = runFib2 $ fib 7 x --> x=21
compileFib = compileCHR "FIBCHR" [fibo1,fibo2,fibo3,addrule]
-- solveCHR $ fib 20 x where x free
----------------------------------------------------------------------
--- CHR(Curry): use CHR to compute the greatest common divisor
---
--- @author Michael Hanus
--- @version February 2015
----------------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns -Wno-missing-signatures #-}
import CHR
----------------------------------------------------------------------
-- gcd constraints (from Duck et al, ICLP 2004)
-- see also http://chr.informatik.uni-ulm.de/~webchr/
data GCD = GCD Int | GCDanswer Int
gcd = toGoal1 GCD
gcdanswer = toGoal1 GCDanswer
gcda [n,x] = gcd 0 /\ gcd n /\ gcdanswer x <=> x .=. n
gcd1 [] = gcd 0 <=> true
gcd2 [m,n] = gcd n \\ gcd m <=> m .>=. n |> gcd (m-n)
-- Note that we can use functional syntax here!
runGCD = runCHR [gcd1,gcd2]
main30 = runGCD $ gcd 16 /\ gcd 28 --> gcd 4
main31 = runGCD $ gcd 206 /\ gcd 40 --> gcd 2
----------------------------------------------------------------------
compileGCD = compileCHR "GCDCHR" [gcda,gcd2]
-- solveCHR $ gcdanswer x /\ gcd 206 /\ gcd 40 where x free
----------------------------------------------------------------------
--- CHR(Curry): solving linear arithmetic equations with Gaussian elimination
---
--- @author Michael Hanus
--- @version February 2015
----------------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns -Wno-missing-signatures #-}
import CHR
import Float
import Sort(mergeSortBy)
import Unsafe(compareAnyTerm)
infix 7 :*:
infixr 6 :+:
infix 5 :=:
----------------------------------------------------------------------
-- Gaussian elimination to solve linear equalities
type Poly = [(Float,Float)] -- a polynom is a list of (coeff,variable)
data Gauss = Equals Poly Float
| ArithOp (Float->Float->Float) Float Float Float
-- Notational abbreviations:
(:*:) :: Float -> Float -> Poly
a :*: x = [(a,x)]
(:+:) :: Poly -> Poly -> Poly
p :+: q = p ++ q
-- CHR constraints:
(:=:) = toGoal2 Equals
arithop = toGoal4 ArithOp
plus = arithop (+.)
mult = arithop (*.)
-- Specific primitive constraints:
-- Find and delete some element in a list.
select x xs zs = anyPrim $ \() -> del xs zs
where
del (y:p) q = (y =:= x & q =:= p)
? (let q1 free in del p q1 & q =:= y:q1)
-- Multiply a polynomial p with a constant c.
polyMult c p q = anyPrim $ \() -> q =:= map (\ (a,x) -> (a*.c,x)) p
-- Add two polynomials
polyAdd ps qs rs = anyPrim $ \() ->
let ops = mergeSortBy (\ (_,x) (_,y) -> compareAnyTerm x y /= GT) ps
oqs = mergeSortBy (\ (_,x) (_,y) -> compareAnyTerm x y /= GT) qs
in rs =:= addP ops oqs
where
addP [] ys = ys
addP (x:xs) [] = x:xs
addP ((i,x):xs) ((j,y):ys)
| compareAnyTerm x y == EQ = (i+.j,x) : addP xs ys
| compareAnyTerm x y == LT = (i,x) : addP xs ((j,y):ys)
| otherwise = (j,y) : addP ((i,x):xs) ys
-- CHR rules:
-- main rule: eliminate a term in a polynomial:
eliminate [a,x,c1,c2,b,c,c1c,c3] = let p,p1,p2,p1c,p3 free in
((a,x):p1) :=: c1 \\ p :=: c2 <=> select (b,x) p p2 |>
c .=. 0.0 -. b /. a /\
mult c1 c c1c /\ polyMult c p1 p1c /\
plus c1c c2 c3 /\ polyAdd p2 p1c p3 /\
p3 :=: c3
-- remove constant monomials:
constM [a,x,c] = let p,q free in
p :=: c <=> select (a,x) p q /\ nonvar x |> q :=: (c -. a *. x)
-- empty polynomials have zero value:
emptyP [c] = [] :=: c <=> c .=. 0.0
-- bind a variable if unique:
bindVar [a,x,c] = [(a,x)] :=: c <=> x .=. c /. a
-- Simplify arithmetic relations:
arithrule [x,y,z] = arithop op x y z <=> nonvar x /\ nonvar y |>
z .=. x `op` y
where op free
runGauss = runCHR [arithrule,emptyP,constM,eliminate,bindVar]
main80 x y = runGauss $ 3:*:x :=: 6 /\ 2:*:x :+: 6:*:y :=: 10.0
main81 x y = runGauss $
1.0:*:x :+: 1.0:*:y :=: 7.0 /\ 1.0:*:x :+: (-1.0):*:y :=: 3.0
main82 x y = runGauss $
1.0:*:x :+: (-1.0):*:y :=: 0.0 /\ 1.0:*:x :+: 1.0:*:y :=: 4.0
main83 x = runGauss $ 2:*:x :+: 4:*:2 :=: 10.0
-- Application: circuit analysis:
data Circuit = Resistor Float
| Series Circuit Circuit
| Parallel Circuit Circuit
cvi :: Circuit -> Float -> Float -> Goal Float Gauss
cvi (Resistor r) v i = r :*: i :+: (-1) :*: v :=: 0
cvi (Series c1 c2) v i = let v1,v2 free in
cvi c1 v1 i /\ cvi c2 v2 i /\ 1:*:v1 :+: 1:*:v2 :+: (-1):*:v :=: 0
cvi (Parallel c1 c2) v i = let i1,i2 free in
cvi c1 v i1 /\ cvi c2 v i2 /\ 1:*:i1 :+: 1:*:i2 :+: (-1):*:i :=: 0
main85 i = runGauss $ cvi (Series (Resistor 180) (Resistor 470)) 5 i
-- i=0.007692307692307692
main86 i = runGauss $ cvi (Parallel (Resistor 180) (Resistor 470)) 5 i
-- i=0.038416075650118
----------------------------------------------------------------------
compileGauss = compileCHR "GAUSSCHR" [arithrule,emptyP,constM,eliminate,bindVar]
-- [(3.0,x)] :=: 6.0 /\ [(2.0,x),(6.0,y)] :=: 10.0
--> x=2.0, y=1.0
----------------------------------------------------------------------
--- CHR(Curry): the classical Leq example
---
--- @author Michael Hanus
--- @version February 2015
----------------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns -Wno-missing-signatures #-}
import CHR
----------------------------------------------------------------------
-- Leq constraints:
data LEQ a = Leq a a
leq = toGoal2 Leq
reflexivity [x,y] = leq x y <=> x .=. y |> true
antisymmetry [x,y] = leq x y /\ leq y x <=> x .=. y
idempotence [x,y] = leq x y \\ leq x y <=> true
transitivity [x,y,z] = leq x y /\ leq y z ==> leq x z
-- This rule can be used to solve leq on known ground values:
leqval [x,y] = leq x y <=> ground x /\ ground y |> x .<=. y
runLEQ = runCHR [reflexivity,antisymmetry,idempotence,transitivity]
main10 x = runLEQ $ leq 1 x /\ leq x 1
main11 x y z = runLEQ $ leq x y /\ leq y z /\ leq z x
main12 x y z z' = runLEQ $ leq x y /\ leq z z'
compileLeq =
compileCHR "LEQCHR" [reflexivity,antisymmetry,idempotence,transitivity]
----------------------------------------------------------------------
--- CHR(Curry): use CHR to compute prime numbers
---
--- Advantage compared to CHR(Prolog): natural functional notation
---
--- @author Michael Hanus
--- @version February 2015
----------------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns -Wno-missing-signatures #-}
import CHR
----------------------------------------------------------------------
-- Prime numbers
-- http://chr.informatik.uni-ulm.de/~webchr/cgi-bin/program.cgi?load=functions/primes1.pl
data Prime = Prime Int
prime = toGoal1 Prime
primeFail [n] = prime n <=> n .<=. 1 |> fail
primeGen [n] = prime n ==> n .>=. 3 |> prime (n-1)
primeSift [x,y] = prime x \\ prime y <=> y `mod` x .=. 0 |> true
runPrime = runCHR [primeFail,primeGen,primeSift]
main70 = runPrime $ prime 20
Loading program "Leq"...
main10 x
{x=1} []
main11 x y z
{x=x, y=x, z=x} []
main12 x y z z'
{x=x, y=y, z=z, z'=z'} [Leq z z',Leq x y]
Loading program "Bool"...
main20 x y z
{x=True, y=True, z=True} []
main21 a b s c
{a=True, b=True, s=False, c=True} []
main22 a b s c
{a=a, b=b, s=s, c=False} [And a b False,Or a b s]
Loading program "GCD"...
runGCD $ ((gcd 16) /\ (gcd 28))
[GCD 4]
runGCD $ ((gcd 206) /\ (gcd 40))
[GCD 2]
compileCHR "GCDCHR" [gcda,gcd2]
Curry interface to CHR(Prolog) written to GCDCHR.curry
Loading program "GCDCHR"...
solveCHR $ ((gcdanswer x) /\ ((gcd 206) /\ (gcd 40)))
{x=2} True
Loading program "Fib"...
(runCHR [dup,fib1,fibn,addrule]) $ ((fib 7) x)
{x=21} [Fib 7 21,Fib 4 5,Fib 2 2,Fib 3 3,Fib 5 8,Fib 6 13]
compileCHR "FIBCHR" [fibo1,fibo2,fibo3,addrule]
Curry interface to CHR(Prolog) written to FIBCHR.curry
Loading program "FIBCHR"...
solveCHR $ (fib 20 x)
{x=10946} True
Loading program "FD"...
main50 x y
{x=1, y=1} []
main51 x
{x=3} []
main52 [x,y,z]
{x=2, y=2, z=2} []
main53 xs
{xs=[2,3,1]} []
{xs=[3,2,1]} []
{xs=[1,3,2]} []
{xs=[3,1,2]} []
{xs=[1,2,3]} []
{xs=[2,1,3]} []
main55 xs
{xs=[4,3,2,1]} []
{xs=[2,3,4,1]} []
{xs=[4,3,1,2]} []
{xs=[1,3,4,2]} []
{xs=[2,3,1,4]} []
{xs=[1,3,2,4]} []
Loading program "UnionFind"...
main60
[Root 1,Arrow 2 1,Root 4,Root 3]
main61 x
{x=1} [Root 4,Root 3,Arrow 2 1,Root 1]
main62 x y
{x=1, y=3} [Root 4,Arrow 2 1,Arrow 1 3,Root 3]
main63
[Root 5,Arrow 3 5,Arrow 4 3,Root 1,Arrow 2 1]
main64 x y
{x=1, y=5} [Root 1,Arrow 2 1,Arrow 4 3,Arrow 3 5,Root 5]
main65 x y
{x='a', y='e'} [Root 'a',Arrow 'b' 'a',Arrow 'd' 'c',Arrow 'c' 'e',Root 'e']
compileCHR "UFCHR" [makeI,unionI,findNode,findRoot,linkEq,linkTo]
Curry interface to CHR(Prolog) written to UFCHR.curry
Loading program "UFCHR"...
solveCHR $ (andCHR [make 1,make 2,make 3,make 4,make 5,union 1 2,union 3 4,union 5 3,find 2 x,find 4 y])
{x=1, y=5} True
Loading program "Primes"...
runPrime $ (prime 20)
[Prime 2,Prime 19,Prime 17,Prime 3,Prime 13,Prime 11,Prime 7,Prime 5]
Loading program "Gauss"...
main80 x y
{x=2.0, y=1.0} []
main81 x y
{x=5.0, y=2.0} []
main82 x y
{x=2.0, y=2.0} []
main85 i
{i=0.007692307692307692} []
main86 i
{i=0.0384160756501182} []
compileCHR "GAUSSCHR" [arithrule,emptyP,constM,eliminate,bindVar]
Curry interface to CHR(Prolog) written to GAUSSCHR.curry
Loading program "GAUSSCHR"...
solveCHR $ (((3.0 :*: x) :=: 6.0) /\ (((2.0 :*: x) :+: (6.0 :*: y)) :=: 10.0))
{x=2.0, y=1.0} True
----------------------------------------------------------------------
--- CHR(Curry): union-find algorithm in CHR
---
--- @author Michael Hanus
--- @version February 2015
----------------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns -Wno-missing-signatures #-}
import CHR
----------------------------------------------------------------------
-- Naive union-find algorithm (according to Schrijvers/Fruehwirth TPLP 2006)
-- Advantage to Prolog CHR: polymorphic type-safe rules!
data UF a = Root a | Arrow a a -- data structure
| Make a | Union a a | Find a a | Link a a -- operations
root = toGoal1 Root
make = toGoal1 Make
(~>) = toGoal2 Arrow
union = toGoal2 Union
find = toGoal2 Find
link = toGoal2 Link
makeI [a] = make a <=> root a
unionI [a,b,x,y] = union a b <=> find a x /\ find b y /\ link x y
findNode [a,b,x] = a ~> b \\ find a x <=> find b x
findRoot [a,x] = root a \\ find a x <=> x .=. a
linkEq [a] = link a a <=> true
linkTo [a,b] = link a b /\ root a /\ root b <=> b ~> a /\ root a
runUF = runCHR [makeI,unionI,findNode,findRoot,linkEq,linkTo]
main60 = runUF $ andCHR [make 1, make 2, make 3, make 4, union 1 2]
--> [Root 1,Arrow 2 1,Root 4,Root 3]
main61 x = runUF $ andCHR [2 ~> 1,root 1,root 4,root 3, find 2 x] --> x=1
main62 x y = runUF $ andCHR [2 ~> 1,root 1,root 4,root 3, find 2 x,
union 3 2, find 2 y]
--> x=1, y=3
main63 = runUF $ andCHR [make 1, make 2, make 3, make 4, make 5,
union 1 2, union 3 4, union 5 3]
main64 x y = runUF $ andCHR
[make 1, make 2, make 3, make 4, make 5,
union 1 2, union 3 4, union 5 3, find 2 x, find 4 y] --> x=1, y=5
-- union/find on character elements:
main65 x y =
runUF $ andCHR $ map make "abcde" ++
[union 'a' 'b', union 'c' 'd', union 'e' 'c',
find 'b' x, find 'd' y] --> x='a', y='e'
compileUF = compileCHR "UFCHR" [makeI,unionI,findNode,findRoot,linkEq,linkTo]
-- solveCHR $ andC [make 1, make 2, make 3, make 4, make 5, union 1 2, union 3 4, union 5 3, find 2 x, find 4 y]
--> x=1, y=5
#!/bin/sh
# Shell script to test the current set of CHR(Curry) examples
# Root location of the Curry System specified by variable CURRYROOT
CURRYROOT=`$CURRYBIN :set v0 :set -time :add Distribution :eval "putStrLn installDir" :quit`
CURRYBINDIR=$CURRYROOT/bin