Mercurial > urweb

comparison src/especialize.sml @ 521:31aba58a5b5b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Ditch use of ElabEnv.env in Especialize, to realize big speed-up
author Adam Chlipala <adamc@hcoop.net>
date Thu, 27 Nov 2008 12:34:44 -0500
parents 3f20c22098af
children 3162bbf8e30f
comparison
equal deleted inserted replaced
520:3f20c22098af 521:31aba58a5b5b
102 maxName : int, 102 maxName : int,
103 funcs : func IM.map, 103 funcs : func IM.map,
104 decls : (string * int * con * exp * string) list 104 decls : (string * int * con * exp * string) list
105 } 105 }
106 106
107 fun kind x = x 107 fun id x = x
108 fun default (_, x, st) = (x, st) 108 fun default (_, x, st) = (x, st)
109 109
110 fun specialize' file = 110 fun specialize' file =
111 let 111 let
112 fun default' (_, fs) = fs 112 fun default' (_, fs) = fs
138 decl = default'} 138 decl = default'}
139 IS.empty file 139 IS.empty file
140 140
141 fun bind (env, b) = 141 fun bind (env, b) =
142 case b of 142 case b of
143 U.Decl.RelC (x, k) => E.pushCRel env x k 143 U.Decl.RelE xt => xt :: env
144 | U.Decl.NamedC (x, n, k, co) => E.pushCNamed env x n k co 144 | _ => env
145 | U.Decl.RelE (x, t) => E.pushERel env x t
146 | U.Decl.NamedE (x, n, t, eo, s) => E.pushENamed env x n t eo s
147 145
148 fun exp (env, e, st : state) = 146 fun exp (env, e, st : state) =
149 let 147 let
150 fun getApp e = 148 fun getApp e =
151 case e of 149 case e of
247 ("fxs'", Print.p_list 245 ("fxs'", Print.p_list
248 (CorePrint.p_exp E.empty) fxs'), 246 (CorePrint.p_exp E.empty) fxs'),
249 ("e", CorePrint.p_exp env (e, loc))]*) 247 ("e", CorePrint.p_exp env (e, loc))]*)
250 val (body', typ') = IS.foldl (fn (n, (body', typ')) => 248 val (body', typ') = IS.foldl (fn (n, (body', typ')) =>
251 let 249 let
252 val (x, xt) = E.lookupERel env n 250 val (x, xt) = List.nth (env, n)
253 in 251 in
254 ((EAbs (x, xt, typ', body'), 252 ((EAbs (x, xt, typ', body'),
255 loc), 253 loc),
256 (TFun (xt, typ'), loc)) 254 (TFun (xt, typ'), loc))
257 end) 255 end)
275 end 273 end
276 end 274 end
277 end 275 end
278 end 276 end
279 277
280 and specExp env = U.Exp.foldMapB {kind = kind, con = default, exp = exp, bind = bind} env 278 and specExp env = U.Exp.foldMapB {kind = id, con = default, exp = exp, bind = bind} env
281 279
282 val specDecl = U.Decl.foldMapB {kind = kind, con = default, exp = exp, decl = default, bind = bind} 280 val specDecl = U.Decl.foldMapB {kind = id, con = default, exp = exp, decl = default, bind = bind}
283 281
284 fun doDecl (d, (env, st : state, changed)) = 282 fun doDecl (d, (st : state, changed)) =
285 let 283 let
286 val env = E.declBinds env d 284 (*val befor = Time.now ()*)
287 285
288 val funcs = #funcs st 286 val funcs = #funcs st
289 val funcs = 287 val funcs =
290 case #1 d of 288 case #1 d of
291 DValRec vis => 289 DValRec vis =>
301 val st = {maxName = #maxName st, 299 val st = {maxName = #maxName st,
302 funcs = funcs, 300 funcs = funcs,
303 decls = []} 301 decls = []}
304 302
305 (*val () = Print.prefaces "decl" [("d", CorePrint.p_decl CoreEnv.empty d)]*) 303 (*val () = Print.prefaces "decl" [("d", CorePrint.p_decl CoreEnv.empty d)]*)
306 val (d', st) = specDecl env st d 304
305 val (d', st) = specDecl [] st d
306
307 (*val () = print "/decl\n"*) 307 (*val () = print "/decl\n"*)
308 308
309 val funcs = #funcs st 309 val funcs = #funcs st
310 val funcs = 310 val funcs =
311 case #1 d of 311 case #1 d of
327 | vis => 327 | vis =>
328 (true, case d' of 328 (true, case d' of
329 (DValRec vis', _) => [(DValRec (vis @ vis'), ErrorMsg.dummySpan)] 329 (DValRec vis', _) => [(DValRec (vis @ vis'), ErrorMsg.dummySpan)]
330 | _ => [(DValRec vis, ErrorMsg.dummySpan), d']) 330 | _ => [(DValRec vis, ErrorMsg.dummySpan), d'])
331 in 331 in
332 (ds, (env, 332 (*Print.prefaces "doDecl" [("d", CorePrint.p_decl E.empty d),
333 {maxName = #maxName st, 333 ("t", Print.PD.string (Real.toString (Time.toReal
334 (Time.- (Time.now (), befor)))))];*)
335 (ds, ({maxName = #maxName st,
334 funcs = funcs, 336 funcs = funcs,
335 decls = []}, changed)) 337 decls = []}, changed))
336 end 338 end
337 339
338 val (ds, (_, _, changed)) = ListUtil.foldlMapConcat doDecl 340 val (ds, (_, changed)) = ListUtil.foldlMapConcat doDecl
339 (E.empty, 341 ({maxName = U.File.maxName file + 1,
340 {maxName = U.File.maxName file + 1,
341 funcs = IM.empty, 342 funcs = IM.empty,
342 decls = []}, 343 decls = []},
343 false) 344 false)
344 file 345 file
345 in 346 in