Mercurial > urweb

comparison src/monoize.sml @ 183:c0ea24dcb86f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Optimizing 'case' in Mono_reduce
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 13:30:27 -0400
parents d11754ffe252
children 19ee24bffbc0
comparison
equal deleted inserted replaced
182:d11754ffe252 183:c0ea24dcb86f
61 (L'.TRecord (map (fn (x, t) => (monoName env x, monoType env t)) xcs), loc) 61 (L'.TRecord (map (fn (x, t) => (monoName env x, monoType env t)) xcs), loc)
62 | L.TRecord _ => poly () 62 | L.TRecord _ => poly ()
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 | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) =>
67 (L'.TFfi ("Basis", "string"), loc)
66 68
67 | L.CRel _ => poly () 69 | L.CRel _ => poly ()
68 | L.CNamed n => 70 | L.CNamed n =>
69 let 71 let
70 val (_, xncs) = Env.lookupDatatype env n 72 val (_, xncs) = Env.lookupDatatype env n
162 case #1 e of 164 case #1 e of
163 L'.EClosure (fnam, [(L'.ERecord [], _)]) => 165 L'.EClosure (fnam, [(L'.ERecord [], _)]) =>
164 let 166 let
165 val (_, _, _, s) = Env.lookupENamed env fnam 167 val (_, _, _, s) = Env.lookupENamed env fnam
166 in 168 in
167 ((L'.EPrim (Prim.String s), loc), fm) 169 ((L'.EPrim (Prim.String ("/" ^ s)), loc), fm)
168 end 170 end
169 | L'.EClosure (fnam, args) => 171 | L'.EClosure (fnam, args) =>
170 let 172 let
171 val (_, ft, _, s) = Env.lookupENamed env fnam 173 val (_, ft, _, s) = Env.lookupENamed env fnam
172 val ft = monoType env ft 174 val ft = monoType env ft
185 fm) 187 fm)
186 end 188 end
187 | _ => (E.errorAt loc "Type mismatch encoding attribute"; 189 | _ => (E.errorAt loc "Type mismatch encoding attribute";
188 (e, fm)) 190 (e, fm))
189 in 191 in
190 attrify (args, ft, (L'.EPrim (Prim.String s), loc), fm) 192 attrify (args, ft, (L'.EPrim (Prim.String ("/" ^ s)), loc), fm)
191 end 193 end
192 | _ => 194 | _ =>
193 case t of 195 case t of
194 L'.TFfi ("Basis", "string") => ((L'.EFfiApp ("Basis", fk2s fk ^ "ifyString", [e]), loc), fm) 196 L'.TFfi ("Basis", "string") => ((L'.EFfiApp ("Basis", fk2s fk ^ "ifyString", [e]), loc), fm)
195 | L'.TFfi ("Basis", "int") => ((L'.EFfiApp ("Basis", fk2s fk ^ "ifyInt", [e]), loc), fm) 197 | L'.TFfi ("Basis", "int") => ((L'.EFfiApp ("Basis", fk2s fk ^ "ifyInt", [e]), loc), fm)