scrape some unused barnacles off of ZipCfg and put them into ZipCfgExtras
[ghc.git] / 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 (gr_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 (gr_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