summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorNorman Ramsey <nr@eecs.harvard.edu>2007-09-15 20:10:30 +0000
committerNorman Ramsey <nr@eecs.harvard.edu>2007-09-15 20:10:30 +0000
commitcd437edc8792e5dbcfaa6a6b9948364e9d9d08f3 (patch)
tree3faffa8e98db3d5046d7f619b3a12ccfb75bca5b /compiler
parent6cc7a2957040c2d751a14c3776cf144152be4dd0 (diff)
downloadhaskell-cd437edc8792e5dbcfaa6a6b9948364e9d9d08f3.tar.gz
get freshBlockId out of ZipCfg and bury it in MkZipCfg where it belongs
Diffstat (limited to 'compiler')
-rw-r--r--compiler/cmm/Cmm.hs4
-rw-r--r--compiler/cmm/DFMonad.hs4
-rw-r--r--compiler/cmm/MkZipCfg.hs9
-rw-r--r--compiler/cmm/ZipCfg.hs25
-rw-r--r--compiler/cmm/ZipDataflow.hs2
-rw-r--r--compiler/codeGen/CgMonad.lhs4
6 files changed, 24 insertions, 24 deletions
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index afa47a24f7..fef00c76e5 100644
--- 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 0365cbb9b0..e8afab42ad 100644
--- 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 a0dcf11e8a..d098bb620f 100644
--- 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 b3973db7c8..5d8fdb7973 100644
--- 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 cf18b13341..2b7cb14779 100644
--- 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 55110c1977..6a26e668f1 100644
--- 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