diff src/core_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 b4480a56cab7
children e15234fbb163
line wrap: on
line diff
--- a/src/core_util.sml	Sat Jan 07 11:01:21 2012 -0500
+++ b/src/core_util.sml	Sat Jan 07 15:56:22 2012 -0500
@@ -468,7 +468,7 @@
       | (EFfiApp (f1, x1, es1), EFfiApp (f2, x2, es2)) =>
         join (String.compare (f1, f2),
            fn () => join (String.compare (x1, x2),
-                       fn () => joinL compare (es1, es2)))
+                       fn () => joinL (fn ((e1, _), (e2, _)) => compare (e1, e2))(es1, es2)))
       | (EFfiApp _, _) => LESS
       | (_, EFfiApp _) => GREATER
 
@@ -586,6 +586,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 (mfc ctx t,
+                          fn t' => (e', t')))
+
         and mfe' ctx (eAll as (e, loc)) =
             case e of
                 EPrim _ => S.return2 eAll
@@ -603,7 +609,7 @@
                                     (ECon (dk, n, cs', SOME e'), loc)))
               | EFfi _ => S.return2 eAll
               | EFfiApp (m, x, es) =>
-                S.map2 (ListUtil.mapfold (mfe ctx) es,
+                S.map2 (ListUtil.mapfold (mfet ctx) es,
                      fn es' =>
                         (EFfiApp (m, x, es'), loc))
               | EApp (e1, e2) =>