Mercurial > urweb

comparison src/monoize.sml @ 391:fe8f75f7e130

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
lt, le working for int
author Adam Chlipala <adamc@hcoop.net>
date Tue, 21 Oct 2008 10:56:43 -0400
parents 519366a76603
children a813476230e3
comparison
equal deleted inserted replaced
390:519366a76603 391:fe8f75f7e130
110 ("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 110 ("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
111 ("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 111 ("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
112 ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], 112 ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))],
113 loc) 113 loc)
114 end 114 end
115 | L.CApp ((L.CFfi ("Basis", "ord"), _), t) =>
116 let
117 val t = mt env dtmap t
118 in
119 (L'.TRecord [("Lt", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)),
120 ("Le", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc))],
121 loc)
122 end
115 | L.CApp ((L.CFfi ("Basis", "show"), _), t) => 123 | L.CApp ((L.CFfi ("Basis", "show"), _), t) =>
116 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc) 124 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
117 | L.CApp ((L.CFfi ("Basis", "read"), _), t) => 125 | L.CApp ((L.CFfi ("Basis", "read"), _), t) =>
118 readType (mt env dtmap t, loc) 126 readType (mt env dtmap t, loc)
119 127
494 ("Plus", plus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 502 ("Plus", plus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
495 ("Minus", minus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 503 ("Minus", minus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
496 ("Times", times, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 504 ("Times", times, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
497 ("Div", dv, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 505 ("Div", dv, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
498 ("Mod", md, (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc), fm) 506 ("Mod", md, (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc), fm)
507
508 fun ordTy t =
509 (L'.TRecord [("Lt", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)),
510 ("Le", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc))], loc)
511 fun ordEx (t, lt, le) =
512 ((L'.ERecord [("Lt", lt, (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)),
513 ("Le", le, (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc))],
514 loc), fm)
499 in 515 in
500 case e of 516 case e of
501 L.EPrim p => ((L'.EPrim p, loc), fm) 517 L.EPrim p => ((L'.EPrim p, loc), fm)
502 | L.ERel n => ((L'.ERel n, loc), fm) 518 | L.ERel n => ((L'.ERel n, loc), fm)
503 | L.ENamed n => ((L'.ENamed n, loc), fm) 519 | L.ENamed n => ((L'.ENamed n, loc), fm)
649 floatBin "+", 665 floatBin "+",
650 floatBin "-", 666 floatBin "-",
651 floatBin "*", 667 floatBin "*",
652 floatBin "/", 668 floatBin "/",
653 floatBin "fmod") 669 floatBin "fmod")
670 end
671
672 | L.ECApp ((L.EFfi ("Basis", "lt"), _), t) =>
673 let
674 val t = monoType env t
675 in
676 ((L'.EAbs ("r", ordTy t, (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc),
677 (L'.EField ((L'.ERel 0, loc), "Lt"), loc)), loc), fm)
678 end
679 | L.ECApp ((L.EFfi ("Basis", "le"), _), t) =>
680 let
681 val t = monoType env t
682 in
683 ((L'.EAbs ("r", ordTy t, (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc),
684 (L'.EField ((L'.ERel 0, loc), "Le"), loc)), loc), fm)
685 end
686 | L.EFfi ("Basis", "ord_int") =>
687 let
688 fun intBin s =
689 (L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc),
690 (L'.TFun ((L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc),
691 (L'.EAbs ("y", (L'.TFfi ("Basis", "int"), loc),
692 (L'.TFfi ("Basis", "bool"), loc),
693 (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
694 in
695 ordEx ((L'.TFfi ("Basis", "int"), loc),
696 intBin "<",
697 intBin "<=")
654 end 698 end
655 699
656 | L.ECApp ((L.EFfi ("Basis", "show"), _), t) => 700 | L.ECApp ((L.EFfi ("Basis", "show"), _), t) =>
657 let 701 let
658 val t = monoType env t 702 val t = monoType env t