scrape some unused barnacles off of ZipCfg and put them into ZipCfgExtras

1 files changed, 23 insertions, 63 deletions

diff --git a/compiler/cmm/ZipCfg.hs b/compiler/cmm/ZipCfg.hs
index 0c2b84b0fe..e9d474de37 100644
--- a/compiler/cmm/ZipCfg.hs
+++ b/compiler/cmm/ZipCfg.hs
@@ -9,22 +9,30 @@ module ZipCfg
     , LastNode, mkBranchNode, isBranchNode, branchNodeTarget
 
         -- Observers and transformers
-    , entry, exit, focus, focusp, unfocus
-    , blockId, zip, unzip, last, goto_end, ht_to_first, ht_to_last, zipht
-    , tailOfLast
-    , splice_head, splice_tail, splice_head_only, splice_focus_entry
-                 , splice_focus_exit, remove_entry_label
+    , blockId, zip, unzip, last, goto_end, zipht, tailOfLast
+    , remove_entry_label
+    , splice_tail, splice_head, splice_head_only
     , of_block_list, to_block_list
+    , map_nodes
     , postorder_dfs
-    , fold_layout, fold_blocks
-    , fold_fwd_block, foldM_fwd_block
-    , map_nodes, translate
+    , fold_layout
+    , fold_blocks
+    , translate
 
     , pprLgraph
+
+    {-
+    -- the following functions might one day be useful and can be found
+    -- either below or in ZipCfgExtras:
+    , entry, exit, focus, focusp, unfocus
+    , ht_to_first, ht_to_last, 
+    , splice_focus_entry, splice_focus_exit
+    , fold_fwd_block, foldM_fwd_block
+    -}
+
     )
 where
 
-import Maybes
 import Outputable hiding (empty)
 import Panic
 import Prelude hiding (zip, unzip, last)
@@ -111,21 +119,6 @@ fourth representation that is asymptotically optimal for such construction.
     
 -}
 
