Mercurial > urweb

comparison src/monoize.sml @ 1021:7a4a55e05081

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use call/cc for recv and sleep
author Adam Chlipala <adamc@hcoop.net>
date Sun, 25 Oct 2009 15:29:21 -0400
parents dfe34fad749d
children 7facf72aaf0a
comparison
equal deleted inserted replaced
1020:dfe34fad749d 1021:7a4a55e05081
1205 (L'.ERecord [], loc)), 1205 (L'.ERecord [], loc)),
1206 loc)), loc)), loc)), loc)), loc)), loc), 1206 loc)), loc)), loc)), loc)), loc)), loc),
1207 fm) 1207 fm)
1208 end 1208 end
1209 1209
1210 | L.EApp ((L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), _), _), _), _), t2), _), 1210 | L.EApp ((L.ECApp ((L.EFfi ("Basis", "recv"), _), t1), _), ch) =>
1211 (L.EFfi ("Basis", "transaction_monad"), _)), _), 1211 let
1212 (L.EApp ((L.ECApp ((L.EFfi ("Basis", "recv"), _), t1), _), 1212 val un = (L'.TRecord [], loc)
1213 ch), loc)) =>
1214 let
1215 val t1 = monoType env t1 1213 val t1 = monoType env t1
1216 val t2 = monoType env t2
1217 val un = (L'.TRecord [], loc)
1218 val mt2 = (L'.TFun (un, t2), loc)
1219 val (ch, fm) = monoExp (env, st, fm) ch 1214 val (ch, fm) = monoExp (env, st, fm) ch
1220 in 1215 in
1221 ((L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc), 1216 ((L'.EAbs ("_", un, un, (L'.ERecv (liftExpInExp 0 ch, t1), loc)), loc), fm)
1222 (L'.EAbs ("_", un, un,
1223 (L'.ERecv (liftExpInExp 0 (liftExpInExp 0 ch),
1224 (L'.ERel 1, loc),
1225 t1), loc)), loc)), loc),
1226 fm)
1227 end 1217 end
1228 | L.EFfiApp ("Basis", "recv", _) => poly () 1218 | L.EFfiApp ("Basis", "recv", _) => poly ()
1229 1219
1230 | L.EApp ((L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), _), _), _), _), t2), _), 1220 | L.EFfiApp ("Basis", "sleep", [n]) =>
1231 (L.EFfi ("Basis", "transaction_monad"), _)), _), 1221 let
1232 (L.EAbs (_, _, _,
1233 (L.EFfiApp ("Basis", "sleep", [n]), _)), loc)) =>
1234 let
1235 val t2 = monoType env t2
1236 val un = (L'.TRecord [], loc)
1237 val mt2 = (L'.TFun (un, t2), loc)
1238 val (n, fm) = monoExp (env, st, fm) n 1222 val (n, fm) = monoExp (env, st, fm) n
1239 in 1223 in
1240 ((L'.EAbs ("m2", (L'.TFun (un, mt2), loc), (L'.TFun (un, un), loc), 1224 ((L'.ESleep n, loc), fm)
1241 (L'.EAbs ("_", un, un,
1242 (L'.ESleep (liftExpInExp 0 n, (L'.EApp ((L'.ERel 1, loc),
1243 (L'.ERecord [], loc)), loc)),
1244 loc)), loc)), loc),
1245 fm)
1246 end 1225 end
1247 | L.EFfiApp ("Basis", "sleep", _) => poly () 1226 | L.EFfiApp ("Basis", "sleep", _) => poly ()
1248 1227
1249 | L.ECApp ((L.EFfi ("Basis", "source"), _), t) => 1228 | L.ECApp ((L.EFfi ("Basis", "source"), _), t) =>
1250 let 1229 let
1300 1279
1301 | L.EFfiApp ("Basis", "spawn", [e]) => 1280 | L.EFfiApp ("Basis", "spawn", [e]) =>
1302 let 1281 let
1303 val (e, fm) = monoExp (env, st, fm) e 1282 val (e, fm) = monoExp (env, st, fm) e
1304 in 1283 in
1305 ((L'.EApp (e, (L'.ERecord [], loc)), loc), fm) 1284 ((L'.ESpawn e, loc), fm)
1306 end 1285 end
1307 1286
1308 | L.EFfi ("Basis", "signal_monad") => ((L'.ERecord [], loc), fm) 1287 | L.EFfi ("Basis", "signal_monad") => ((L'.ERecord [], loc), fm)
1309 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), (L.CFfi ("Basis", "signal"), _)), _), t) => 1288 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), (L.CFfi ("Basis", "signal"), _)), _), t) =>
1310 let 1289 let