[add static argument transformation, this replaces the old simple recursive transformation
John Meacham <john@repetae.net>**20061122034400] hunk ./E/Inline.hs 6
+    programDecomposedDs,
hunk ./E/Inline.hs 139
+programDecomposedDs :: Program -> [Either (TVr, E) [(TVr,E)]]
+programDecomposedDs prog = decomposeDs $ programDs prog 
hunk ./E/LambdaLift.hs 1
-module E.LambdaLift(lambdaLift)  where
+module E.LambdaLift(lambdaLift,staticArgumentTransform)  where
hunk ./E/LambdaLift.hs 12
+import E.Inline
hunk ./E/LambdaLift.hs 28
+import Support.CanType
hunk ./E/LambdaLift.hs 30
+import Doc.PPrint
hunk ./E/LambdaLift.hs 33
+annotateId mn x = case fromId x of
+    Just y -> toId (toName Val (mn,'f':show y))
+    Nothing -> toId (toName Val (mn,'f':show x))
+
+
+-- | transform simple recursive functions into non-recursive variants
+-- this is exactly the opposite of lambda lifting, but is a big win if the function ends up inlined
+-- and is conducive to other optimizations
+--
+-- in particular, the type arguments can almost always be transformed away from the recursive inner function
+
+staticArgumentTransform :: Program -> Program
+staticArgumentTransform prog = ans where
+    ans = programSetDs (concat ds') prog { progStats = progStats prog `mappend` nstat }
+    (ds',nstat) = runStatM $ mapM f (programDecomposedDs prog)
+    f (Left t) = return [t]
+    f (Right [(t,v@ELam {})]) | tvrIdent t `member` (freeVars v :: IdSet) = do
+        let nname = annotateId "R@" (tvrIdent t)
+            dropArgs = minimum [ countCommon args aps | aps <- collectApps ] where
+                args = map EVar $ snd $ fromLam v
+                countCommon (x:xs) (y:ys) | x == y = 1 + countCommon xs ys
+                countCommon _ _ = 0
+            collectApps = execWriter (ca v) where
+                ca e | (EVar v,as) <- fromAp e, tvrIdent v == tvrIdent t = tell [as] >> mapM_ ca as >> return e
+                ca e = emapE ca e
+            (body,args) = fromLam v
+            (droppedAs,keptAs) = splitAt dropArgs args
+            rbody = foldr ELam (subst t newV body)  keptAs
+            newV = foldr ELam (EVar tvr') [ t { tvrIdent = 0 } | t <- droppedAs ]
+            tvr' = tvr { tvrIdent = nname, tvrType = getType rbody }
+            ne' = foldr ELam (ELetRec [(tvr',rbody)]  (foldl EAp (EVar tvr') (map EVar keptAs))) args
+            --ne' = foldr ELam (ELetRec [(tvr',subst t (EVar tvr') v)]  (foldl EAp (EVar tvr') (map EVar as))) args
+        mtick $ "SimpleRecursive.{" ++ pprint t
+        return [(t,ne')]
+    f (Right ts) = return ts
hunk ./E/Program.hs 101
-{-
-programMapRecGroups :: Monad m => ([(TVr,E)] -> m [(TVr,E)]) -> Program -> m Program
-programMapRecGroups f prog = do
-    let pds = programDs prog
--}
hunk ./Main.hs 241
-annotateId mn x = case fromId x of
-    Just y -> toId (toName Val (mn,'f':show y))
-    Nothing -> toId (toName Val (mn,'f':show x))
hunk ./Main.hs 360
-        -- This transforms simple recursive routines into non-recursive ones that contain a local
-        -- recursive definition. this makes them easier to inline and optimize.
-        -- TODO - static argument transformation at same time?
-
-        let sRec mprog = case (rec,ns) of
-                (True,[(t,v@ELam {})]) | tvrIdent t `member` (freeVars v :: IdSet) -> do
-                    let nname = annotateId "R@" (tvrIdent t)
-                        tvr' = tvr { tvrIdent = nname, tvrType = tvrType t }
-                        (_,as) = fromLam v
-                        ne' = foldr ELam (ELetRec [(tvr',subst t (EVar tvr') v)]  (foldl EAp (EVar tvr') (map EVar as))) as
-                    putStrLn $ "\nSimple Recursive: " ++ pprint t
-                    return $ programSetDs [(t,ne')] mprog
-                _ -> return mprog
-        mprog <- transformProgram tparms { transformCategory = "SimpleRecursive", transformOperation = sRec } mprog
-
hunk ./Main.hs 364
+
+        -- | this catches more static arguments if we wait until after the initial normalizing simplification pass
+        mprog <- transformProgram tparms { transformCategory = "SimpleRecursive", transformOperation = return . staticArgumentTransform } mprog
+