get freshBlockId out of ZipCfg and bury it in MkZipCfg where it belongs

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index afa47a2..fef00c7 100644 (file)
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -22,7 +22,7 @@ module Cmm (
        CmmCallTarget(..),
        CmmStatic(..), Section(..),
         module CmmExpr,
-        BlockId(..), freshBlockId,
+        BlockId(..), 
         BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv,
         BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet,
   ) where
@@ -40,7 +40,7 @@ import FastString
 
 import Data.Word
 
-import ZipCfg (        BlockId(..), freshBlockId
+import ZipCfg (        BlockId(..)
               , BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv
               , BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet
               )

diff --git a/compiler/cmm/DFMonad.hs b/compiler/cmm/DFMonad.hs
index 0365cbb..e8afab4 100644 (file)
--- a/compiler/cmm/DFMonad.hs
+++ b/compiler/cmm/DFMonad.hs
@@ -24,7 +24,7 @@ import Maybes
 import PprCmm()
 import UniqFM
 import UniqSupply
-import ZipCfg hiding (freshBlockId)
+import ZipCfg
 import qualified ZipCfg as G
 
 import Outputable
@@ -247,7 +247,7 @@ markGraphRewritten = DFM f
     where f _ s = ((), s {df_rewritten = SomeChange})
 
 freshBlockId :: String -> DFM f BlockId
-freshBlockId s = liftUSM $ G.freshBlockId s
+freshBlockId _s = liftUSM $ getUniqueUs >>= return . BlockId
 
 liftUSM :: UniqSM a -> DFM f a
 liftUSM uc = DFM f

diff --git a/compiler/cmm/MkZipCfg.hs b/compiler/cmm/MkZipCfg.hs
index a0dcf11..d098bb6 100644 (file)
--- a/compiler/cmm/MkZipCfg.hs
+++ b/compiler/cmm/MkZipCfg.hs
@@ -350,5 +350,14 @@ Emitting a Branch at this point is fine:
        goto L1; L2: ...stuff... 
 -}
 
+
+-- | The string argument to 'freshBlockId' was originally helpful in debugging
+-- the Quick C-- compiler, so I have kept it here even though at present it is
+-- thrown away at this spot---there's no reason a BlockId couldn't one day carry
+-- a string.  
+
+freshBlockId :: String -> UniqSM BlockId
+freshBlockId _ = do { u <- getUniqueUs; return $ BlockId u }
+
 _unused :: FS.FastString
 _unused = undefined

diff --git a/compiler/cmm/ZipCfg.hs b/compiler/cmm/ZipCfg.hs
index b3973db..5d8fdb7 100644 (file)
--- a/compiler/cmm/ZipCfg.hs
+++ b/compiler/cmm/ZipCfg.hs
@@ -1,8 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module ZipCfg
     (  -- These data types and names are carefully thought out
-      BlockId(..), freshBlockId                -- ToDo: BlockId should be abstract,
-                                       --       but it isn't yet
+      BlockId(..)      -- ToDo: BlockId should be abstract, but it isn't yet
     , BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, insertBlock, mkBlockEnv
     , BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet, mkBlockSet
     , Graph(..), LGraph(..), FGraph(..)
@@ -44,7 +43,6 @@ import Panic
 import Unique
 import UniqFM
 import UniqSet
-import UniqSupply
 
 import Maybe
 import Prelude hiding (zip, unzip, last)
@@ -100,13 +98,13 @@ increasing complexity, they are:
 There are three types because each type offers a slightly different
 invariant or cost model.  
 
-  * The distinguished entry of a Graph has no label.  Because labels must
-    be unique, acquiring one requires a monadic operation ('freshBlockId').
-    The primary advantage of the Graph representation is that we can build
-    a small Graph purely functionally, without entering a monad.  For
-    example, during optimization we can easily rewrite a single middle
-    node into a Graph containing a sequence of two middle nodes followed by
-    LastExit.
+  * The distinguished entry of a Graph has no label.  Because labels must be
+    unique, acquiring one requires a supply of Unique labels (BlockId's).
+    The primary advantage of the Graph representation is that we can build a
+    small Graph purely functionally, without needing a fresh BlockId or
+    Unique.  For example, during optimization we can easily rewrite a single
+    middle node into a Graph containing a sequence of two middle nodes
+    followed by LastExit.
 
   * In an LGraph, every basic block is labelled.  The primary advantage of
     this representation is its simplicity: each basic block can be treated
@@ -168,11 +166,6 @@ data FGraph m l = FGraph { fg_entry  :: BlockId
 
 ----  Utility functions ---
 
--- | The string argument to 'freshBlockId' was originally helpful in debugging the Quick C--
--- compiler, so I have kept it here even though at present it is thrown away at
--- this spot---there's no reason a BlockId couldn't one day carry a string.
-freshBlockId :: String -> UniqSM BlockId
-
 blockId   :: Block  m l -> BlockId
 zip       :: ZBlock m l -> Block  m l
 unzip     :: Block  m l -> ZBlock m l
@@ -336,8 +329,6 @@ instance LastNode l => HavingSuccessors (ZTail m l) where
 
 blockId (Block id _) = id
 
-freshBlockId _ = do { u <- getUniqueUs; return $ BlockId u }
-
 -- | Convert block between forms.
 -- These functions are tail-recursive, so we can go as deep as we like
 -- without fear of stack overflow.  

diff --git a/compiler/cmm/ZipDataflow.hs b/compiler/cmm/ZipDataflow.hs
index cf18b13..2b7cb14 100644 (file)
--- a/compiler/cmm/ZipDataflow.hs
+++ b/compiler/cmm/ZipDataflow.hs
@@ -17,7 +17,7 @@ where
 
 import CmmTx
 import DFMonad
-import ZipCfg hiding (freshBlockId) -- use version from DFMonad
+import ZipCfg
 import qualified ZipCfg as G
 
 import Outputable

diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs
index 55110c1..6a26e66 100644 (file)
--- a/compiler/codeGen/CgMonad.lhs
+++ b/compiler/codeGen/CgMonad.lhs
@@ -712,8 +712,8 @@ labelC :: BlockId -> Code
 labelC id = emitCgStmt (CgLabel id)
 
 newLabelC :: FCode BlockId
-newLabelC = do { us <- newUniqSupply
-               ; return $ initUs_ us (freshBlockId "LabelC") }
+newLabelC = do { u <- newUnique
+               ; return $ BlockId u }
 
 checkedAbsC :: CmmStmt -> Code
 -- Emit code, eliminating no-ops