Mercurial > urweb

comparison src/monoize.sml @ 1020:dfe34fad749d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
RPC uses VM support for call/cc
author Adam Chlipala <adamc@hcoop.net>
date Sun, 25 Oct 2009 14:07:10 -0400
parents ea9f03ac2710
children 7a4a55e05081
comparison
equal deleted inserted replaced
1019:68ba074e260f 1020:dfe34fad749d
3199 val (e2, fm) = monoExp (Env.pushERel env x t, st, fm) e2 3199 val (e2, fm) = monoExp (Env.pushERel env x t, st, fm) e2
3200 in 3200 in
3201 ((L'.ELet (x, t', e1, e2), loc), fm) 3201 ((L'.ELet (x, t', e1, e2), loc), fm)
3202 end 3202 end
3203 3203
3204 | L.ETailCall (n, es, ek, _, (L.TRecord (L.CRecord (_, []), _), _)) => 3204 | L.EServerCall (n, es, t) =>
3205 let
3206 val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es
3207 val (ek, fm) = monoExp (env, st, fm) ek
3208
3209 val e = (L'.ENamed n, loc)
3210 val e = foldl (fn (arg, e) => (L'.EApp (e, arg), loc)) e es
3211 val e = (L'.EApp (e, ek), loc)
3212 in
3213 (e, fm)
3214 end
3215 | L.ETailCall _ => (E.errorAt loc "Full scope of tail call continuation isn't known";
3216 Print.eprefaces' [("Expression", CorePrint.p_exp env all)];
3217 (dummyExp, fm))
3218
3219 | L.EServerCall (n, es, ek, t, (L.TRecord (L.CRecord (_, []), _), _)) =>
3220 let 3205 let
3221 val t = monoType env t 3206 val t = monoType env t
3222 val (_, ft, _, name) = Env.lookupENamed env n 3207 val (_, ft, _, name) = Env.lookupENamed env n
3223 val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es 3208 val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es
3224 3209
3237 3222
3238 val (call, fm) = encodeArgs (es, ft, [], fm) 3223 val (call, fm) = encodeArgs (es, ft, [], fm)
3239 val call = foldl (fn (e, call) => (L'.EStrcat (call, e), loc)) 3224 val call = foldl (fn (e, call) => (L'.EStrcat (call, e), loc))
3240 (L'.EPrim (Prim.String name), loc) call 3225 (L'.EPrim (Prim.String name), loc) call
3241 3226
3242 val (ek, fm) = monoExp (env, st, fm) ek
3243
3244 val unit = (L'.TRecord [], loc) 3227 val unit = (L'.TRecord [], loc)
3245 3228
3246 val ekf = (L'.EAbs ("f",
3247 (L'.TFun (t,
3248 (L'.TFun ((L'.TRecord [], loc),
3249 (L'.TRecord [], loc)), loc)), loc),
3250 (L'.TFun (t,
3251 (L'.TRecord [], loc)), loc),
3252 (L'.EAbs ("x",
3253 t,
3254 (L'.TRecord [], loc),
3255 (L'.EApp ((L'.EApp ((L'.ERel 1, loc),
3256 (L'.ERel 0, loc)), loc),
3257 (L'.ERecord [], loc)), loc)), loc)), loc)
3258 val ek = (L'.EApp (ekf, ek), loc)
3259 val eff = if IS.member (!readCookie, n) then 3229 val eff = if IS.member (!readCookie, n) then
3260 L'.ReadCookieWrite 3230 L'.ReadCookieWrite
3261 else 3231 else
3262 L'.ReadOnly 3232 L'.ReadOnly
3263 3233
3264 val e = (L'.EServerCall (call, ek, t, eff), loc) 3234 val e = (L'.EServerCall (call, t, eff), loc)
3265 val e = liftExpInExp 0 e 3235 val e = liftExpInExp 0 e
3266 val e = (L'.EAbs ("_", unit, unit, e), loc) 3236 val e = (L'.EAbs ("_", unit, unit, e), loc)
3267 in 3237 in
3268 (e, fm) 3238 (e, fm)
3269 end 3239 end
3270 | L.EServerCall _ => (E.errorAt loc "Full scope of server call continuation isn't known";
3271 Print.eprefaces' [("Expression", CorePrint.p_exp env all)];
3272 (dummyExp, fm))
3273 3240
3274 | L.EKAbs _ => poly () 3241 | L.EKAbs _ => poly ()
3275 | L.EKApp _ => poly () 3242 | L.EKApp _ => poly ()
3276 end 3243 end
3277 3244