summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-05-17 14:36:55 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-05-17 14:36:55 -0400
commit7bbee7c3f41f0386072d0d73cd3477d0a4734ca9 (patch)
tree37190bd18788573834dedcc81888776b49cd758e /src
parent8d4ec5e3186b939a3c4d4a04e0e834836dd2c779 (diff)
Fix argument ordering bug in fuse; fix case subsitution bug in MonoReduce
Diffstat (limited to 'src')
-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),