Mercurial > urweb
diff src/monoize.sml @ 417:e0e9e9eca1cb
Fix nasty de Bruijn substitution bug; TcSum demo
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 23 Oct 2008 12:58:35 -0400 |
| parents | c5a3d223f157 |
| children | 0ce90d4d9ae7 |
line wrap: on
line diff
--- a/src/monoize.sml Thu Oct 23 11:59:48 2008 -0400 +++ b/src/monoize.sml Thu Oct 23 12:58:35 2008 -0400 @@ -104,7 +104,8 @@ let val t = mt env dtmap t in - (L'.TRecord [("Neg", (L'.TFun (t, t), loc)), + (L'.TRecord [("Zero", t), + ("Neg", (L'.TFun (t, t), loc)), ("Plus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), ("Minus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), ("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), @@ -491,14 +492,16 @@ (dummyExp, fm)) fun numTy t = - (L'.TRecord [("Neg", (L'.TFun (t, t), loc)), + (L'.TRecord [("Zero", t), + ("Neg", (L'.TFun (t, t), loc)), ("Plus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), ("Minus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), ("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), ("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc) - fun numEx (t, neg, plus, minus, times, dv, md) = - ((L'.ERecord [("Neg", neg, (L'.TFun (t, t), loc)), + fun numEx (t, zero, neg, plus, minus, times, dv, md) = + ((L'.ERecord [("Zero", (L'.EPrim zero, loc), t), + ("Neg", neg, (L'.TFun (t, t), loc)), ("Plus", plus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), ("Minus", minus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), ("Times", times, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)), @@ -595,6 +598,13 @@ (L'.EBinop ("!strcmp", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc), fm) + | L.ECApp ((L.EFfi ("Basis", "zero"), _), t) => + let + val t = monoType env t + in + ((L'.EAbs ("r", numTy t, t, + (L'.EField ((L'.ERel 0, loc), "Zero"), loc)), loc), fm) + end | L.ECApp ((L.EFfi ("Basis", "neg"), _), t) => let val t = monoType env t @@ -647,6 +657,7 @@ (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc) in numEx ((L'.TFfi ("Basis", "int"), loc), + Prim.Int (Int64.fromInt 0), (L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "int"), loc), (L'.EUnop ("-", (L'.ERel 0, loc)), loc)), loc), @@ -666,6 +677,7 @@ (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc) in numEx ((L'.TFfi ("Basis", "float"), loc), + Prim.Float 0.0, (L'.EAbs ("x", (L'.TFfi ("Basis", "float"), loc), (L'.TFfi ("Basis", "float"), loc), (L'.EUnop ("-", (L'.ERel 0, loc)), loc)), loc),