summaryrefslogtreecommitdiff
path: root/src/monoize.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-08-09 16:13:27 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-08-09 16:13:27 -0400
commit1f98468265e6f5d652ed107a0bd89a319eca0297 (patch)
tree007835aa119d7ec7cae1d7de078850147ab9ca13 /src/monoize.sml
parentf223822addd309cd20b5b01e34548496e6d33251 (diff)
Library improvements; proper list [un]urlification; remove server-side ServerCalls; eta reduction in type inference
Diffstat (limited to 'src/monoize.sml')
-rw-r--r--src/monoize.sml19
1 files changed, 16 insertions, 3 deletions
diff --git a/src/monoize.sml b/src/monoize.sml
index d774c697..c0351756 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -93,7 +93,12 @@ fun monoType env =
L.TFun (c1, c2) => (L'.TFun (mt env dtmap c1, mt env dtmap c2), loc)
| L.TCFun _ => poly ()
| L.TRecord (L.CRecord ((L.KType, _), xcs), _) =>
- (L'.TRecord (map (fn (x, t) => (monoName env x, mt env dtmap t)) xcs), loc)
+ let
+ val xcs = map (fn (x, t) => (monoName env x, mt env dtmap t)) xcs
+ val xcs = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) xcs
+ in
+ (L'.TRecord xcs, loc)
+ end
| L.TRecord _ => poly ()
| L.CApp ((L.CFfi ("Basis", "option"), _), t) =>
@@ -3076,6 +3081,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
e,
monoType env t), fm)
end) fm xes
+
+ val xes = ListMergeSort.sort (fn ((x, _, _), (y, _, _)) => String.compare (x, y) = GREATER) xes
in
((L'.ERecord xes, loc), fm)
end
@@ -3154,6 +3161,12 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
val (ek, fm) = monoExp (env, st, fm) ek
+ val unRpced = foldl (fn (e1, e2) => (L'.EApp (e2, e1), loc)) (L'.ENamed n, loc) es
+ val unRpced = (L'.EApp (unRpced, (L'.ERecord [], loc)), loc)
+ val unRpced = (L'.EApp (ek, unRpced), loc)
+ val unRpced = (L'.EApp (unRpced, (L'.ERecord [], loc)), loc)
+ val unit = (L'.TRecord [], loc)
+
val ekf = (L'.EAbs ("f",
(L'.TFun (t,
(L'.TFun ((L'.TRecord [], loc),
@@ -3171,9 +3184,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
L'.ReadCookieWrite
else
L'.ReadOnly
- val e = (L'.EServerCall (call, ek, t, eff), loc)
+
+ val e = (L'.EServerCall (call, ek, t, eff, unRpced), loc)
val e = liftExpInExp 0 e
- val unit = (L'.TRecord [], loc)
val e = (L'.EAbs ("_", unit, unit, e), loc)
in
(e, fm)