[create new routine dedicated to just renaming terms, use it everywhere.
John Meacham <john@repetae.net>**20060816095057] hunk ./E/Traverse.hs 3
-    Binding(..),
-    TravM,
-    TravOptions(..),
hunk ./E/Traverse.hs 4
-    emapE',
-    emapE,
+    Binding(..),
hunk ./E/Traverse.hs 6
+    emapE,
+    emapE',
hunk ./E/Traverse.hs 12
-    renameTraverse',
+    renameE,
hunk ./E/Traverse.hs 14
+    renameTraverse',
hunk ./E/Traverse.hs 16
+    traverse,
hunk ./E/Traverse.hs 18
-    traverse
+    TravOptions(..),
+    TravM
hunk ./E/Traverse.hs 22
-import Control.Monad.Identity
hunk ./E/Traverse.hs 56
-runRename set e = runIdentity $ traverse travOptions { pruneUnreachable = Nothing } (\_ (x,xs) -> (return $ foldl EAp x xs)) mempty (idSetToIdMap (const NotKnown) set)  e
+runRename set e = renameE set mempty e
+--runRename set e = runIdentity $ traverse travOptions { pruneUnreachable = Nothing } (\_ (x,xs) -> (return $ foldl EAp x xs)) mempty (idSetToIdMap (const NotKnown) set)  e
hunk ./E/Traverse.hs 375
+renameE :: IdSet -> IdMap E -> E -> (E,IdSet)
+renameE initSet initMap e = runReader (runIdNameT' $ addBoundNamesIdMap initMap >> addBoundNamesIdSet initSet >> f e) initMap  where
+    f,f' :: E -> IdNameT (Reader (IdMap E)) E
+    f' e = f e
+    f  (EAp a b) = return EAp `ap` f a `ap` f b
+    f  (ELit (LitCons n xs t)) = do
+        xs' <- mapM f xs
+        t' <- f' t
+        return $ ELit (LitCons n xs' t')
+    f (ELit (LitInt n t)) = do
+        t' <- f' t
+        return (ELit (LitInt n t'))
+    f (EError x t) = return (EError x) `ap` f' t
+    f (EPrim n es t) = do
+        es' <- mapM f es
+        t' <- f' t
+        return $ EPrim n es' t'
+    f (ELam tvr e) = lp f' ELam tvr e
+    f (EPi tvr e) = lp f EPi tvr e
+    f  e@(EVar TVr { tvrIdent = n }) = do
+        im <- lift ask
+        case mlookup n im of
+            Just n' -> do return n'
+            Nothing -> return e
+    f x@(ESort {}) = return x
+    f Unknown = return Unknown
+    f ec@ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d } = do
+        e' <- f e
+        t' <- f' (eCaseType ec)
+        addNames $ map tvrIdent (caseBinds ec)
+        (ob,b') <- ntvr f' b
+        localSubst ob $ do
+            as' <- mapM da as
+            d' <- fmapM f d
+            return $ ec { eCaseScrutinee = e', eCaseType = t', eCaseBind = b', eCaseAlts = as', eCaseDefault = d' }
+    f (ELetRec ds e) = do
+        addNames (map (tvrIdent . fst) ds)
+        ds' <- mapM ( ntvr f' . fst) ds
+        localSubst (mconcat $ fsts ds') $ do
+            es <- mapM f (snds ds)
+            e' <- f e
+            return (ELetRec (zip (snds ds') es) e')
+    --f e = error $ "renameE.f: " ++ show e
+    da :: Alt E -> IdNameT (Reader (IdMap E)) (Alt E)
+    da (Alt (LitCons n xs t) l) = do
+        t' <- f' t
+        xs' <-  mapM (ntvr f') xs
+        localSubst (mconcat [ x | (x,_) <- xs']) $ do
+            l' <- f l
+            return (Alt (LitCons n (snds xs') t') l')
+    da (Alt (LitInt n t) l) = do
+        t' <- f' t
+        l' <- f l
+        return (Alt (LitInt n t') l')
+    localSubst :: (IdMap E) -> IdNameT (Reader (IdMap E)) a  -> IdNameT (Reader (IdMap E)) a
+    localSubst ex action = do local (ex `mappend`) action
+    ntvr fg tv@TVr { tvrIdent = 0, tvrType = t} = do
+        t' <- fg t
+        return (mempty,tv { tvrType = t'})
+    ntvr fg tv@(TVr { tvrIdent = n, tvrType = t}) = do
+        n' <- if n > 0 then uniqueName  n else newName
+        t' <- fg t
+        let tv' = tv { tvrIdent = n', tvrType = t' }
+        return (msingleton n (EVar tv'),tv')
+    lp fg elam tv e = do
+        (n,tv') <- ntvr fg tv
+        e' <- localSubst n (f e)
+        return $ elam tv' e'
+
+
+
hunk ./Main.hs 10
-import qualified List(group)
hunk ./Main.hs 14
+import qualified List(group)
hunk ./Main.hs 155
-barendregt e = runIdentity  (renameTraverse' e)
+barendregt e = fst $ renameE mempty mempty e -- runIdentity  (renameTraverse' e)
hunk ./Main.hs 167
-        Identity (ELetRec ds' Unknown) = renameTraverse' (ELetRec (programDs prog) Unknown)
+        (ELetRec ds' Unknown,_) = renameE mempty mempty (ELetRec (programDs prog) Unknown)
hunk ./Main.hs 1105
+
hunk ./Name/Id.hs 18
-import Control.Monad
hunk ./Name/Id.hs 19
+import Control.Monad.Reader
hunk ./Name/Id.hs 66
+instance (MonadReader r m) => MonadReader r (IdNameT m) where
+	ask       = lift ask
+	local f (IdNameT m) = IdNameT $ local f m
+