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 StackSlot
  18 import ZipCfg
  19
  20 import Prelude hiding (zip, unzip, last)
  21
  22
  23 exit    :: LGraph m l -> FGraph m l         -- focus on edge into default exit node
  24                                             -- (fails if there isn't one)
  25 focusp  :: (Block m l -> Bool) -> LGraph m l -> Maybe (FGraph m l)
  26                                       -- focus on start of block satisfying predicate
  27 unfocus :: FGraph m l -> LGraph m l            -- lose focus
  28
  29 -- | We can insert a single-entry, single-exit subgraph at
  30 -- the current focus.
  31 -- The new focus can be at either the entry edge or the exit edge.
  32
  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
  38 _unused :: ()
  39 _unused = all `seq` ()
  40     where all = ( exit, focusp, unfocus {- , splice_focus_entry, splice_focus_exit -}
  41                 , foldM_fwd_block (\_ a -> Just a)
  42                 )
  43
  44 unfocus (FGraph e bz bs) = LGraph e (insertBlock (zip bz) bs)
  45
  46 focusp p (LGraph entry blocks) =
  47     fmap (\(b, bs) -> FGraph entry (unzip b) bs) (splitp_blocks p blocks)
  48
  49 exit g@(LGraph eid _) = FGraph eid (ZBlock h (ZLast l)) others
  50     where FGraph _ b others = focusp is_exit g `orElse` panic "no exit in flow graph"
  51           (h, l) = goto_end b
  52
  53
  54 {-
  55 splice_focus_entry (FGraph eid (ZBlock head tail) blocks) g =
  56   let (tail', g') = splice_tail g tail in
  57   FGraph eid (ZBlock head tail') (plusUFM (lg_blocks g') blocks)
  58
  59 splice_focus_exit (FGraph eid (ZBlock head tail) blocks) g =
  60   let (g', head') = splice_head head g in
  61   FGraph eid (ZBlock head' tail) (plusUFM (lg_blocks g') blocks)
  62 -}
  63
  64 -- | iterate from first to last
  65 foldM_fwd_block ::
  66   Monad m => (BlockId -> a -> m a) -> (mid -> a -> m a) -> (ZLast l -> a -> m a) ->
  67              Block mid l -> a -> m a
  68 foldM_fwd_block first middle last (Block id t) z = do { z <- first id z; tail t z }
  69     where tail (ZTail m t) z = do { z <- middle m z; tail t z }
  70           tail (ZLast l)   z = last l z
  71
  72 splitp_blocks :: (Block m l -> Bool) -> BlockEnv (Block m l) ->
  73                  Maybe (Block m l, BlockEnv (Block m l))
  74 splitp_blocks = undefined -- implemented in ZipCfg but not exported
  75 is_exit :: Block m l -> Bool
  76 is_exit = undefined -- implemented in ZipCfg but not exported