Mercurial > urweb

comparison src/monoize.sml @ 905:7a4b026e45dd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Library improvements; proper list [un]urlification; remove server-side ServerCalls; eta reduction in type inference
author Adam Chlipala <adamc@hcoop.net>
date Sun, 09 Aug 2009 16:13:27 -0400
parents 63114a2e5075
children 5fe49effbc83
comparison
equal deleted inserted replaced
904:6d9538ce94d8 905:7a4b026e45dd
91 in 91 in
92 case c of 92 case c of
93 L.TFun (c1, c2) => (L'.TFun (mt env dtmap c1, mt env dtmap c2), loc) 93 L.TFun (c1, c2) => (L'.TFun (mt env dtmap c1, mt env dtmap c2), loc)
94 | L.TCFun _ => poly () 94 | L.TCFun _ => poly ()
95 | L.TRecord (L.CRecord ((L.KType, _), xcs), _) => 95 | L.TRecord (L.CRecord ((L.KType, _), xcs), _) =>
96 (L'.TRecord (map (fn (x, t) => (monoName env x, mt env dtmap t)) xcs), loc) 96 let
97 val xcs = map (fn (x, t) => (monoName env x, mt env dtmap t)) xcs
98 val xcs = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) xcs
99 in
100 (L'.TRecord xcs, loc)
101 end
97 | L.TRecord _ => poly () 102 | L.TRecord _ => poly ()
98 103
99 | L.CApp ((L.CFfi ("Basis", "option"), _), t) => 104 | L.CApp ((L.CFfi ("Basis", "option"), _), t) =>
100 (L'.TOption (mt env dtmap t), loc) 105 (L'.TOption (mt env dtmap t), loc)
101 | L.CApp ((L.CFfi ("Basis", "list"), _), t) => 106 | L.CApp ((L.CFfi ("Basis", "list"), _), t) =>
3074 in 3079 in
3075 ((monoName env x, 3080 ((monoName env x,
3076 e, 3081 e,
3077 monoType env t), fm) 3082 monoType env t), fm)
3078 end) fm xes 3083 end) fm xes
3084
3085 val xes = ListMergeSort.sort (fn ((x, _, _), (y, _, _)) => String.compare (x, y) = GREATER) xes
3079 in 3086 in
3080 ((L'.ERecord xes, loc), fm) 3087 ((L'.ERecord xes, loc), fm)
3081 end 3088 end
3082 | L.EField (e, x, _) => 3089 | L.EField (e, x, _) =>
3083 let 3090 let
3151 val (call, fm) = encodeArgs (es, ft, [], fm) 3158 val (call, fm) = encodeArgs (es, ft, [], fm)
3152 val call = foldl (fn (e, call) => (L'.EStrcat (call, e), loc)) 3159 val call = foldl (fn (e, call) => (L'.EStrcat (call, e), loc))
3153 (L'.EPrim (Prim.String name), loc) call 3160 (L'.EPrim (Prim.String name), loc) call
3154 3161
3155 val (ek, fm) = monoExp (env, st, fm) ek 3162 val (ek, fm) = monoExp (env, st, fm) ek
3163
3164 val unRpced = foldl (fn (e1, e2) => (L'.EApp (e2, e1), loc)) (L'.ENamed n, loc) es
3165 val unRpced = (L'.EApp (unRpced, (L'.ERecord [], loc)), loc)
3166 val unRpced = (L'.EApp (ek, unRpced), loc)
3167 val unRpced = (L'.EApp (unRpced, (L'.ERecord [], loc)), loc)
3168 val unit = (L'.TRecord [], loc)
3156 3169
3157 val ekf = (L'.EAbs ("f", 3170 val ekf = (L'.EAbs ("f",
3158 (L'.TFun (t, 3171 (L'.TFun (t,
3159 (L'.TFun ((L'.TRecord [], loc), 3172 (L'.TFun ((L'.TRecord [], loc),
3160 (L'.TRecord [], loc)), loc)), loc), 3173 (L'.TRecord [], loc)), loc)), loc),
3169 val ek = (L'.EApp (ekf, ek), loc) 3182 val ek = (L'.EApp (ekf, ek), loc)
3170 val eff = if IS.member (!readCookie, n) then 3183 val eff = if IS.member (!readCookie, n) then
3171 L'.ReadCookieWrite 3184 L'.ReadCookieWrite
3172 else 3185 else
3173 L'.ReadOnly 3186 L'.ReadOnly
3174 val e = (L'.EServerCall (call, ek, t, eff), loc) 3187
3188 val e = (L'.EServerCall (call, ek, t, eff, unRpced), loc)
3175 val e = liftExpInExp 0 e 3189 val e = liftExpInExp 0 e
3176 val unit = (L'.TRecord [], loc)
3177 val e = (L'.EAbs ("_", unit, unit, e), loc) 3190 val e = (L'.EAbs ("_", unit, unit, e), loc)
3178 in 3191 in
3179 (e, fm) 3192 (e, fm)
3180 end 3193 end
3181 3194