[rename local functions in grin before points-to analysis
John Meacham <john@repetae.net>**20061013014745] hunk ./Grin/Grin.hs 79
+import Options
hunk ./Grin/Grin.hs 215
+setGrinFunctions xs _grin | flint && hasRepeatUnder fst xs = error $ "setGrinFunctions: grin has redundent defeninitions" ++ show (fsts xs)
hunk ./Grin/PointsToAnalysis.hs 22
+import Grin.Simplify
hunk ./Grin/PointsToAnalysis.hs 301
+    grin <- return $ renameUniqueGrin grin
hunk ./Grin/Simplify.hs 1
-module Grin.Simplify(simplify) where
+module Grin.Simplify(simplify,renameUniqueGrin) where
hunk ./Grin/Simplify.hs 8
+import Control.Monad.RWS
hunk ./Grin/Simplify.hs 10
-import List
+import List hiding (insert)
hunk ./Grin/Simplify.hs 28
-import Util.Seq as Seq
hunk ./Grin/Simplify.hs 30
+import qualified Util.Seq as Seq
hunk ./Grin/Simplify.hs 668
+-- renames all functions to unique names, grin-wide
hunk ./Grin/Simplify.hs 670
+renameUniqueGrin :: Grin -> Grin
+renameUniqueGrin grin = res where
+    (res,()) = evalRWS (execUniqT 1 ans) ( mempty :: Map.Map Atom Atom) (fromList [ x | (x,_) <- grinFuncs grin ] :: Set.Set Atom)
+    ans = do mapGrinFuncsM f grin
+    f (l :-> b) = g b >>= return . (l :->)
+    g a@App  { expFunction = fn } = do
+        m <- lift ask
+        case mlookup fn m of
+            Just fn' -> return a { expFunction = fn' }
+            _ -> return a
+    g a@Call { expValue = Item fn t } = do
+        m <- lift ask
+        case mlookup fn m of
+            Just fn' -> return a { expValue = Item fn' t }
+            _ -> return a
+    g (e@Let { expDefs = defs }) = do
+        (defs',rs) <- liftM unzip $ flip mapM defs $ \d -> do
+            (nn,rs) <- newName (funcDefName d)
+            return (d { funcDefName = nn },rs)
+        local (fromList rs `mappend`) $  mapExpExp g e { expDefs = defs' }
+    g b = mapExpExp g b
+    newName a = do
+        m <- lift get
+        case member a m of
+            False -> do lift $ modify (insert a); return (a,(a,a))
+            True -> do
+            let cfname = do
+                uniq <- newUniq
+                let fname = toAtom $ show a  ++ "-" ++ show uniq
+                if fname `member` (m :: Set.Set Atom) then cfname else return fname
+            nn <- cfname
+            lift $ modify (insert nn)
+            return (nn,(a,nn))
+
+mapGrinFuncsM :: Monad m => (Lam -> m Lam) -> Grin -> m Grin
+mapGrinFuncsM f grin = liftM (`setGrinFunctions` grin) $ mapM  (\x -> do nb <- f (funcDefBody x); return (funcDefName x, nb)) (grinFunctions grin)