Mercurial > urweb

comparison src/monoize.sml @ 168:25b169416ea8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Storing datatype constructors in type references past monoize
author Adam Chlipala <adamc@hcoop.net>
date Tue, 29 Jul 2008 15:43:17 -0400
parents 2be573fec9a6
children 5d030ee143e2
comparison
equal deleted inserted replaced
167:2be573fec9a6 168:25b169416ea8
31 structure Env = CoreEnv 31 structure Env = CoreEnv
32 32
33 structure L = Core 33 structure L = Core
34 structure L' = Mono 34 structure L' = Mono
35 35
36 val dummyTyp = (L'.TNamed 0, E.dummySpan) 36 val dummyTyp = (L'.TDatatype (0, []), E.dummySpan)
37 37
38 fun monoName env (all as (c, loc)) = 38 fun monoName env (all as (c, loc)) =
39 let 39 let
40 fun poly () = 40 fun poly () =
41 (E.errorAt loc "Unsupported name constructor"; 41 (E.errorAt loc "Unsupported name constructor";
63 63
64 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) => 64 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) =>
65 (L'.TFfi ("Basis", "string"), loc) 65 (L'.TFfi ("Basis", "string"), loc)
66 66
67 | L.CRel _ => poly () 67 | L.CRel _ => poly ()
68 | L.CNamed n => (L'.TNamed n, loc) 68 | L.CNamed n =>
69 let
70 val (_, xncs) = Env.lookupDatatype env n
71
72 val xncs = map (fn (x, n, to) => (x, n, Option.map (monoType env) to)) xncs
73 in
74 (L'.TDatatype (n, xncs), loc)
75 end
69 | L.CFfi mx => (L'.TFfi mx, loc) 76 | L.CFfi mx => (L'.TFfi mx, loc)
70 | L.CApp _ => poly () 77 | L.CApp _ => poly ()
71 | L.CAbs _ => poly () 78 | L.CAbs _ => poly ()
72 79
73 | L.CName _ => poly () 80 | L.CName _ => poly ()
113 L'.TFfi ("Basis", "string") => (L'.EFfiApp ("Basis", name ^ "ifyString", [e]), loc) 120 L'.TFfi ("Basis", "string") => (L'.EFfiApp ("Basis", name ^ "ifyString", [e]), loc)
114 | L'.TFfi ("Basis", "int") => (L'.EFfiApp ("Basis", name ^ "ifyInt", [e]), loc) 121 | L'.TFfi ("Basis", "int") => (L'.EFfiApp ("Basis", name ^ "ifyInt", [e]), loc)
115 | L'.TFfi ("Basis", "float") => (L'.EFfiApp ("Basis", name ^ "ifyFloat", [e]), loc) 122 | L'.TFfi ("Basis", "float") => (L'.EFfiApp ("Basis", name ^ "ifyFloat", [e]), loc)
116 | L'.TRecord [] => (L'.EPrim (Prim.String ""), loc) 123 | L'.TRecord [] => (L'.EPrim (Prim.String ""), loc)
117 124
118 | L'.TNamed _ => (L'.EPrim (Prim.String "A"), loc) 125 | L'.TDatatype _ => (L'.EPrim (Prim.String "A"), loc)
119 126
120 | _ => (E.errorAt loc "Don't know how to encode attribute type"; 127 | _ => (E.errorAt loc "Don't know how to encode attribute type";
121 Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty tAll)]; 128 Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty tAll)];
122 dummyExp) 129 dummyExp)
123 in 130 in