Mercurial > urweb

comparison src/monoize.sml @ 1544:a99b743a3087

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Basis.mkMonad
author Adam Chlipala <adam@chlipala.net>
date Fri, 19 Aug 2011 15:23:01 -0400
parents 27b8c0a460cf
children e1f5d9c4cc20
comparison
equal deleted inserted replaced
1543:6f046b4bad24 1544:a99b743a3087
1 (* Copyright (c) 2008-2010, Adam Chlipala 1 (* Copyright (c) 2008-2011, Adam Chlipala
2 * All rights reserved. 2 * All rights reserved.
3 * 3 *
4 * Redistribution and use in source and binary forms, with or without 4 * Redistribution and use in source and binary forms, with or without
5 * modification, are permitted provided that the following conditions are met: 5 * modification, are permitted provided that the following conditions are met:
6 * 6 *
1313 ("ReadError", (L'.EFfi ("Basis", "stringToTime_error"), loc), readErrType (t, loc))], 1313 ("ReadError", (L'.EFfi ("Basis", "stringToTime_error"), loc), readErrType (t, loc))],
1314 loc), 1314 loc),
1315 fm) 1315 fm)
1316 end 1316 end
1317 1317
1318 | L.EFfi ("Basis", "transaction_monad") => ((L'.ERecord [], loc), fm) 1318 | L.ECApp ((L.EFfi ("Basis", "transaction_return"), _), t) =>
1319 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), (L.CFfi ("Basis", "transaction"), _)), _), t) =>
1320 let 1319 let
1321 val t = monoType env t 1320 val t = monoType env t
1322 in 1321 in
1323 ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (t, (L'.TFun ((L'.TRecord [], loc), t), loc)), loc), 1322 ((L'.EAbs ("x", t,
1324 (L'.EAbs ("x", t,
1325 (L'.TFun ((L'.TRecord [], loc), t), loc), 1323 (L'.TFun ((L'.TRecord [], loc), t), loc),
1326 (L'.EAbs ("_", (L'.TRecord [], loc), t, 1324 (L'.EAbs ("_", (L'.TRecord [], loc), t,
1327 (L'.ERel 1, loc)), loc)), loc)), loc), 1325 (L'.ERel 1, loc)), loc)), loc),
1328 fm) 1326 fm)
1329 end 1327 end
1330 | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), (L.CFfi ("Basis", "transaction"), _)), _), 1328 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "transaction_bind"), _), t1), _), t2) =>
1331 t1), _), t2) =>
1332 let 1329 let
1333 val t1 = monoType env t1 1330 val t1 = monoType env t1
1334 val t2 = monoType env t2 1331 val t2 = monoType env t2
1335 val un = (L'.TRecord [], loc) 1332 val un = (L'.TRecord [], loc)
1336 val mt1 = (L'.TFun (un, t1), loc) 1333 val mt1 = (L'.TFun (un, t1), loc)
1337 val mt2 = (L'.TFun (un, t2), loc) 1334 val mt2 = (L'.TFun (un, t2), loc)
1338 in 1335 in
1339 ((L'.EAbs ("_", un, 1336 ((L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc)), loc),
1340 (L'.TFun (mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc)), loc)), loc), 1337 (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc),
1341 (L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc)), loc), 1338 (L'.EAbs ("_", un, un,
1342 (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc), 1339 (L'.ELet ("r", t1, (L'.EApp ((L'.ERel 2, loc),
1343 (L'.EAbs ("_", un, un, 1340 (L'.ERecord [], loc)), loc),
1344 (L'.ELet ("r", t1, (L'.EApp ((L'.ERel 2, loc), 1341 (L'.EApp (
1345 (L'.ERecord [], loc)), loc), 1342 (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc),
1346 (L'.EApp ( 1343 (L'.ERecord [], loc)),
1347 (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc), 1344 loc)), loc)), loc)), loc)), loc),
1348 (L'.ERecord [], loc)),
1349 loc)), loc)), loc)), loc)), loc)), loc),
1350 fm) 1345 fm)
1351 end 1346 end
1352 1347
1353 | L.EApp ((L.ECApp ((L.EFfi ("Basis", "recv"), _), t1), _), ch) => 1348 | L.EApp ((L.ECApp ((L.EFfi ("Basis", "recv"), _), t1), _), ch) =>
1354 let 1349 let
1425 val (e, fm) = monoExp (env, st, fm) e 1420 val (e, fm) = monoExp (env, st, fm) e
1426 in 1421 in
1427 ((L'.ESpawn e, loc), fm) 1422 ((L'.ESpawn e, loc), fm)
1428 end 1423 end
1429 1424
1430 | L.EFfi ("Basis", "signal_monad") => ((L'.ERecord [], loc), fm) 1425 | L.ECApp ((L.EFfi ("Basis", "signal_return"), _), t) =>
1431 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), (L.CFfi ("Basis", "signal"), _)), _), t) =>
1432 let 1426 let
1433 val t = monoType env t 1427 val t = monoType env t
1434 in 1428 in
1435 ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (t, (L'.TSignal t, loc)), loc), 1429 ((L'.EAbs ("x", t, (L'.TSignal t, loc),
1436 (L'.EAbs ("x", t, (L'.TSignal t, loc), 1430 (L'.ESignalReturn (L'.ERel 0, loc), loc)), loc),
1437 (L'.ESignalReturn (L'.ERel 0, loc), loc)), loc)), loc), 1431 fm)
1438 fm) 1432 end
1439 end 1433 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "signal_bind"), _), t1), _), t2) =>
1440 | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), (L.CFfi ("Basis", "signal"), _)), _),
1441 t1), _), t2) =>
1442 let 1434 let
1443 val t1 = monoType env t1 1435 val t1 = monoType env t1
1444 val t2 = monoType env t2 1436 val t2 = monoType env t2
1445 val un = (L'.TRecord [], loc) 1437 val un = (L'.TRecord [], loc)
1446 val mt1 = (L'.TSignal t1, loc) 1438 val mt1 = (L'.TSignal t1, loc)
1447 val mt2 = (L'.TSignal t2, loc) 1439 val mt2 = (L'.TSignal t2, loc)
1448 in 1440 in
1449 ((L'.EAbs ("_", un, (L'.TFun (mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), mt2), loc)), loc), 1441 ((L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), mt2), loc),
1450 (L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), mt2), loc), 1442 (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), mt2,
1451 (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), mt2, 1443 (L'.ESignalBind ((L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
1452 (L'.ESignalBind ((L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)),
1453 loc),
1454 fm) 1444 fm)
1455 end 1445 end
1456 | L.ECApp ((L.EFfi ("Basis", "signal"), _), t) => 1446 | L.ECApp ((L.EFfi ("Basis", "signal"), _), t) =>
1457 let 1447 let
1458 val t = monoType env t 1448 val t = monoType env t