comparison src/monoize.sml @ 105:da760c34f5ed

Stringifying attributes
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 15:19:06 -0400
parents b1e5398a7f30
children d101cb1efe55
comparison
equal deleted inserted replaced
104:b1e5398a7f30 105:da760c34f5ed
77 | L.CUnit => poly () 77 | L.CUnit => poly ()
78 end 78 end
79 79
80 val dummyExp = (L'.EPrim (Prim.Int 0), E.dummySpan) 80 val dummyExp = (L'.EPrim (Prim.Int 0), E.dummySpan)
81 81
82 fun attrifyExp (e, tAll as (t, loc)) =
83 case t of
84 L'.TFfi ("Basis", "string") => e
85 | L'.TFfi ("Basis", "int") => (L'.EFfiApp ("Basis", "attrifyInt", [e]), loc)
86 | L'.TFfi ("Basis", "float") => (L'.EFfiApp ("Basis", "attrifyFloat", [e]), loc)
87 | _ => (E.errorAt loc "Don't know how to encode attribute type";
88 Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty tAll)];
89 dummyExp)
90
82 fun monoExp env (all as (e, loc)) = 91 fun monoExp env (all as (e, loc)) =
83 let 92 let
84 fun poly () = 93 fun poly () =
85 (E.errorAt loc "Unsupported expression"; 94 (E.errorAt loc "Unsupported expression";
86 Print.eprefaces' [("Expression", CorePrint.p_exp env all)]; 95 Print.eprefaces' [("Expression", CorePrint.p_exp env all)];
138 fun lowercaseFirst "" = "" 147 fun lowercaseFirst "" = ""
139 | lowercaseFirst s = str (Char.toLower (String.sub (s, 0))) ^ String.extract (s, 1, NONE) 148 | lowercaseFirst s = str (Char.toLower (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
140 149
141 val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc) 150 val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc)
142 in 151 in
143 foldl (fn ((x, e, _), s) => 152 foldl (fn ((x, e, t), s) =>
144 let 153 let
145 val xp = " " ^ lowercaseFirst x ^ "=\"" 154 val xp = " " ^ lowercaseFirst x ^ "=\""
146 in 155 in
147 (L'.EStrcat (s, 156 (L'.EStrcat (s,
148 (L'.EStrcat ((L'.EPrim (Prim.String xp), loc), 157 (L'.EStrcat ((L'.EPrim (Prim.String xp), loc),
149 (L'.EStrcat (e, 158 (L'.EStrcat (attrifyExp (e, t),
150 (L'.EPrim (Prim.String "\""), loc)), 159 (L'.EPrim (Prim.String "\""), loc)),
151 loc)), 160 loc)),
152 loc)), loc) 161 loc)), loc)
153 end) 162 end)
154 s xes 163 s xes