Mercurial > urweb

comparison src/monoize.sml @ 387:7abb28e9d51f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Binops; equality tested on int; lame 404 substitute
author Adam Chlipala <adamc@hcoop.net>
date Tue, 21 Oct 2008 09:50:19 -0400
parents 1195f6e4d208
children 2e93d18daf44
comparison
equal deleted inserted replaced
386:ef43ed6cd1de 387:7abb28e9d51f
92 | L.TRecord _ => poly () 92 | L.TRecord _ => poly ()
93 93
94 | L.CApp ((L.CFfi ("Basis", "option"), _), t) => 94 | L.CApp ((L.CFfi ("Basis", "option"), _), t) =>
95 (L'.TOption (mt env dtmap t), loc) 95 (L'.TOption (mt env dtmap t), loc)
96 96
97 | L.CApp ((L.CFfi ("Basis", "eq"), _), t) =>
98 let
99 val t = mt env dtmap t
100 in
101 (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)
102 end
97 | L.CApp ((L.CFfi ("Basis", "show"), _), t) => 103 | L.CApp ((L.CFfi ("Basis", "show"), _), t) =>
98 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc) 104 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
99 | L.CApp ((L.CFfi ("Basis", "read"), _), t) => 105 | L.CApp ((L.CFfi ("Basis", "read"), _), t) =>
100 readType (mt env dtmap t, loc) 106 readType (mt env dtmap t, loc)
101 107
489 val (e, fm) = monoExp (env, st, fm) e 495 val (e, fm) = monoExp (env, st, fm) e
490 in 496 in
491 ((L'.ESome (monoType env t, e), loc), fm) 497 ((L'.ESome (monoType env t, e), loc), fm)
492 end 498 end
493 | L.ECon _ => poly () 499 | L.ECon _ => poly ()
500
501 | L.ECApp ((L.EFfi ("Basis", "eq"), _), t) =>
502 let
503 val t = monoType env t
504 val b = (L'.TFfi ("Basis", "bool"), loc)
505 val dom = (L'.TFun (t, (L'.TFun (t, b), loc)), loc)
506 in
507 ((L'.EAbs ("f", dom, dom,
508 (L'.ERel 0, loc)), loc), fm)
509 end
510 | L.ECApp ((L.EFfi ("Basis", "ne"), _), t) =>
511 let
512 val t = monoType env t
513 val b = (L'.TFfi ("Basis", "bool"), loc)
514 val dom = (L'.TFun (t, (L'.TFun (t, b), loc)), loc)
515 in
516 ((L'.EAbs ("f", dom, dom,
517 (L'.EAbs ("x", t, (L'.TFun (t, b), loc),
518 (L'.EAbs ("y", t, b,
519 (L'.EUnop ("!", (L'.EApp ((L'.EApp ((L'.ERel 2, loc),
520 (L'.ERel 1, loc)), loc),
521 (L'.ERel 0, loc)), loc)), loc)),
522 loc)),
523 loc)),
524 loc), fm)
525 end
526 | L.EFfi ("Basis", "eq_int") =>
527 ((L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc),
528 (L'.TFun ((L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
529 (L'.EAbs ("y", (L'.TFfi ("Basis", "int"), loc),
530 (L'.TFfi ("Basis", "bool"), loc),
531 (L'.EBinop ("==", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
532 fm)
494 533
495 | L.ECApp ((L.EFfi ("Basis", "show"), _), t) => 534 | L.ECApp ((L.EFfi ("Basis", "show"), _), t) =>
496 let 535 let
497 val t = monoType env t 536 val t = monoType env t
498 val s = (L'.TFfi ("Basis", "string"), loc) 537 val s = (L'.TFfi ("Basis", "string"), loc)