X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FZipCfgExtras.hs;h=0f8eeb0d2b7242043878e3bf5afc53f8d033a80b;hp=acddbae58bd666cc876989586104a89314379317;hb=edc0bafd3fcd01b85a2e8894e5dfe149eb0e0857;hpb=176fa33f17dd78355cc572e006d2ab26898e2c69 diff --git a/compiler/cmm/ZipCfgExtras.hs b/compiler/cmm/ZipCfgExtras.hs index acddbae..0f8eeb0 100644 --- a/compiler/cmm/ZipCfgExtras.hs +++ b/compiler/cmm/ZipCfgExtras.hs @@ -43,10 +43,10 @@ _unused = all `seq` () --unfocus (FGraph e bz bs) = LGraph e (insertBlock (zip bz) bs) -focusp p (LGraph entry _ blocks) = +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 +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 @@ -65,12 +65,12 @@ splice_focus_exit (FGraph eid (ZBlock head tail) blocks) g = 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 } +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 +splitp_blocks = panic "splitp_blocks" -- implemented in ZipCfg but not exported is_exit :: Block m l -> Bool -is_exit = undefined -- implemented in ZipCfg but not exported +is_exit = panic "is_exit" -- implemented in ZipCfg but not exported