Mercurial > urweb
comparison src/especialize.sml @ 1766:92cfc69419bd
Be more conservative in choosing candidates for Especialize, re: mutual recursion
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 17 May 2012 10:20:24 -0400 |
parents | 3cfc79f92db7 |
children | 62c18ecbfec4 |
comparison
equal
deleted
inserted
replaced
1765:be114e170b77 | 1766:92cfc69419bd |
---|---|
147 v as SOME (_, _ :: _) => v | 147 v as SOME (_, _ :: _) => v |
148 | _ => NONE | 148 | _ => NONE |
149 | 149 |
150 val maxInt = Option.getOpt (Int.maxInt, 9999) | 150 val maxInt = Option.getOpt (Int.maxInt, 9999) |
151 | 151 |
152 fun calcConstArgs enclosingFunction e = | 152 fun calcConstArgs enclosingFunctions e = |
153 let | 153 let |
154 fun ca depth e = | 154 fun ca depth e = |
155 case #1 e of | 155 case #1 e of |
156 EPrim _ => maxInt | 156 EPrim _ => maxInt |
157 | ERel _ => maxInt | 157 | ERel _ => maxInt |
158 | ENamed n => if n = enclosingFunction then 0 else maxInt | 158 | ENamed n => if IS.member (enclosingFunctions, n) then 0 else maxInt |
159 | ECon (_, _, _, NONE) => maxInt | 159 | ECon (_, _, _, NONE) => maxInt |
160 | ECon (_, _, _, SOME e) => ca depth e | 160 | ECon (_, _, _, SOME e) => ca depth e |
161 | EFfi _ => maxInt | 161 | EFfi _ => maxInt |
162 | EFfiApp (_, _, ecs) => foldl (fn ((e, _), d) => Int.min (ca depth e, d)) maxInt ecs | 162 | EFfiApp (_, _, ecs) => foldl (fn ((e, _), d) => Int.min (ca depth e, d)) maxInt ecs |
163 | EApp (e1, e2) => | 163 | EApp (e1, e2) => |
165 fun default () = Int.min (ca depth e1, ca depth e2) | 165 fun default () = Int.min (ca depth e1, ca depth e2) |
166 in | 166 in |
167 case getApp e of | 167 case getApp e of |
168 NONE => default () | 168 NONE => default () |
169 | SOME (f, args) => | 169 | SOME (f, args) => |
170 if f <> enclosingFunction then | 170 if not (IS.member (enclosingFunctions, f)) then |
171 default () | 171 default () |
172 else | 172 else |
173 let | 173 let |
174 fun visitArgs (count, args) = | 174 fun visitArgs (count, args) = |
175 case args of | 175 case args of |
418 (*val () = Print.prefaces "New one" | 418 (*val () = Print.prefaces "New one" |
419 [("name", Print.PD.string name), | 419 [("name", Print.PD.string name), |
420 ("f", Print.PD.string (Int.toString f)), | 420 ("f", Print.PD.string (Int.toString f)), |
421 ("|fvs|", Print.PD.string (Int.toString (IS.numItems fvs))), | 421 ("|fvs|", Print.PD.string (Int.toString (IS.numItems fvs))), |
422 ("|fxs|", Print.PD.string (Int.toString (length fxs))), | 422 ("|fxs|", Print.PD.string (Int.toString (length fxs))), |
423 ("fxs'", Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs'), | |
423 ("spec", Print.PD.string (Bool.toString (IS.member (#specialized st, f))))]*) | 424 ("spec", Print.PD.string (Bool.toString (IS.member (#specialized st, f))))]*) |
424 | 425 |
425 (*val () = Print.prefaces ("Yes(" ^ name ^ ")") | 426 (*val () = Print.prefaces ("Yes(" ^ name ^ ")") |
426 [("fxs'", | 427 [("fxs'", |
427 Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs')]*) | 428 Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs')]*) |
454 val funcs = IM.insert (#funcs st, f, {name = name, | 455 val funcs = IM.insert (#funcs st, f, {name = name, |
455 args = args, | 456 args = args, |
456 body = body, | 457 body = body, |
457 typ = typ, | 458 typ = typ, |
458 tag = tag, | 459 tag = tag, |
459 constArgs = calcConstArgs f body}) | 460 constArgs = calcConstArgs (IS.singleton f) body}) |
460 | 461 |
461 val st = { | 462 val st = { |
462 maxName = f' + 1, | 463 maxName = f' + 1, |
463 funcs = funcs, | 464 funcs = funcs, |
464 decls = #decls st, | 465 decls = #decls st, |
513 | 514 |
514 val funcs = #funcs st | 515 val funcs = #funcs st |
515 val funcs = | 516 val funcs = |
516 case #1 d of | 517 case #1 d of |
517 DValRec vis => | 518 DValRec vis => |
518 foldl (fn ((x, n, c, e, tag), funcs) => | 519 let |
519 IM.insert (funcs, n, {name = x, | 520 val fs = foldl (fn ((_, n, _, _, _), fs) => IS.add (fs, n)) IS.empty vis |
520 args = KM.empty, | 521 val constArgs = foldl (fn ((_, _, _, e, _), constArgs) => |
521 body = e, | 522 Int.min (constArgs, calcConstArgs fs e)) |
522 typ = c, | 523 maxInt vis |
523 tag = tag, | 524 in |
524 constArgs = calcConstArgs n e})) | 525 foldl (fn ((x, n, c, e, tag), funcs) => |
525 funcs vis | 526 IM.insert (funcs, n, {name = x, |
527 args = KM.empty, | |
528 body = e, | |
529 typ = c, | |
530 tag = tag, | |
531 constArgs = constArgs})) | |
532 funcs vis | |
533 end | |
526 | _ => funcs | 534 | _ => funcs |
527 | 535 |
528 val st = {maxName = #maxName st, | 536 val st = {maxName = #maxName st, |
529 funcs = funcs, | 537 funcs = funcs, |
530 decls = [], | 538 decls = [], |
601 IM.insert (funcs, n, {name = x, | 609 IM.insert (funcs, n, {name = x, |
602 args = KM.empty, | 610 args = KM.empty, |
603 body = e, | 611 body = e, |
604 typ = c, | 612 typ = c, |
605 tag = tag, | 613 tag = tag, |
606 constArgs = calcConstArgs n e}) | 614 constArgs = calcConstArgs (IS.singleton n) e}) |
607 | DVal (_, n, _, (ENamed n', _), _) => | 615 | DVal (_, n, _, (ENamed n', _), _) => |
608 (case IM.find (funcs, n') of | 616 (case IM.find (funcs, n') of |
609 NONE => funcs | 617 NONE => funcs |
610 | SOME v => IM.insert (funcs, n, v)) | 618 | SOME v => IM.insert (funcs, n, v)) |
611 | _ => funcs | 619 | _ => funcs |