Mercurial > urweb

comparison src/monoize.sml @ 389:acaf9d19fbb7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
num working for int
author Adam Chlipala <adamc@hcoop.net>
date Tue, 21 Oct 2008 10:34:07 -0400
parents 2e93d18daf44
children 519366a76603
comparison
equal deleted inserted replaced
388:2e93d18daf44 389:acaf9d19fbb7
98 let 98 let
99 val t = mt env dtmap t 99 val t = mt env dtmap t
100 in 100 in
101 (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc) 101 (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)
102 end 102 end
103 | L.CApp ((L.CFfi ("Basis", "num"), _), t) =>
104 let
105 val t = mt env dtmap t
106 in
107 (L'.TRecord [("Neg", (L'.TFun (t, t), loc)),
108 ("Plus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
109 ("Minus", (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)),
112 ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))],
113 loc)
114 end
103 | L.CApp ((L.CFfi ("Basis", "show"), _), t) => 115 | L.CApp ((L.CFfi ("Basis", "show"), _), t) =>
104 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc) 116 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
105 | L.CApp ((L.CFfi ("Basis", "read"), _), t) => 117 | L.CApp ((L.CFfi ("Basis", "read"), _), t) =>
106 readType (mt env dtmap t, loc) 118 readType (mt env dtmap t, loc)
107 119
467 let 479 let
468 fun poly () = 480 fun poly () =
469 (E.errorAt loc "Unsupported expression"; 481 (E.errorAt loc "Unsupported expression";
470 Print.eprefaces' [("Expression", CorePrint.p_exp env all)]; 482 Print.eprefaces' [("Expression", CorePrint.p_exp env all)];
471 (dummyExp, fm)) 483 (dummyExp, fm))
484
485 fun numTy t =
486 (L'.TRecord [("Neg", (L'.TFun (t, t), loc)),
487 ("Plus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
488 ("Minus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
489 ("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
490 ("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
491 ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc)
492 fun numEx (t, neg, plus, minus, times, dv, md) =
493 ((L'.ERecord [("Neg", neg, (L'.TFun (t, t), loc)),
494 ("Plus", plus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
495 ("Minus", minus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
496 ("Times", times, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
497 ("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)
472 in 499 in
473 case e of 500 case e of
474 L.EPrim p => ((L'.EPrim p, loc), fm) 501 L.EPrim p => ((L'.EPrim p, loc), fm)
475 | L.ERel n => ((L'.ERel n, loc), fm) 502 | L.ERel n => ((L'.ERel n, loc), fm)
476 | L.ENamed n => ((L'.ENamed n, loc), fm) 503 | L.ENamed n => ((L'.ENamed n, loc), fm)
543 (L'.EAbs ("y", (L'.TFfi ("Basis", "string"), loc), 570 (L'.EAbs ("y", (L'.TFfi ("Basis", "string"), loc),
544 (L'.TFfi ("Basis", "bool"), loc), 571 (L'.TFfi ("Basis", "bool"), loc),
545 (L'.EBinop ("!strcmp", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc), 572 (L'.EBinop ("!strcmp", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
546 fm) 573 fm)
547 574
575 | L.ECApp ((L.EFfi ("Basis", "neg"), _), t) =>
576 let
577 val t = monoType env t
578 in
579 ((L'.EAbs ("r", numTy t, (L'.TFun (t, t), loc),
580 (L'.EField ((L'.ERel 0, loc), "Neg"), loc)), loc), fm)
581 end
582 | L.ECApp ((L.EFfi ("Basis", "plus"), _), t) =>
583 let
584 val t = monoType env t
585 in
586 ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
587 (L'.EField ((L'.ERel 0, loc), "Plus"), loc)), loc), fm)
588 end
589 | L.ECApp ((L.EFfi ("Basis", "minus"), _), t) =>
590 let
591 val t = monoType env t
592 in
593 ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
594 (L'.EField ((L'.ERel 0, loc), "Minus"), loc)), loc), fm)
595 end
596 | L.ECApp ((L.EFfi ("Basis", "times"), _), t) =>
597 let
598 val t = monoType env t
599 in
600 ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
601 (L'.EField ((L'.ERel 0, loc), "Times"), loc)), loc), fm)
602 end
603 | L.ECApp ((L.EFfi ("Basis", "div"), _), t) =>
604 let
605 val t = monoType env t
606 in
607 ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
608 (L'.EField ((L'.ERel 0, loc), "Div"), loc)), loc), fm)
609 end
610 | L.ECApp ((L.EFfi ("Basis", "mod"), _), t) =>
611 let
612 val t = monoType env t
613 in
614 ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
615 (L'.EField ((L'.ERel 0, loc), "Mod"), loc)), loc), fm)
616 end
617 | L.EFfi ("Basis", "num_int") =>
618 let
619 fun intBin s =
620 (L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc),
621 (L'.TFun ((L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "int"), loc)), loc),
622 (L'.EAbs ("y", (L'.TFfi ("Basis", "int"), loc),
623 (L'.TFfi ("Basis", "int"), loc),
624 (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
625 in
626 numEx ((L'.TFfi ("Basis", "int"), loc),
627 (L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc),
628 (L'.TFfi ("Basis", "int"), loc),
629 (L'.EUnop ("-", (L'.ERel 0, loc)), loc)), loc),
630 intBin "+",
631 intBin "-",
632 intBin "*",
633 intBin "/",
634 intBin "%")
635 end
636
548 | L.ECApp ((L.EFfi ("Basis", "show"), _), t) => 637 | L.ECApp ((L.EFfi ("Basis", "show"), _), t) =>
549 let 638 let
550 val t = monoType env t 639 val t = monoType env t
551 val s = (L'.TFfi ("Basis", "string"), loc) 640 val s = (L'.TFfi ("Basis", "string"), loc)
552 in 641 in