-entry   :: LGraph m l -> FGraph m l         -- focus on edge out of entry node 
-exit    :: LGraph m l -> FGraph m l         -- focus on edge into default exit node 
-                                            -- (fails if there isn't one)
-focus   :: BlockId -> LGraph m l -> FGraph m l -- focus on edge out of node with id 
-focusp  :: (Block m l -> Bool) -> LGraph m l -> Maybe (FGraph m l)
-                                      -- focus on start of block satisfying predicate
-unfocus :: FGraph m l -> LGraph m l            -- lose focus 
-
--- | We can insert a single-entry, single-exit subgraph at
--- the current focus.
--- The new focus can be at either the entry edge or the exit edge.
-
-splice_focus_entry :: FGraph m l -> LGraph m l -> FGraph m l
-splice_focus_exit  :: FGraph m l -> LGraph m l -> FGraph m l
-
 --------------- Representation --------------------
 
 -- | A basic block is a [[first]] node, followed by zero or more [[middle]]
@@ -269,18 +262,6 @@ instance LastNode l => HavingSuccessors (Block m l) where
     succs b = succs (unzip b)
 
 
-------------------- Observing nodes
-
--- | Fold from first to last
-fold_fwd_block ::
-  (BlockId -> a -> a) -> (m -> a -> a) -> (ZLast l -> a -> a) ->
-  Block m l -> a -> a
-
--- | iterate from first to last
-foldM_fwd_block ::
-  Monad m => (BlockId -> a -> m a) -> (mid -> a -> m a) -> (ZLast l -> a -> m a) ->
-             Block mid l -> a -> m a
-
 -- ================ IMPLEMENTATION ================--
 
 blockId (Block id _) = id
@@ -313,14 +294,12 @@ last (ZBlock _ t) = lastt t
   where lastt (ZLast l) = l
         lastt (ZTail _ t) = lastt t
 
+focus :: BlockId -> LGraph m l -> FGraph m l -- focus on edge out of node with id 
 focus id (LGraph entry blocks) =
     case lookupBlockEnv blocks id of
       Just b -> FGraph entry (unzip b) (delFromUFM blocks id)
       Nothing -> panic "asked for nonexistent block in flow graph"
 
-focusp p (LGraph entry blocks) =
-    fmap (\(b, bs) -> FGraph entry (unzip b) bs) (splitp_blocks p blocks)
-
 splitp_blocks :: (Block m l -> Bool) -> BlockEnv (Block m l) ->
                  Maybe (Block m l, BlockEnv (Block m l))
 splitp_blocks p blocks = lift $ foldUFM scan (Nothing, emptyBlockEnv) blocks 
@@ -332,12 +311,6 @@ splitp_blocks p blocks = lift $ foldUFM scan (Nothing, emptyBlockEnv) blocks
           lift (Nothing, _) = Nothing
           lift (Just b, bs) = Just (b, bs)
 
-entry g@(LGraph eid _) = focus eid g
-
-exit g@(LGraph eid _) = FGraph eid (ZBlock h (ZLast l)) others
-    where FGraph _ b others = focusp is_exit g `orElse` panic "no exit in flow graph"
-          (h, l) = goto_end b
-
 is_exit :: Block m l -> Bool
 is_exit b = case last (unzip b) of { LastExit -> True; _ -> False }
 
@@ -350,8 +323,6 @@ insertBlock b bs =
       Just _ -> panic ("duplicate labels " ++ show id ++ " in ZipCfg graph")
     where id = blockId b
 
-unfocus (FGraph e bz bs) = LGraph e (insertBlock (zip bz) bs)
-
 check_single_exit :: LGraph l m -> a -> a
 check_single_exit g =
   let check block found = case last (unzip block) of
@@ -366,6 +337,11 @@ check_single_exit g =
 freshBlockId :: String -> UniqSM BlockId
 freshBlockId _ = do { u <- getUniqueUs; return $ BlockId u }
 
+entry   :: LGraph m l -> FGraph m l         -- focus on edge out of entry node 
+entry g@(LGraph eid _) = focus eid g
+
+
+
 postorder_dfs g@(LGraph _ blocks) =
   let FGraph _ eblock _ = entry g
   in  vnode (zip eblock) (\acc _visited -> acc) [] emptyBlockSet
@@ -395,14 +371,6 @@ fold_layout f z g@(LGraph eid _) = fold (postorder_dfs g) z
             if id == eid then panic "entry as successor"
             else Just id
 
-fold_fwd_block first middle last (Block id t) z = tail t (first id z)
-    where tail (ZTail m t) z = tail t (middle m z)
-          tail (ZLast l)   z = last l z
-
-foldM_fwd_block first middle last (Block id t) z = do { z <- first id z; tail t z }
-    where tail (ZTail m t) z = do { z <- middle m z; tail t z }
-          tail (ZLast l)   z = last l z
-
 fold_blocks f z (LGraph _ blocks) = foldUFM f z blocks
 
 map_nodes idm middle last (LGraph eid blocks) = LGraph (idm eid) (mapUFM block blocks)
@@ -465,14 +433,6 @@ splice_tail g tail =
          (entry, LGraph (gr_entry g) (insertBlock (zipht exit tail) others))
   in  prepare_for_splicing g splice_one_block splice_many_blocks
 
-splice_focus_entry (FGraph eid (ZBlock head tail) blocks) g =
-  let (tail', g') = splice_tail g tail in
-  FGraph eid (ZBlock head tail') (plusUFM (gr_blocks g') blocks)
-
-splice_focus_exit (FGraph eid (ZBlock head tail) blocks) g =
-  let (g', head') = splice_head head g in
-  FGraph eid (ZBlock head' tail) (plusUFM (gr_blocks g') blocks)
-
 splice_head_only head g =
   let FGraph eid gentry gblocks = entry g
   in case gentry of