Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
80 lines (57 sloc) 2.04 KB
using dict;
nonfix nil;
var c = {c};
isvar = matrixp;
walk key state = if isvar key && member state key
then walk (state ! key) state else key;
emptystate = (emptyhdict, 0);
mzero = [];
unit x = [x];
unify _ _ nil = nil;
unify left right state = case (walk left state, walk right state) of
(l, r) = state if (isvar l) && (isvar r) && (l == r);
(l, r) = update state l r if isvar l;
(l, r) = update state r l if isvar r;
((l:ls), (r:rs)) = unify ls rs (unify l r state);
(l, r) = state if l == r;
_ = nil;
end;
infixl (==) ?==;
l ?== r = \(state, counter) -> case unify l r state of
nil = mzero;
state = unit (state, counter);
end;
callfresh f = \(state, counter) -> (f (var counter)) (state, counter + 1);
mplus [] stream2 = stream2;
mplus (head:tail) stream2 = head:((mplus stream2 tail)&);
bind [] goal = mzero;
bind (head:tail) goal = mplus (goal head) ((bind tail goal)&);
infixl (||) ?||;
goal1 ?|| goal2 = \(s,c) -> mplus (goal1 (s,c)) (goal2 (s,c));
infixl (&&) ?&&;
goal1 ?&& goal2 = \(s,c) -> bind (goal1 (s,c)) goal2;
callgoal goal = goal emptystate;
pull n goal = list (take n (callgoal goal));
// fives x = x ?== 5 ?|| (\sc -> (fives x sc)&);
// sixes x = x ?== 6 ?|| (\sc -> (sixes x sc)&);
// fivesandsixes = callfresh (\x -> (fives x ?|| sixes x));
// callgoal 4 $ fivesandsixes;
// Above should yield {0}=>5 and {0}=>6 alternatingly.
nonfix fresh;
infixr 10 in;
def fresh (v:[]) in body = callfresh (__lambda__ [v] body);
def fresh (v:vs) in body = callfresh (__lambda__ [v] (fresh vs in body));
Zzz g = \sc -> ((g sc)&);
walk_ v s = case walk v s of
(v:vs) = (walk_ v s) : (walk_ vs s);
v = v;
end;
reify_1st (s,c) = walk_ (var 0) s;
infixr 0 <?;
n <? g = map reify_1st $ list (take n (callgoal g));
prefix 0 ?*;
?* goal = map reify_1st $ list (callgoal goal);
appendo l r out = (l ?== [] ?&& r ?== out)
?|| (fresh [a,d,res] in
(a:d ?== l ?&& a:res ?== out
?&& Zzz (appendo d r res)));