Mercurial > urweb
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 |