# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1337264424 14400
# Node ID 92cfc69419bd343fdbda9bb00d0f29b5213929c0
# Parent  be114e170b77724f343faf881b6c9ea2390e98ee
Be more conservative in choosing candidates for Especialize, re: mutual recursion

diff -r be114e170b77 -r 92cfc69419bd src/especialize.sml
--- a/src/especialize.sml	Thu May 17 03:22:34 2012 +0400
+++ b/src/especialize.sml	Thu May 17 10:20:24 2012 -0400
@@ -149,13 +149,13 @@
 
 val maxInt = Option.getOpt (Int.maxInt, 9999)
 
-fun calcConstArgs enclosingFunction e =
+fun calcConstArgs enclosingFunctions e =
     let
         fun ca depth e =
             case #1 e of
                 EPrim _ => maxInt
               | ERel _ => maxInt
-              | ENamed n => if n = enclosingFunction then 0 else maxInt
+              | ENamed n => if IS.member (enclosingFunctions, n) then 0 else maxInt
               | ECon (_, _, _, NONE) => maxInt
               | ECon (_, _, _, SOME e) => ca depth e
               | EFfi _ => maxInt
@@ -167,7 +167,7 @@
                     case getApp e of
                         NONE => default ()
                       | SOME (f, args) =>
-                        if f <> enclosingFunction then
+                        if not (IS.member (enclosingFunctions, f)) then
                             default ()
                         else
                             let
@@ -420,6 +420,7 @@
                                                   ("f", Print.PD.string (Int.toString f)),
                                                   ("|fvs|", Print.PD.string (Int.toString (IS.numItems fvs))),
                                                   ("|fxs|", Print.PD.string (Int.toString (length fxs))),
+                                                  ("fxs'", Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs'),
                                                   ("spec", Print.PD.string (Bool.toString (IS.member (#specialized st, f))))]*)
 
                                         (*val () = Print.prefaces ("Yes(" ^ name ^ ")")
@@ -456,7 +457,7 @@
                                                                                       body = body,
                                                                                       typ = typ,
                                                                                       tag = tag,
-                                                                                      constArgs = calcConstArgs f body})
+                                                                                      constArgs = calcConstArgs (IS.singleton f) body})
 
                                                 val st = {
                                                     maxName = f' + 1,
@@ -515,14 +516,21 @@
                 val funcs = 
                     case #1 d of
                         DValRec vis =>
-                        foldl (fn ((x, n, c, e, tag), funcs) =>
-                                  IM.insert (funcs, n, {name = x,
-                                                        args = KM.empty,
-                                                        body = e,
-                                                        typ = c,
-                                                        tag = tag,
-                                                        constArgs = calcConstArgs n e}))
-                              funcs vis
+                        let
+                            val fs = foldl (fn ((_, n, _, _, _), fs) => IS.add (fs, n)) IS.empty vis
+                            val constArgs = foldl (fn ((_, _, _, e, _), constArgs) =>
+                                                      Int.min (constArgs, calcConstArgs fs e))
+                                                  maxInt vis
+                        in
+                            foldl (fn ((x, n, c, e, tag), funcs) =>
+                                      IM.insert (funcs, n, {name = x,
+                                                            args = KM.empty,
+                                                            body = e,
+                                                            typ = c,
+                                                            tag = tag,
+                                                            constArgs = constArgs}))
+                                  funcs vis
+                        end
                       | _ => funcs
 
                 val st = {maxName = #maxName st,
@@ -603,7 +611,7 @@
                                               body = e,
                                               typ = c,
                                               tag = tag,
-                                              constArgs = calcConstArgs n e})
+                                              constArgs = calcConstArgs (IS.singleton n) e})
                       | DVal (_, n, _, (ENamed n', _), _) =>
                         (case IM.find (funcs, n') of
                              NONE => funcs