Skip to content

Commit

Permalink
moved some unused code
Browse files Browse the repository at this point in the history
  • Loading branch information
Sebastiaan Visser committed Dec 20, 2009
1 parent 01ca298 commit 72a2b54
Show file tree
Hide file tree
Showing 2 changed files with 40 additions and 0 deletions.
11 changes: 11 additions & 0 deletions src/Compiler/Unused/CSE.hs
Expand Up @@ -13,3 +13,14 @@ reifyGraphA = Kleisli R.reifyGraph
commonSubExpressionElimination :: Kleisli IO Expr (R.Graph ExprF)
commonSubExpressionElimination = arr cse . Kleisli R.reifyGraph

-- MuRef instances for Data.Reify.

instance Traversable f => R.MuRef (FixA Id f) where
type R.DeRef (Fix f) = f
mapDeRef f = traverse f . unId . out

data Graph = Graph
{ nodes :: Map String (ExprF String)
, first :: String
}

29 changes: 29 additions & 0 deletions src/Compiler/Unused/CodeGen.hs
Expand Up @@ -4,6 +4,35 @@ import Compiler.Raw
import Control.Arrow
import Data.List

-- Generic value traversal.

foldGraph
:: (Graph -> [a] -> [a] -> String -> String -> String -> a)
-> (Graph -> String -> String -> a)
-> (Graph -> String -> ([String] -> String) -> [String] -> a)
-> (Graph -> [a] -> String -> [String] -> String -> a)
-> (Graph -> String -> String -> a)
-> (Graph -> [a] -> String -> String -> String -> a)
-> (Graph -> [[a]] -> String -> [String] -> a)
-> Graph
-> [a]
foldGraph f0 f1 f2 f3 f4 f5 f6 g@(Graph m r) = evalState (folder (r, r `from` m)) Set.empty
where
folder (i, term) =
case term of
App f b -> rec f >>= \r0 -> rec b >>= \r1 -> pure [f0 g r0 r1 i f b ]
Con s -> pure [f1 g i s ]
Prim s vs -> pure [f2 g i s vs ]
Lam v b -> rec b >>= \r0 -> pure [f3 g r0 i v b ]
Var v -> pure [f4 g i v ]
More as -> mapM rec as >>= \rs -> pure [f6 g rs i as ]
Def n b -> rec b >>= \r0 -> pure [f5 g r0 i n b ]
from f = fromMaybe (error "internal error in foldGraph") . lookup f
rec k =
do v <- gets (Set.member k)
modify (Set.insert k)
if not v then folder (k, k `from` m) else return mempty

concatDefinitions :: Kleisli IO [String] String
concatDefinitions = arr unlines

Expand Down

0 comments on commit 72a2b54

Please sign in to comment.