Mercurial > urweb

comparison src/monoize.sml @ 1831:36428d853c97

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Standard library additions: Option.unsafeGet, Basis.exp
author Austin Seipp <mad.one@gmail.com>
date Wed, 28 Nov 2012 11:41:54 -0500
parents 148203744882
children 373e2c3f03b2
comparison
equal deleted inserted replaced
1830:d636d33fd8a2 1831:36428d853c97
189 ("Neg", (L'.TFun (t, t), loc)), 189 ("Neg", (L'.TFun (t, t), loc)),
190 ("Plus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 190 ("Plus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
191 ("Minus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 191 ("Minus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
192 ("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 192 ("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
193 ("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 193 ("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
194 ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], 194 ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
195 ("Exp", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))],
195 loc) 196 loc)
196 end 197 end
197 | L.CApp ((L.CFfi ("Basis", "ord"), _), t) => 198 | L.CApp ((L.CFfi ("Basis", "ord"), _), t) =>
198 let 199 let
199 val t = mt env dtmap t 200 val t = mt env dtmap t
789 ("Neg", (L'.TFun (t, t), loc)), 790 ("Neg", (L'.TFun (t, t), loc)),
790 ("Plus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 791 ("Plus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
791 ("Minus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 792 ("Minus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
792 ("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 793 ("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
793 ("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 794 ("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
794 ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc) 795 ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
795 fun numEx (t, zero, neg, plus, minus, times, dv, md) = 796 ("Exp", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc)
797 fun numEx (t, zero, neg, plus, minus, times, dv, md, ex) =
796 ((L'.ERecord [("Zero", (L'.EPrim zero, loc), t), 798 ((L'.ERecord [("Zero", (L'.EPrim zero, loc), t),
797 ("Neg", neg, (L'.TFun (t, t), loc)), 799 ("Neg", neg, (L'.TFun (t, t), loc)),
798 ("Plus", plus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 800 ("Plus", plus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
799 ("Minus", minus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 801 ("Minus", minus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
800 ("Times", times, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 802 ("Times", times, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
801 ("Div", dv, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), 803 ("Div", dv, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
802 ("Mod", md, (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc), fm) 804 ("Mod", md, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
805 ("Exp", ex, (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc), fm)
803 806
804 fun ordTy t = 807 fun ordTy t =
805 (L'.TRecord [("Lt", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)), 808 (L'.TRecord [("Lt", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)),
806 ("Le", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc))], loc) 809 ("Le", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc))], loc)
807 fun ordEx (t, lt, le) = 810 fun ordEx (t, lt, le) =
1027 val t = monoType env t 1030 val t = monoType env t
1028 in 1031 in
1029 ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc), 1032 ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
1030 (L'.EField ((L'.ERel 0, loc), "Mod"), loc)), loc), fm) 1033 (L'.EField ((L'.ERel 0, loc), "Mod"), loc)), loc), fm)
1031 end 1034 end
1035 | L.ECApp ((L.EFfi ("Basis", "exp"), _), t) =>
1036 let
1037 val t = monoType env t
1038 in
1039 ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
1040 (L'.EField ((L'.ERel 0, loc), "Exp"), loc)), loc), fm)
1041 end
1032 | L.EFfi ("Basis", "num_int") => 1042 | L.EFfi ("Basis", "num_int") =>
1033 let 1043 let
1034 fun intBin s = 1044 fun intBin s =
1035 (L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc), 1045 (L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc),
1036 (L'.TFun ((L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "int"), loc)), loc), 1046 (L'.TFun ((L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "int"), loc)), loc),
1045 (L'.EUnop ("-", (L'.ERel 0, loc)), loc)), loc), 1055 (L'.EUnop ("-", (L'.ERel 0, loc)), loc)), loc),
1046 intBin "+", 1056 intBin "+",
1047 intBin "-", 1057 intBin "-",
1048 intBin "*", 1058 intBin "*",
1049 intBin "/", 1059 intBin "/",
1050 intBin "%") 1060 intBin "%",
1061 intBin "powl"
1062 )
1051 end 1063 end
1052 | L.EFfi ("Basis", "num_float") => 1064 | L.EFfi ("Basis", "num_float") =>
1053 let 1065 let
1054 fun floatBin s = 1066 fun floatBin s =
1055 (L'.EAbs ("x", (L'.TFfi ("Basis", "float"), loc), 1067 (L'.EAbs ("x", (L'.TFfi ("Basis", "float"), loc),
1065 (L'.EUnop ("-", (L'.ERel 0, loc)), loc)), loc), 1077 (L'.EUnop ("-", (L'.ERel 0, loc)), loc)), loc),
1066 floatBin "+", 1078 floatBin "+",
1067 floatBin "-", 1079 floatBin "-",
1068 floatBin "*", 1080 floatBin "*",
1069 floatBin "fdiv", 1081 floatBin "fdiv",
1070 floatBin "fmod") 1082 floatBin "fmod",
1083 floatBin "powf"
1084 )
1071 end 1085 end
1072 1086
1073 | L.ECApp ((L.EFfi ("Basis", "lt"), _), t) => 1087 | L.ECApp ((L.EFfi ("Basis", "lt"), _), t) =>
1074 let 1088 let
1075 val t = monoType env t 1089 val t = monoType env t