X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FMkZipCfg.hs;h=8b0284c411c43ee2f3d0e9d5372b6b0af9d74bed;hb=9173913b7bb53e0ed3d64d1e28324007c77646cc;hp=10068b89f56645d95350bef7983cd9191cda539d;hpb=4a7fff22295bfc4da3b86ba0659e78b429cdc854;p=ghc-hetmet.git

diff --git a/compiler/cmm/MkZipCfg.hs b/compiler/cmm/MkZipCfg.hs
index 10068b8..8b0284c 100644
--- a/compiler/cmm/MkZipCfg.hs
+++ b/compiler/cmm/MkZipCfg.hs
@@ -1,9 +1,8 @@
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}
 module MkZipCfg
     ( AGraph, (<*>), emptyAGraph, withFreshLabel, withUnique
     , mkMiddle, mkMiddles, mkLast, mkZTail, mkBranch, mkLabel, mkIfThenElse, mkWhileDo
-    , mkBlock
+    , outOfLine
     , emptyGraph, graphOfMiddles, graphOfZTail
     , lgraphOfAGraph, graphOfAGraph, labelAGraph
     )
@@ -13,6 +12,7 @@ import ZipCfg
 
 import Outputable
 import Unique
+import UniqFM
 import UniqSupply
 
 import Prelude hiding (zip, unzip, last)
@@ -171,21 +171,21 @@ withFreshLabel :: String -> (BlockId -> AGraph m l) -> AGraph m l
 withUnique     :: (Unique -> AGraph m l) -> AGraph m l
 
 
-mkBlock :: AGraph m l -> AGraph m l
--- ^ 
--- The argument is an AGraph that has an 
+outOfLine :: (LastNode l, Outputable m, Outputable l)
+          => AGraph m l -> AGraph m l
+-- ^ The argument is an AGraph that has an 
 -- empty entry sequence and no exit sequence.
 -- The result is a new AGraph that has an empty entry sequence
 -- connected to an empty exit sequence, with the original graph
 -- sitting to the side out-of-line.
 --
 -- Example:  mkMiddle (x = 3)
---           <*> mkBlock (mkLabel L <*> ...stuff...)
+--           <*> outOfLine (mkLabel L <*> ...stuff...)
 --           <*> mkMiddle (y = x)
 -- Control will flow directly from x=3 to y=x;
 -- the block starting with L is "on the side".
 --
--- N.B. algebraically for any g, g'   g <*> mkBlock g' == mkBlock g' <*> g
+-- N.B. algebraically forall g g' : g <*> outOfLine g' == outOfLine g' <*> g
 
 
 
@@ -291,7 +291,12 @@ withUnique ofU = AGraph f
                  let AGraph f' = ofU u
                  f' g
 
-mkBlock = undefined
+outOfLine (AGraph f) = AGraph f'
+    where f' (Graph tail' blocks') =
+            do Graph emptyEntrance blocks <- f emptyGraph
+               note_this_code_becomes_unreachable emptyEntrance
+               return $ Graph tail' (blocks `plusUFM` blocks')
+                                                       
 
 mkIfThenElse cbranch tbranch fbranch = 
     withFreshLabel "end of if"     $ \endif ->
@@ -315,11 +320,16 @@ mkWhileDo cbranch body =
 note_this_code_becomes_unreachable ::
     (Monad m, LastNode l, Outputable middle, Outputable l) => ZTail middle l -> m ()
 
+#ifdef DEBUG
 note_this_code_becomes_unreachable = u
     where u (ZLast LastExit)                       = return ()
           u (ZLast (LastOther l)) | isBranchNode l = return ()
                                     -- Note [Branch follows branch]
           u tail = fail ("unreachable code: " ++ showSDoc (ppr tail))
+#else
+note_this_code_becomes_unreachable _ = return ()
+#endif
+
 {-
 Note [Branch follows branch]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~