summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/fuse.sml2
-rw-r--r--src/mono_reduce.sml11
2 files changed, 7 insertions, 6 deletions
diff --git a/src/fuse.sml b/src/fuse.sml
index b6bd6b47..ad1958f7 100644
--- a/src/fuse.sml
+++ b/src/fuse.sml
@@ -78,7 +78,7 @@ fun fuse file =
val (body, args) = getBody (e, args)
val body = MonoOpt.optExp (EWrite body, loc)
- val (body, _) = foldl (fn ((x, dom), (body, ran)) =>
+ val (body, _) = foldr (fn ((x, dom), (body, ran)) =>
((EAbs (x, dom, ran, body), loc),
(TFun (dom, ran), loc)))
(body, (TRecord [], loc)) args
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 94c57bac..77672acc 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -140,12 +140,12 @@ val swapExpVarsPat =
bind = fn ((lower, len), U.Exp.RelE _) => (lower+1, len)
| (st, _) => st}
-datatype result = Yes of E.env | No | Maybe
+datatype result = Yes of exp list | No | Maybe
fun match (env, p : pat, e : exp) =
case (#1 p, #1 e) of
(PWild, _) => Yes env
- | (PVar (x, t), _) => Yes (E.pushERel env x t (SOME e))
+ | (PVar (x, t), _) => Yes (e :: env)
| (PPrim (Prim.String s), EStrcat ((EPrim (Prim.String s'), _), _)) =>
if String.isPrefix s' s then
@@ -406,12 +406,13 @@ fun reduce file =
case pes of
[] => push ()
| (p, body) :: pes =>
- case match (env, p, e') of
+ case match ([], p, e') of
No => search pes
| Maybe => push ()
- | Yes env' =>
+ | Yes subs =>
let
- val r = reduceExp env' body
+ val body = foldr (fn (e, body) => subExpInExp (0, e) body) body subs
+ val r = reduceExp env body
in
(*Print.prefaces "ECase"
[("body", MonoPrint.p_exp env' body),