Mercurial > urweb

comparison src/monoize.sml @ 820:91f465ded07e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Change monoization of monads to allow partial applications of operations
author Adam Chlipala <adamc@hcoop.net>
date Sat, 23 May 2009 10:14:51 -0400
parents 066493f7f008
children 395a5d450cc0
comparison
equal deleted inserted replaced
819:cb30dd2ba353 820:91f465ded07e
92 92
93 | L.CApp ((L.CFfi ("Basis", "option"), _), t) => 93 | L.CApp ((L.CFfi ("Basis", "option"), _), t) =>
94 (L'.TOption (mt env dtmap t), loc) 94 (L'.TOption (mt env dtmap t), loc)
95 | L.CApp ((L.CFfi ("Basis", "list"), _), t) => 95 | L.CApp ((L.CFfi ("Basis", "list"), _), t) =>
96 (L'.TList (mt env dtmap t), loc) 96 (L'.TList (mt env dtmap t), loc)
97
98 | L.CApp ((L.CFfi ("Basis", "monad"), _), _) =>
99 (L'.TRecord [], loc)
97 100
98 | L.CApp ((L.CFfi ("Basis", "eq"), _), t) => 101 | L.CApp ((L.CFfi ("Basis", "eq"), _), t) =>
99 let 102 let
100 val t = mt env dtmap t 103 val t = mt env dtmap t
101 in 104 in
1094 ("ReadError", (L'.EFfi ("Basis", "stringToTime_error"), loc), readErrType (t, loc))], 1097 ("ReadError", (L'.EFfi ("Basis", "stringToTime_error"), loc), readErrType (t, loc))],
1095 loc), 1098 loc),
1096 fm) 1099 fm)
1097 end 1100 end
1098 1101
1099 | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), _), _), t), _), 1102 | L.EFfi ("Basis", "transaction_monad") => ((L'.ERecord [], loc), fm)
1100 (L.EFfi ("Basis", "transaction_monad"), _)) => 1103 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), (L.CFfi ("Basis", "transaction"), _)), _), t) =>
1101 let 1104 let
1102 val t = monoType env t 1105 val t = monoType env t
1103 in 1106 in
1104 ((L'.EAbs ("x", t, 1107 ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (t, (L'.TFun ((L'.TRecord [], loc), t), loc)), loc),
1105 (L'.TFun ((L'.TRecord [], loc), t), loc), 1108 (L'.EAbs ("x", t,
1106 (L'.EAbs ("_", (L'.TRecord [], loc), t, 1109 (L'.TFun ((L'.TRecord [], loc), t), loc),
1107 (L'.ERel 1, loc)), loc)), loc), fm) 1110 (L'.EAbs ("_", (L'.TRecord [], loc), t,
1108 end 1111 (L'.ERel 1, loc)), loc)), loc)), loc),
1109 | L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), _), _), t1), _), t2), _), 1112 fm)
1110 (L.EFfi ("Basis", "transaction_monad"), _)) => 1113 end
1114 | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), (L.CFfi ("Basis", "transaction"), _)), _),
1115 t1), _), t2) =>
1111 let 1116 let
1112 val t1 = monoType env t1 1117 val t1 = monoType env t1
1113 val t2 = monoType env t2 1118 val t2 = monoType env t2
1114 val un = (L'.TRecord [], loc) 1119 val un = (L'.TRecord [], loc)
1115 val mt1 = (L'.TFun (un, t1), loc) 1120 val mt1 = (L'.TFun (un, t1), loc)
1116 val mt2 = (L'.TFun (un, t2), loc) 1121 val mt2 = (L'.TFun (un, t2), loc)
1117 in 1122 in
1118 ((L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc)), loc), 1123 ((L'.EAbs ("_", un,
1119 (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc), 1124 (L'.TFun (mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc)), loc)), loc),
1120 (L'.EAbs ("_", un, un, 1125 (L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc)), loc),
1121 (L'.ELet ("r", t1, (L'.EApp ((L'.ERel 2, loc), 1126 (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc),
1122 (L'.ERecord [], loc)), loc), 1127 (L'.EAbs ("_", un, un,
1123 (L'.EApp ( 1128 (L'.ELet ("r", t1, (L'.EApp ((L'.ERel 2, loc),
1124 (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc), 1129 (L'.ERecord [], loc)), loc),
1125 (L'.ERecord [], loc)), 1130 (L'.EApp (
1126 loc)), loc)), loc)), loc)), loc), 1131 (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc),
1132 (L'.ERecord [], loc)),
1133 loc)), loc)), loc)), loc)), loc)), loc),
1127 fm) 1134 fm)
1128 end 1135 end
1129 1136
1130 | L.EApp ((L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), _), _), _), _), t2), _), 1137 | L.EApp ((L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), _), _), _), _), t2), _),
1131 (L.EFfi ("Basis", "transaction_monad"), _)), _), 1138 (L.EFfi ("Basis", "transaction_monad"), _)), _),
1211 val (e, fm) = monoExp (env, st, fm) e 1218 val (e, fm) = monoExp (env, st, fm) e
1212 in 1219 in
1213 ((L'.EApp (e, (L'.ERecord [], loc)), loc), fm) 1220 ((L'.EApp (e, (L'.ERecord [], loc)), loc), fm)
1214 end 1221 end
1215 1222
1216 | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), _), _), t), _), 1223 | L.EFfi ("Basis", "signal_monad") => ((L'.ERecord [], loc), fm)
1217 (L.EFfi ("Basis", "signal_monad"), _)) => 1224 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), (L.CFfi ("Basis", "signal"), _)), _), t) =>
1218 let 1225 let
1219 val t = monoType env t 1226 val t = monoType env t
1220 in 1227 in
1221 ((L'.EAbs ("x", t, (L'.TSignal t, loc), 1228 ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (t, (L'.TSignal t, loc)), loc),
1222 (L'.ESignalReturn (L'.ERel 0, loc), loc)), loc), 1229 (L'.EAbs ("x", t, (L'.TSignal t, loc),
1223 fm) 1230 (L'.ESignalReturn (L'.ERel 0, loc), loc)), loc)), loc),
1224 end 1231 fm)
1225 | L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), _), _), t1), _), t2), _), 1232 end
1226 (L.EFfi ("Basis", "signal_monad"), _)) => 1233 | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), (L.CFfi ("Basis", "signal"), _)), _),
1234 t1), _), t2) =>
1227 let 1235 let
1228 val t1 = monoType env t1 1236 val t1 = monoType env t1
1229 val t2 = monoType env t2 1237 val t2 = monoType env t2
1230 val un = (L'.TRecord [], loc) 1238 val un = (L'.TRecord [], loc)
1231 val mt1 = (L'.TSignal t1, loc) 1239 val mt1 = (L'.TSignal t1, loc)
1232 val mt2 = (L'.TSignal t2, loc) 1240 val mt2 = (L'.TSignal t2, loc)
1233 in 1241 in
1234 ((L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), mt2), loc), 1242 ((L'.EAbs ("_", un, (L'.TFun (mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), mt2), loc)), loc),
1235 (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), mt2, 1243 (L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), mt2), loc),
1236 (L'.ESignalBind ((L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc), 1244 (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), mt2,
1245 (L'.ESignalBind ((L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)),
1246 loc),
1237 fm) 1247 fm)
1238 end 1248 end
1239 | L.ECApp ((L.EFfi ("Basis", "signal"), _), t) => 1249 | L.ECApp ((L.EFfi ("Basis", "signal"), _), t) =>
1240 let 1250 let
1241 val t = monoType env t 1251 val t = monoType env t