comparison src/especialize.sml @ 626:230654093b51

demo/hello compiles with kind polymorphism
author Adam Chlipala <adamc@hcoop.net>
date Sun, 22 Feb 2009 17:17:01 -0500
parents 3162bbf8e30f
children 9864b64b1700
comparison
equal deleted inserted replaced
625:47947d6e9750 626:230654093b51
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 freeVars = U.Exp.foldB {kind = fn (_, xs) => xs, 46 val freeVars = U.Exp.foldB {kind = fn (_, _, xs) => xs,
47 con = fn (_, _, xs) => xs, 47 con = fn (_, _, xs) => xs,
48 exp = fn (bound, e, xs) => 48 exp = fn (bound, e, xs) =>
49 case e of 49 case e of
50 ERel x => 50 ERel x =>
51 if x >= bound then 51 if x >= bound then
78 in 78 in
79 pof (0, ls) 79 pof (0, ls)
80 end 80 end
81 81
82 fun squish fvs = 82 fun squish fvs =
83 U.Exp.mapB {kind = fn k => k, 83 U.Exp.mapB {kind = fn _ => fn k => k,
84 con = fn _ => fn c => c, 84 con = fn _ => fn c => c,
85 exp = fn bound => fn e => 85 exp = fn bound => fn e =>
86 case e of 86 case e of
87 ERel x => 87 ERel x =>
88 if x >= bound then 88 if x >= bound then
108 maxName : int, 108 maxName : int,
109 funcs : func IM.map, 109 funcs : func IM.map,
110 decls : (string * int * con * exp * string) list 110 decls : (string * int * con * exp * string) list
111 } 111 }
112 112
113 fun id x = x
114 fun default (_, x, st) = (x, st) 113 fun default (_, x, st) = (x, st)
115 114
116 fun specialize' file = 115 fun specialize' file =
117 let 116 let
118 fun default' (_, fs) = fs 117 fun default' (_, fs) = fs
279 end 278 end
280 end 279 end
281 end 280 end
282 end 281 end
283 282
284 and specExp env = U.Exp.foldMapB {kind = id, con = default, exp = exp, bind = bind} env 283 and specExp env = U.Exp.foldMapB {kind = default, con = default, exp = exp, bind = bind} env
285 284
286 val specDecl = U.Decl.foldMapB {kind = id, con = default, exp = exp, decl = default, bind = bind} 285 val specDecl = U.Decl.foldMapB {kind = default, con = default, exp = exp, decl = default, bind = bind}
287 286
288 fun doDecl (d, (st : state, changed)) = 287 fun doDecl (d, (st : state, changed)) =
289 let 288 let
290 (*val befor = Time.now ()*) 289 (*val befor = Time.now ()*)
291 290