Mercurial > urweb
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 |