Mercurial > urweb

comparison src/especialize.sml @ 487:33d5bd69da00

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Get threadedBlog to work
author Adam Chlipala <adamc@hcoop.net>
date Tue, 11 Nov 2008 11:49:51 -0500
parents 3ce20b0b6914
children 5521bb0b4014
comparison
equal deleted inserted replaced
486:8e055bbbd28b 487:33d5bd69da00
186 in 186 in
187 if List.all (fn (ERel _, _) => false | _ => true) xs' 187 if List.all (fn (ERel _, _) => false | _ => true) xs'
188 andalso List.exists (fn (ERecord [], _) => false | _ => true) xs' 188 andalso List.exists (fn (ERecord [], _) => false | _ => true) xs'
189 andalso not (IS.member (actionable, f)) 189 andalso not (IS.member (actionable, f))
190 andalso hasFunarg (typ, xs') then 190 andalso hasFunarg (typ, xs') then
191 (#1 (foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan)) 191 let
192 body xs'), 192 val e = foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan))
193 st) 193 body xs'
194 in
195 (*Print.prefaces "Unfolded"
196 [("e", CorePrint.p_exp CoreEnv.empty e)];*)
197 (#1 e, st)
198 end
194 else 199 else
195 (e, st) 200 (e, st)
196 end) 201 end)
197 | SOME (f, xs, xs') => 202 | SOME (f, xs, xs') =>
198 case IM.find (#funcs st, f) of 203 case IM.find (#funcs st, f) of
219 in 224 in
220 case subBody (body, typ, xs) of 225 case subBody (body, typ, xs) of
221 NONE => (e, st) 226 NONE => (e, st)
222 | SOME (body', typ') => 227 | SOME (body', typ') =>
223 let 228 let
229 (*val () = Print.prefaces "sub'd"
230 [("body'", CorePrint.p_exp CoreEnv.empty body')]*)
231
224 val f' = #maxName st 232 val f' = #maxName st
225 val funcs = IM.insert (#funcs st, f, {name = name, 233 val funcs = IM.insert (#funcs st, f, {name = name,
226 args = KM.insert (args, 234 args = KM.insert (args,
227 xs, f'), 235 xs, f'),
228 body = body, 236 body = body,
232 maxName = f' + 1, 240 maxName = f' + 1,
233 funcs = funcs, 241 funcs = funcs,
234 decls = #decls st 242 decls = #decls st
235 } 243 }
236 244
245 (*val () = print ("Created " ^ Int.toString f' ^ " from "
246 ^ Int.toString f ^ "\n")
247 val () = Print.prefaces "body'"
248 [("body'", CorePrint.p_exp CoreEnv.empty body')]*)
237 val (body', st) = specExp st body' 249 val (body', st) = specExp st body'
250 (*val () = Print.prefaces "body''"
251 [("body'", CorePrint.p_exp CoreEnv.empty body')]*)
238 val e' = foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan)) 252 val e' = foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan))
239 (ENamed f', ErrorMsg.dummySpan) xs' 253 (ENamed f', ErrorMsg.dummySpan) xs'
240 in 254 in
241 (#1 e', 255 (#1 e',
242 {maxName = #maxName st, 256 {maxName = #maxName st,
314 (changed, ds) 328 (changed, ds)
315 end 329 end
316 330
317 fun specialize file = 331 fun specialize file =
318 let 332 let
333 (*val () = Print.prefaces "Intermediate" [("file", CorePrint.p_file CoreEnv.empty file)];*)
319 val (changed, file) = specialize' file 334 val (changed, file) = specialize' file
320 in 335 in
321 if changed then 336 if changed then
322 specialize (ReduceLocal.reduce file) 337 specialize (ReduceLocal.reduce file)
323 else 338 else