Commit 6785e77e authored by bbr's avatar bbr
Browse files

InstancesPrelude now compiling

the state argument was changed to be last in the generated instances
parent f3d2b536
......@@ -449,10 +449,10 @@ curryInstance opts (Type origName vis vars consdecls)
rule [C.PComb (consName opts cname) (map toPVar [1..arity]),
C.PComb (consName opts cname) (map (toPVar' "y") [1..arity])]
(noguard $ if arity==0 then (extInstPresym isPrelude "strEqSuccess")
else foldr1 (\ e es -> fapp (extInstPresym isPrelude "concAnd") [st,e,es])
else foldr1 (\ e es -> fapp (extInstPresym isPrelude "concAnd") (addStateArg [e,es]))
(map sEq [1..arity])) []
where
sEq i = fapp (extInstPresym isPrelude "genStrEq") [st,toVar i,toVar' "y" i]
sEq i = fapp (extInstPresym isPrelude "genStrEq") (addStateArg [toVar i,toVar' "y" i])
eq = C.Func (newModName,"eq") (transvis vis) untyped
(Just
......@@ -463,10 +463,10 @@ curryInstance opts (Type origName vis vars consdecls)
rule [C.PComb (consName opts cname) (map toPVar [1..arity]),
C.PComb (consName opts cname) (map (toPVar' "y") [1..arity])]
(noguard $ if arity==0 then baseTypesym isPrelude "C_True"
else foldr1 (\ e es -> fapp (fbasesym opts "&&") [st,e,es])
else foldr1 (\ e es -> fapp (fbasesym opts "&&") (addStateArg [e,es]))
(map eqArgs [1..arity])) []
where
eqArgs i = fapp (extInstPresym isPrelude "genEq") [st,toVar i,toVar' "y" i]
eqArgs i = fapp (extInstPresym isPrelude "genEq") (addStateArg [toVar i,toVar' "y" i])
propagate = C.Func (newModName,"propagate") (transvis vis) untyped
(Just (map propRule consdecls))
......@@ -546,22 +546,23 @@ baseCurryInstance opts (Type origName vis vars consdecls)
nf gr = C.Func (newModName,if gr then "gnf" else "nf") (transvis vis) untyped
(Just
(concatMap (nfrule gr) (filter ((1<=) . consArity) consdecls) ++
[C.Rule [C.PVar "f",C.PVar "state",C.PVar "x"]
(noguard (fapp (C.Var "f") [C.Var "state",C.Var "x"])) []]))
[C.Rule (addStatePat [C.PVar "f",C.PVar "x"])
(noguard (fapp (C.Var "f") (addStateArg [C.Var "x"]))) []]))
nfrule gr (Cons cname arity _ _)
= [C.Rule [C.PVar "f",C.PVar "state0",
C.PComb (consName opts cname) (map toPVar [1..arity])]
= [C.Rule [C.PVar "f",
C.PComb (consName opts cname) (map toPVar [1..arity]),
C.PVar "state0"]
(noguard $ foldr (nflambda gr)
(fapp (C.Var "f")
[toVar' "state" arity,
fapp (sym $ consName opts cname)
(map (toVar' "v") [1..arity])])
[fapp (sym $ consName opts cname)
(map (toVar' "v") [1..arity]),
toVar' "state" arity])
[1..arity]) []]
nflambda gr i e =
fapp (basesym (if gr then "gnfCTC" else "nfCTC"))
[C.Lambda [toPVar' "state" i,toPVar' "v" i] e,toVar' "state" (i-1),toVar i]
[C.Lambda [toPVar' "v" i,toPVar' "state" i] e,toVar i,toVar' "state" (i-1)]
free s t = C.Func (newModName,s) (transvis vis) untyped
(Just [C.Rule [_x] (noguard (app (basesym "orsCTC")
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment