diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-07-29 15:43:17 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-07-29 15:43:17 -0400 |
| commit | 846cf3f1661a8c91e40d80382db28c76dceaf1f0 (patch) | |
| tree | fe42c0c78660d50832719e1ae9fd9cda2d7e603f /src/monoize.sml | |
| parent | cb3b3831a07d6674a5fa02e3e8a1e4329b58cb34 (diff) | |
Storing datatype constructors in type references past monoize
Diffstat (limited to 'src/monoize.sml')
| -rw-r--r-- | src/monoize.sml | 13 |
1 files changed, 10 insertions, 3 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index e45597b2..c8060937 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -33,7 +33,7 @@ structure Env = CoreEnv structure L = Core structure L' = Mono -val dummyTyp = (L'.TNamed 0, E.dummySpan) +val dummyTyp = (L'.TDatatype (0, []), E.dummySpan) fun monoName env (all as (c, loc)) = let @@ -65,7 +65,14 @@ fun monoType env (all as (c, loc)) = (L'.TFfi ("Basis", "string"), loc) | L.CRel _ => poly () - | L.CNamed n => (L'.TNamed n, loc) + | L.CNamed n => + let + val (_, xncs) = Env.lookupDatatype env n + + val xncs = map (fn (x, n, to) => (x, n, Option.map (monoType env) to)) xncs + in + (L'.TDatatype (n, xncs), loc) + end | L.CFfi mx => (L'.TFfi mx, loc) | L.CApp _ => poly () | L.CAbs _ => poly () @@ -115,7 +122,7 @@ fun fooifyExp name env = | L'.TFfi ("Basis", "float") => (L'.EFfiApp ("Basis", name ^ "ifyFloat", [e]), loc) | L'.TRecord [] => (L'.EPrim (Prim.String ""), loc) - | L'.TNamed _ => (L'.EPrim (Prim.String "A"), loc) + | L'.TDatatype _ => (L'.EPrim (Prim.String "A"), loc) | _ => (E.errorAt loc "Don't know how to encode attribute type"; Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty tAll)]; |