Skip to content
Browse files

moved some unused code

  • Loading branch information...
1 parent 01ca298 commit 72a2b54bcde2239ec773e5ee6232f413d2706efb Sebastiaan Visser committed
Showing with 40 additions and 0 deletions.
  1. +11 −0 src/Compiler/Unused/CSE.hs
  2. +29 −0 src/Compiler/Unused/CodeGen.hs
View
11 src/Compiler/Unused/CSE.hs
@@ -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
+ }
+
View
29 src/Compiler/Unused/CodeGen.hs
@@ -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

0 comments on commit 72a2b54

Please sign in to comment.
Something went wrong with that request. Please try again.