From 72a2b54bcde2239ec773e5ee6232f413d2706efb Mon Sep 17 00:00:00 2001
From: Sebastiaan Visser <sfvisser@cs.uu.nl>
Date: Sun, 20 Dec 2009 13:09:43 +0100
Subject: [PATCH] moved some unused code

---
 src/Compiler/Unused/CSE.hs     | 11 +++++++++++
 src/Compiler/Unused/CodeGen.hs | 29 +++++++++++++++++++++++++++++
 2 files changed, 40 insertions(+)

diff --git a/src/Compiler/Unused/CSE.hs b/src/Compiler/Unused/CSE.hs
index 5a7dd20..8b101a4 100644
--- a/src/Compiler/Unused/CSE.hs
+++ b/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
+  }
+
diff --git a/src/Compiler/Unused/CodeGen.hs b/src/Compiler/Unused/CodeGen.hs
index b7b96c8..deebaab 100644
--- a/src/Compiler/Unused/CodeGen.hs
+++ b/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