[move traversal routines from E.Inline to E.Traverse
John Meacham <john@repetae.net>**20060310015814] hunk ./E/Diff.hs 8
-import E.Inline
+import E.Traverse
hunk ./E/Eta.hs 14
-import E.Inline(emapE')
+import E.Traverse(emapE')
hunk ./E/Inline.hs 2
-    basicDecompose,
-    emapE,
-    emapE',
-    emapEG,
hunk ./E/Inline.hs 3
-    emapE_,
hunk ./E/Inline.hs 16
+import qualified Data.Graph as G
hunk ./E/Inline.hs 29
-import qualified Data.Graph as G
hunk ./E/Inline.hs 48
-basicDecompose ::
-    Maybe [Int]  -- ^ Just a set of values not to prune or nothing to not prune at all.
-    -> Rules     -- ^ Rules for pruning
-    -> E             -- ^ body for pruning info
-    -> [(TVr,E)]     -- ^ incoming bindings
-    -> [Either (TVr,E) [(TVr,E)]]     -- ^ bindings pruned and ordered by inlinability value
-basicDecompose prune rules body ds = ans where
-    zs = [ ((t,e), tvrNum t, bindingFreeVars t e ) |  (t,e) <- ds ]
-    cg zs =  newGraph zs (\ (_,x,_) -> x) ( \ (_,_,x) -> x)
-    tg = cg zs
-    scc' = scc tg
-    scc'' = case prune of
-        Nothing -> scc'
-        Just s -> scc $ cg $ reachable tg (freeVars body ++ s )
-    ans = mapScc f scc''
-    f (v,_,_) = v
-    mapScc f = map g where
-        g (Left x) = Left (f x)
-        g (Right xs) = Right (map f xs)
hunk ./E/Inline.hs 132
-emapE_ :: Monad m => (E -> m a) -> E -> m ()
-emapE_ f e = emapEG f' f' e >> return () where
-    f' e = f e >> return e
-emapE f = emapEG f f
-emapE' f = emapEG f return
-
-emapEG f g e = z e where
-    z (EAp aa ab) = do aa <- f aa;ab <- f ab; return $ EAp aa ab
-    z (ELam aa ab) = do aa <- mapmTvr g aa; ab <- f ab; return $ ELam aa ab
-    z (EPi aa ab) = do aa <- mapmTvr f aa; ab <- f ab; return $ EPi aa ab
-    z (EVar aa) = do aa <- mapmTvr f aa; return $ EVar aa
-    z (Unknown) = do return $ Unknown
-    z (ESort aa) = do return $ ESort aa
-    z (ELit (LitCons n es t)) = do t' <- g t; es' <- mapM f es; return $ ELit (LitCons n es' t')
-    z (ELit aa) = do aa <- fmapM g aa; return $ ELit aa
-    z (ELetRec aa ab) = do aa <- mapM (\x -> do x <- (do (aa,ab) <- return x; aa <- mapmTvr g aa;ab <- f ab;return (aa,ab)); return x) aa;ab <- f ab; return $ ELetRec aa ab
-    z ec@ECase {} = do
-        e' <- f $ eCaseScrutinee ec
-        b' <- fmapM g (eCaseBind ec)
-        as' <- mapM mapmAlt (eCaseAlts ec)
-        d' <- fmapM f (eCaseDefault ec)
-        t' <- g (eCaseType ec)
-        return ECase { eCaseScrutinee =e', eCaseBind = b', eCaseAlts = as', eCaseDefault = d', eCaseType = t'}
-    --    aa ab) = do aa <- f aa;ab <- mapM (\(x,y) -> do x <- fmapM f x; y <- f y; return (x,y)) ab; return $ ECase aa ab
-    z (EPrim aa ab ac) = do ab <- mapM f ab;ac <- f ac; return $ EPrim aa ab ac
-    z (EError aa ab) = do ab <- f ab; return $ EError aa ab
-    mapmTvr = fmapM
-    mapmAlt (Alt (LitCons n xs t) e) = do
-        e' <- f e
-        xs' <- mapM (fmapM g) xs
-        t' <- g t
-        return $ Alt (LitCons n xs' t') e'
-    mapmAlt (Alt l e) = do
-        e' <- f e
-        l' <- fmapM g l
-        return (Alt l' e')
-
-
-instance Monoid Int where
-    mempty = 0
-    mappend = (+)
-    mconcat = sum
hunk ./E/Inline.hs 133
-instance HasSize E where
-    size = eSize
hunk ./E/Inline.hs 134
-eSize :: E -> Int
-eSize e = n where
-    (_, n) = runWriter (f e)
-    f e@ELit {} = tell 1 >> return e
-    f e@EPrim {} = tell 1 >> return e
-    f e@EError {} = tell 1 >> return e
-    f e = tell ( 1) >> emapE' f e
hunk ./E/Strictness.hs 16
-import E.Inline
+import E.Subst
+import E.Values
hunk ./E/Strictness.hs 140
-    f e@(EAp a b)  = case runIdentity $ app (fromAp e) of
+    f e@(EAp a b)  = case app (fromAp e) of
hunk ./E/Strictness.hs 229
+
+app (e,[]) = e
+app (e,xs) = app' e xs
+
+app' (ELit (LitCons n xs t@EPi {})) (a:as)  = app (ELit (LitCons n (xs ++ [a]) (eAp t a)),as)
+app' (ELam tvr e) (a:as) = app (subst tvr a e,as)
+app' (EPi tvr e) (a:as) = app (subst tvr a e,as)
+app' ec@ECase {} xs = ec' { eCaseType = t } where
+    f e = app' e xs
+    ec' = runIdentity $ caseBodiesMapM (return . f) ec
+    t = foldl eAp (eCaseType ec') xs
+app' (ELetRec ds e) xs =eLetRec ds (app' e xs)
+app' (EError s t) xs = EError s (foldl eAp t xs)
+app' e as = foldl eAp e as
+
hunk ./E/Traverse.hs 2
-module E.Traverse(TravM, newVarName, lookupBinding, newBinding, traverse, renameTraverse, renameTraverse', runRename, TravOptions(..), Binding(..), travOptions, emapE, emapE') where
+module E.Traverse(
+    Binding(..),
+    TravM,
+    TravOptions(..),
+    basicDecompose,
+    emapE',
+    emapE,
+    emapE_,
+    lookupBinding,
+    newBinding,
+    newVarName,
+    renameTraverse',
+    renameTraverse,
+    runRename,
+    travOptions,
+    traverse
+    ) where
hunk ./E/Traverse.hs 29
+import Util.HasSize
hunk ./E/Traverse.hs 31
-import E.Inline
hunk ./E/Traverse.hs 39
+import Util.Graph
hunk ./E/Traverse.hs 307
+emapE_ :: Monad m => (E -> m a) -> E -> m ()
+emapE_ f e = emapEG f' f' e >> return () where
+    f' e = f e >> return e
+emapE f = emapEG f f
+emapE' f = emapEG f return
+
+emapEG f g e = z e where
+    z (EAp aa ab) = do aa <- f aa;ab <- f ab; return $ EAp aa ab
+    z (ELam aa ab) = do aa <- mapmTvr g aa; ab <- f ab; return $ ELam aa ab
+    z (EPi aa ab) = do aa <- mapmTvr f aa; ab <- f ab; return $ EPi aa ab
+    z (EVar aa) = do aa <- mapmTvr f aa; return $ EVar aa
+    z (Unknown) = do return $ Unknown
+    z (ESort aa) = do return $ ESort aa
+    z (ELit (LitCons n es t)) = do t' <- g t; es' <- mapM f es; return $ ELit (LitCons n es' t')
+    z (ELit aa) = do aa <- fmapM g aa; return $ ELit aa
+    z (ELetRec aa ab) = do aa <- mapM (\x -> do x <- (do (aa,ab) <- return x; aa <- mapmTvr g aa;ab <- f ab;return (aa,ab)); return x) aa;ab <- f ab; return $ ELetRec aa ab
+    z ec@ECase {} = do
+        e' <- f $ eCaseScrutinee ec
+        b' <- fmapM g (eCaseBind ec)
+        as' <- mapM mapmAlt (eCaseAlts ec)
+        d' <- fmapM f (eCaseDefault ec)
+        t' <- g (eCaseType ec)
+        return ECase { eCaseScrutinee =e', eCaseBind = b', eCaseAlts = as', eCaseDefault = d', eCaseType = t'}
+    --    aa ab) = do aa <- f aa;ab <- mapM (\(x,y) -> do x <- fmapM f x; y <- f y; return (x,y)) ab; return $ ECase aa ab
+    z (EPrim aa ab ac) = do ab <- mapM f ab;ac <- f ac; return $ EPrim aa ab ac
+    z (EError aa ab) = do ab <- f ab; return $ EError aa ab
+    mapmTvr = fmapM
+    mapmAlt (Alt (LitCons n xs t) e) = do
+        e' <- f e
+        xs' <- mapM (fmapM g) xs
+        t' <- g t
+        return $ Alt (LitCons n xs' t') e'
+    mapmAlt (Alt l e) = do
+        e' <- f e
+        l' <- fmapM g l
+        return (Alt l' e')
+
+
+instance Monoid Int where
+    mempty = 0
+    mappend = (+)
+    mconcat = sum
+
+instance HasSize E where
+    size = eSize
+
+eSize :: E -> Int
+eSize e = n where
+    (_, n) = runWriter (f e)
+    f e@ELit {} = tell 1 >> return e
+    f e@EPrim {} = tell 1 >> return e
+    f e@EError {} = tell 1 >> return e
+    f e = tell ( 1) >> emapE' f e
+
+basicDecompose ::
+    Maybe [Int]  -- ^ Just a set of values not to prune or nothing to not prune at all.
+    -> Rules     -- ^ Rules for pruning
+    -> E             -- ^ body for pruning info
+    -> [(TVr,E)]     -- ^ incoming bindings
+    -> [Either (TVr,E) [(TVr,E)]]     -- ^ bindings pruned and ordered by inlinability value
+basicDecompose prune rules body ds = ans where
+    zs = [ ((t,e), tvrNum t, bindingFreeVars t e ) |  (t,e) <- ds ]
+    cg zs =  newGraph zs (\ (_,x,_) -> x) ( \ (_,_,x) -> x)
+    tg = cg zs
+    scc' = scc tg
+    scc'' = case prune of
+        Nothing -> scc'
+        Just s -> scc $ cg $ reachable tg (freeVars body ++ s )
+    ans = mapScc f scc''
+    f (v,_,_) = v
+    mapScc f = map g where
+        g (Left x) = Left (f x)
+        g (Right xs) = Right (map f xs)
hunk ./E/TypeAnalysis.hs 19
-import E.Inline(emapE',emapE_)
+import E.Traverse(emapE',emapE_)
hunk ./E/WorkerWrapper.hs 12
-import E.Inline
+import E.Traverse
hunk ./Ho/Build.hs 39
-import E.Inline(emapE)
+import E.Traverse(emapE)