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

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

compiler/cmm/ZipCfgCmmRep.hs

@@ -157,12 +157,7 @@ instance Outputable Convention where
 instance DF.DebugNodes Middle Last
 
 instance Outputable CmmGraph where
-    ppr = pprCmmGraphAsRep
-
-pprCmmGraphAsRep :: CmmGraph -> SDoc
-pprCmmGraphAsRep g = vcat (map ppr_block blocks)
-    where blocks = postorder_dfs g
-          ppr_block (Block id tail) = hang (ppr id <> colon) 4 (ppr tail)
+    ppr = pprLgraph
 
 pprMiddle :: Middle -> SDoc    
 pprMiddle stmt = (case stmt of

compiler/cmm/ZipCfgExtras.hs

+{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
+
+-- This module contains code related to the zipcfg representation.
+-- The code either has been used or has been thought to be useful
+-- within the Quick C-- compiler, but as yet no use has been found for
+-- it within GHC.  This module should therefore be considered to be
+-- full of code that need not be maintained.  Should a function in
+-- this module prove useful, it should not be exported, but rather
+-- should be migrated back into ZipCfg (or possibly ZipCfgUtil), where
+-- it can be maintained.
+
+module ZipCfgExtras
+  ()
+where
+import Maybes
+import Panic
+import ZipCfg
+
+import UniqFM
+
+import Prelude hiding (zip, unzip, last)
+
+
+exit    :: LGraph m l -> FGraph m l         -- focus on edge into default exit node 
+                                            -- (fails if there isn't one)
+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
+
+_unused :: ()
+_unused = all `seq` ()
+    where all = ( exit, focusp, unfocus, splice_focus_entry, splice_focus_exit
+                , fold_fwd_block, foldM_fwd_block (\_ a -> Just a)
+                )
+
+unfocus (FGraph e bz bs) = LGraph e (insertBlock (zip bz) bs)
+
+focusp p (LGraph entry blocks) =
+    fmap (\(b, bs) -> FGraph entry (unzip b) bs) (splitp_blocks p blocks)
+
+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
+
+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)
+
+-- | Fold from first to last
+fold_fwd_block ::
+  (BlockId -> a -> a) -> (m -> a -> a) -> (ZLast l -> a -> a) ->
+  Block m l -> a -> a
+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
+
+-- | 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
+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
+
+splitp_blocks :: (Block m l -> Bool) -> BlockEnv (Block m l) ->
+                 Maybe (Block m l, BlockEnv (Block m l))
+splitp_blocks = undefined -- implemented in ZipCfg but not exported
+is_exit :: Block m l -> Bool
+is_exit = undefined -- implemented in ZipCfg but not exported