Mercurial > urweb
comparison src/especialize.sml @ 1289:3b22c3c67f35
Reduce: Inline let-bound variables whose types involve functions
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sun, 22 Aug 2010 13:43:46 -0400 |
parents | 56bd4a4f6e66 |
children | 6c2e565adca6 |
comparison
equal
deleted
inserted
replaced
1288:fc7ecf8883b1 | 1289:3b22c3c67f35 |
---|---|
125 val compare = String.compare | 125 val compare = String.compare |
126 end) | 126 end) |
127 | 127 |
128 val mayNotSpec = ref SS.empty | 128 val mayNotSpec = ref SS.empty |
129 | 129 |
130 val functionInside = U.Con.exists {kind = fn _ => false, | |
131 con = fn TFun _ => true | |
132 | CFfi ("Basis", "transaction") => true | |
133 | CFfi ("Basis", "eq") => true | |
134 | CFfi ("Basis", "num") => true | |
135 | CFfi ("Basis", "ord") => true | |
136 | CFfi ("Basis", "show") => true | |
137 | CFfi ("Basis", "read") => true | |
138 | CFfi ("Basis", "sql_injectable_prim") => true | |
139 | CFfi ("Basis", "sql_injectable") => true | |
140 | _ => false} | |
141 | |
130 fun specialize' (funcs, specialized) file = | 142 fun specialize' (funcs, specialized) file = |
131 let | 143 let |
132 fun bind (env, b) = | 144 fun bind (env, b) = |
133 case b of | 145 case b of |
134 U.Decl.RelE xt => xt :: env | 146 U.Decl.RelE xt => xt :: env |
284 val (xs, st) = ListUtil.foldlMap (fn (e, st) => exp (env, e, st)) st xs | 296 val (xs, st) = ListUtil.foldlMap (fn (e, st) => exp (env, e, st)) st xs |
285 | 297 |
286 (*val () = Print.prefaces "Consider" [("e", CorePrint.p_exp CoreEnv.empty | 298 (*val () = Print.prefaces "Consider" [("e", CorePrint.p_exp CoreEnv.empty |
287 (e, ErrorMsg.dummySpan))]*) | 299 (e, ErrorMsg.dummySpan))]*) |
288 | 300 |
289 val functionInside = U.Con.exists {kind = fn _ => false, | |
290 con = fn TFun _ => true | |
291 | CFfi ("Basis", "transaction") => true | |
292 | CFfi ("Basis", "eq") => true | |
293 | CFfi ("Basis", "num") => true | |
294 | CFfi ("Basis", "ord") => true | |
295 | CFfi ("Basis", "show") => true | |
296 | CFfi ("Basis", "read") => true | |
297 | CFfi ("Basis", "sql_injectable_prim") => true | |
298 | CFfi ("Basis", "sql_injectable") => true | |
299 | _ => false} | |
300 val loc = ErrorMsg.dummySpan | 301 val loc = ErrorMsg.dummySpan |
301 | 302 |
302 fun findSplit av (xs, typ, fxs, fvs, fin) = | 303 fun findSplit av (xs, typ, fxs, fvs, fin) = |
303 case (#1 typ, xs) of | 304 case (#1 typ, xs) of |
304 (TFun (dom, ran), e :: xs') => | 305 (TFun (dom, ran), e :: xs') => |