Mercurial > urweb
diff src/mono_util.sml @ 1663:0577be31a435
First part of changes to avoid depending on C function call argument order of evaluation (omitting normal Ur function calls, so far)
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sat, 07 Jan 2012 15:56:22 -0500 |
| parents | 7bb8c560f23d |
| children | 38297294cf98 |
line wrap: on
line diff
--- a/src/mono_util.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/mono_util.sml Sat Jan 07 15:56:22 2012 -0500 @@ -156,6 +156,12 @@ fun mfe ctx e acc = S.bindP (mfe' ctx e acc, fe ctx) + and mfet ctx (e, t) = + S.bind2 (mfe ctx e, + fn e' => + S.map2 (mft t, + fn t' => (e', t'))) + and mfe' ctx (eAll as (e, loc)) = case e of EPrim _ => S.return2 eAll @@ -178,7 +184,7 @@ (ESome (t', e'), loc))) | EFfi _ => S.return2 eAll | EFfiApp (m, x, es) => - S.map2 (ListUtil.mapfold (fn e => mfe ctx e) es, + S.map2 (ListUtil.mapfold (fn e => mfet ctx e) es, fn es' => (EFfiApp (m, x, es'), loc)) | EApp (e1, e2) => @@ -479,7 +485,7 @@ | ENone _ => () | ESome (_, e) => appl e | EFfi _ => () - | EFfiApp (_, _, es) => app appl es + | EFfiApp (_, _, es) => app (appl o #1) es | EApp (e1, e2) => (appl e1; appl e2) | EAbs (_, _, _, e1) => appl e1 | EUnop (_, e1) => appl e1