Mercurial > urweb
comparison src/especialize.sml @ 1181:618f9f458da9
Got split1 working, but noticed a nasty type inference bug with transplanted unification variables
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 06 Mar 2010 19:14:48 -0500 |
parents | ac3dbbc85c6e |
children | 338be96f8533 |
comparison
equal
deleted
inserted
replaced
1180:ac3dbbc85c6e | 1181:618f9f458da9 |
---|---|
41 | 41 |
42 structure KM = BinaryMapFn(K) | 42 structure KM = BinaryMapFn(K) |
43 structure IM = IntBinaryMap | 43 structure IM = IntBinaryMap |
44 structure IS = IntBinarySet | 44 structure IS = IntBinarySet |
45 | 45 |
46 val isOpen = U.Exp.exists {kind = fn _ => false, | |
47 con = fn c => | |
48 case c of | |
49 CRel _ => true | |
50 | _ => false, | |
51 exp = fn _ => false} | |
52 | |
46 val freeVars = U.Exp.foldB {kind = fn (_, _, xs) => xs, | 53 val freeVars = U.Exp.foldB {kind = fn (_, _, xs) => xs, |
47 con = fn (_, _, xs) => xs, | 54 con = fn (_, _, xs) => xs, |
48 exp = fn (bound, e, xs) => | 55 exp = fn (bound, e, xs) => |
49 case e of | 56 case e of |
50 ERel x => | 57 ERel x => |
219 let | 226 let |
220 val (e, st) = exp (env, e, st) | 227 val (e, st) = exp (env, e, st) |
221 in | 228 in |
222 ((ECApp (e, c), loc), st) | 229 ((ECApp (e, c), loc), st) |
223 end | 230 end |
224 | ECAbs _ => (e, st) | 231 | ECAbs (x, k, e) => |
232 let | |
233 val (e, st) = exp (env, e, st) | |
234 in | |
235 ((ECAbs (x, k, e), loc), st) | |
236 end | |
225 | EKAbs _ => (e, st) | 237 | EKAbs _ => (e, st) |
226 | EKApp (e, k) => | 238 | EKApp (e, k) => |
227 let | 239 let |
228 val (e, st) = exp (env, e, st) | 240 val (e, st) = exp (env, e, st) |
229 in | 241 in |
347 in | 359 in |
348 (*Print.preface ("fxs'", Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs');*) | 360 (*Print.preface ("fxs'", Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs');*) |
349 if not fin | 361 if not fin |
350 orelse List.all (fn (ERel _, _) => true | 362 orelse List.all (fn (ERel _, _) => true |
351 | _ => false) fxs' | 363 | _ => false) fxs' |
364 orelse List.exists isOpen fxs' | |
352 orelse (IS.numItems fvs >= length fxs | 365 orelse (IS.numItems fvs >= length fxs |
353 andalso IS.exists (fn n => functionInside (#2 (List.nth (env, n)))) fvs) then | 366 andalso IS.exists (fn n => functionInside (#2 (List.nth (env, n)))) fvs) then |
354 ((*Print.prefaces "No" [("name", Print.PD.string name), | 367 ((*Print.prefaces "No" [("name", Print.PD.string name), |
355 ("f", Print.PD.string (Int.toString f)), | 368 ("f", Print.PD.string (Int.toString f)), |
356 ("xs", | 369 ("xs", |