compiler/cmm/ZipCfgExtras.hs

   1 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}
   2
   3 -- This module contains code related to the zipcfg representation.
   4 -- The code either has been used or has been thought to be useful
   5 -- within the Quick C-- compiler, but as yet no use has been found for
   6 -- it within GHC.  This module should therefore be considered to be
   7 -- full of code that need not be maintained.  Should a function in
   8 -- this module prove useful, it should not be exported, but rather
   9 -- should be migrated back into ZipCfg (or possibly ZipCfgUtil), where
  10 -- it can be maintained.
  11
  12 module ZipCfgExtras
  13   ()
  14 where
  15 import Maybes
  16 import Panic
  17 import ZipCfg
  18
  19 import UniqFM
  20
  21 import Prelude hiding (zip, unzip, last)
  22
  23
  24 exit    :: LGraph m l -> FGraph m l         -- focus on edge into default exit node
  25                                             -- (fails if there isn't one)
  26 focusp  :: (Block m l -> Bool) -> LGraph m l -> Maybe (FGraph m l)
  27                                       -- focus on start of block satisfying predicate
  28 unfocus :: FGraph m l -> LGraph m l            -- lose focus
  29
  30 -- | We can insert a single-entry, single-exit subgraph at
  31 -- the current focus.
  32 -- The new focus can be at either the entry edge or the exit edge.
  33
  34 splice_focus_entry :: FGraph m l -> LGraph m l -> FGraph m l
  35 splice_focus_exit  :: FGraph m l -> LGraph m l -> FGraph m l
  36
  37 _unused :: ()
  38 _unused = all `seq` ()
  39     where all = ( exit, focusp, unfocus, splice_focus_entry, splice_focus_exit
  40                 , fold_fwd_block, foldM_fwd_block (\_ a -> Just a)
  41                 )
  42
  43 unfocus (FGraph e bz bs) = LGraph e (insertBlock (zip bz) bs)
  44
  45 focusp p (LGraph entry blocks) =
  46     fmap (\(b, bs) -> FGraph entry (unzip b) bs) (splitp_blocks p blocks)
  47
  48 exit g@(LGraph eid _) = FGraph eid (ZBlock h (ZLast l)) others
  49     where FGraph _ b others = focusp is_exit g `orElse` panic "no exit in flow graph"
  50           (h, l) = goto_end b
  51
  52 splice_focus_entry (FGraph eid (ZBlock head tail) blocks) g =
  53   let (tail', g') = splice_tail g tail in
  54   FGraph eid (ZBlock head tail') (plusUFM (lg_blocks g') blocks)
  55
  56 splice_focus_exit (FGraph eid (ZBlock head tail) blocks) g =
  57   let (g', head') = splice_head head g in
  58   FGraph eid (ZBlock head' tail) (plusUFM (lg_blocks g') blocks)
  59
  60 -- | Fold from first to last
  61 fold_fwd_block ::
  62   (BlockId -> a -> a) -> (m -> a -> a) -> (ZLast l -> a -> a) ->
  63   Block m l -> a -> a
  64 fold_fwd_block first middle last (Block id t) z = tail t (first id z)
  65     where tail (ZTail m t) z = tail t (middle m z)
  66           tail (ZLast l)   z = last l z
  67
  68 -- | iterate from first to last
  69 foldM_fwd_block ::
  70   Monad m => (BlockId -> a -> m a) -> (mid -> a -> m a) -> (ZLast l -> a -> m a) ->
  71              Block mid l -> a -> m a
  72 foldM_fwd_block first middle last (Block id t) z = do { z <- first id z; tail t z }
  73     where tail (ZTail m t) z = do { z <- middle m z; tail t z }
  74           tail (ZLast l)   z = last l z
  75
  76 splitp_blocks :: (Block m l -> Bool) -> BlockEnv (Block m l) ->
  77                  Maybe (Block m l, BlockEnv (Block m l))
  78 splitp_blocks = undefined -- implemented in ZipCfg but not exported
  79 is_exit :: Block m l -> Bool
  80 is_exit = undefined -- implemented in ZipCfg but not exported