diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-04-30 11:07:29 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-04-30 11:07:29 -0400 |
| commit | 7a3ba5558cb363006aae188e02dd57dda833d356 (patch) | |
| tree | be8dc60f901b2cab9ec630d505bf152d1d19340e /src/monoize.sml | |
| parent | 0264695e9a76f87e6164c489c34af63fa893889d (diff) | |
Basis.list
Diffstat (limited to 'src/monoize.sml')
| -rw-r--r-- | src/monoize.sml | 31 |
1 files changed, 30 insertions, 1 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index ea191802..1ecf7a20 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -94,6 +94,8 @@ fun monoType env = | L.CApp ((L.CFfi ("Basis", "option"), _), t) => (L'.TOption (mt env dtmap t), loc) + | L.CApp ((L.CFfi ("Basis", "list"), _), t) => + (L'.TList (mt env dtmap t), loc) | L.CApp ((L.CFfi ("Basis", "eq"), _), t) => let @@ -494,6 +496,9 @@ fun monoPatCon env pc = val dummyPat = (L'.PPrim (Prim.Int 0), ErrorMsg.dummySpan) + +fun listify t = (L'.TRecord [("1", t), ("2", (L'.TList t, #2 t))], #2 t) + fun monoPat env (all as (p, loc)) = let fun poly () = @@ -506,8 +511,12 @@ fun monoPat env (all as (p, loc)) = | L.PVar (x, t) => (L'.PVar (x, monoType env t), loc) | L.PPrim p => (L'.PPrim p, loc) | L.PCon (dk, pc, [], po) => (L'.PCon (dk, monoPatCon env pc, Option.map (monoPat env) po), loc) + | L.PCon (L.Option, L.PConFfi {mod = "Basis", datatyp = "list", ...}, [t], NONE) => + (L'.PNone (listify (monoType env t)), loc) + | L.PCon (L.Option, L.PConFfi {mod = "Basis", datatyp = "list", ...}, [t], SOME p) => + (L'.PSome (listify (monoType env t), monoPat env p), loc) | L.PCon (L.Option, _, [t], NONE) => (L'.PNone (monoType env t), loc) - | L.PCon (L.Option, _, [t], SOME p) => (L'.PSome (monoType env t, monoPat env p), loc) + | L.PCon (L.Option, pc, [t], SOME p) => (L'.PSome (monoType env t, monoPat env p), loc) | L.PCon _ => poly () | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, monoPat env p, monoType env t)) xps), loc) end @@ -613,6 +622,14 @@ fun monoExp (env, st, fm) (all as (e, loc)) = in ((L'.ECon (dk, monoPatCon env pc, eo), loc), fm) end + | L.ECon (L.Option, L.PConFfi {mod = "Basis", datatyp = "list", ...}, [t], NONE) => + ((L'.ENone (listify (monoType env t)), loc), fm) + | L.ECon (L.Option, L.PConFfi {mod = "Basis", datatyp = "list", ...}, [t], SOME e) => + let + val (e, fm) = monoExp (env, st, fm) e + in + ((L'.ESome (listify (monoType env t), e), loc), fm) + end | L.ECon (L.Option, _, [t], NONE) => ((L'.ENone (monoType env t), loc), fm) | L.ECon (L.Option, _, [t], SOME e) => @@ -2892,6 +2909,18 @@ fun monoDecl (env, fm) (all as (d, loc)) = in SOME (env', fm, [d]) end + | L.DDatatype ("list", n, [_], [("Nil", _, NONE), + ("Cons", _, SOME (L.TRecord (L.CRecord (_, + [((L.CName "1", _), + (L.CRel 0, _)), + ((L.CName "2", _), + (L.CApp ((L.CNamed n', _), + (L.CRel 0, _)), + _))]), _), _))]) => + if n = n' then + NONE + else + poly () | L.DDatatype _ => poly () | L.DVal (x, n, t, e, s) => let |