[when devolving grin, iterate until fixpoint is reached when deciding what arguments need to be lifted
John Meacham <john@repetae.net>**20090224104352
 Ignore-this: 4cfbf1f9e4b7dfe511e119d94237ea1d
] hunk ./Grin/Devolve.hs 1
-module Grin.Devolve(twiddleGrin,devolveTransform,devolveGrin) where
+module Grin.Devolve(twiddleGrin,devolveTransform) where
hunk ./Grin/Devolve.hs 6
+import Data.Maybe
hunk ./Grin/Devolve.hs 11
+import Util.SetLike
hunk ./Grin/Devolve.hs 18
+{-# NOINLINE devolveTransform #-}
hunk ./Grin/Devolve.hs 32
+    putStrLn "-- devolve"
hunk ./Grin/Devolve.hs 37
+                iterZ :: Bool -> Map.Map Tag (Set.Set Val) -> [FuncDef] -> Map.Map Tag (Set.Set Val)
+                iterZ b pmap (fd@FuncDef { funcDefName = name, funcDefBody = as :-> r }:fs) = iterZ (b || xs' /= xs) (Map.insert name xs pmap) fs where
+                    xs = Set.unions $ xs':catMaybes [ Map.lookup t pmap | t <- Set.toList $ freeVars fd]
+                    xs' = maybe Set.empty id (Map.lookup name pmap)
+                iterZ True pmap [] = iterZ False pmap defs
+                iterZ False pmap [] = pmap
+
+                nndefs = [ fd | fd <- defs, funcDefName fd `Set.member` nonTail ]
+                pmap = iterZ False (fromList [ (funcDefName fd, fromList [ Var x y | (x,y) <- Set.toList $ freeVars (funcDefBody fd), x > v0]) | fd <- nndefs ]) nndefs
+
hunk ./Grin/Devolve.hs 49
-                    | name `Set.member` nonTail = Left ((name,(as ++ xs) :-> proc r),xs)
-                    | otherwise = Right fd { funcDefBody = as :-> proc r }
-                  where xs = [ Var v t |  (v,t) <- Set.toList $ freeVars (as :-> r), v > v0]
-                pmap = Map.fromList [ (n,xs) | ((n,_),xs) <- nmaps]
-                proc b = runIdentity (proc' b)
-                proc' (App a as t) | Just xs <- Map.lookup a pmap = return (App a (as ++ xs) t)
-                proc' e = mapExpExp proc' e
+                    | name `Set.member` nonTail = Left ((name,(as ++ xs) :-> pr),xs)
+                    | otherwise = Right fd { funcDefBody = as :-> pr }
+                  where xs = maybe [] Set.toList $ Map.lookup name pmap
+                        pr = runIdentity $ proc r
+                proc (App a as t) | Just xs <- Map.lookup a pmap = return (App a (as ++ Set.toList xs) t)
+                proc e = mapExpExp proc e
hunk ./Grin/Devolve.hs 56
-            nmaps <- mapM (g . fst) nmaps
-            modifyIORef col (++ nmaps)
-            mapExpExp f $  updateLetProps lt { expDefs = rmaps, expBody = proc body }
+            --nmaps <- mapM (g . fst) nmaps
+            modifyIORef col (++ fsts nmaps)
+            --mapExpExp f $  updateLetProps lt { expDefs = rmaps, expBody = proc body }
+            return $ updateLetProps lt { expDefs = rmaps, expBody = runIdentity $ proc body }
hunk ./Grin/Devolve.hs 64
-    return $ setGrinFunctions (lf ++ nf) grin { grinPhase = PostDevolve, grinTypeEnv = ntenv }
+    let ng = setGrinFunctions (lf ++ nf) grin { grinPhase = PostDevolve, grinTypeEnv = ntenv }
+    if null lf then return ng else devolveGrin ng