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",