X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FMkZipCfg.hs;h=b4053521f9239eeca8ee2740794cd63e42df59d3;hb=2e06595241350a6548b6ab6430c65d6458f7c197;hp=d098bb620fe38684d6cd19ba8e4ac0ffef2cce2c;hpb=cd437edc8792e5dbcfaa6a6b9948364e9d9d08f3;p=ghc-hetmet.git diff --git a/compiler/cmm/MkZipCfg.hs b/compiler/cmm/MkZipCfg.hs index d098bb6..b405352 100644 --- a/compiler/cmm/MkZipCfg.hs +++ b/compiler/cmm/MkZipCfg.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module MkZipCfg - ( AGraph, (<*>), sequence + ( AGraph, (<*>), catAGraphs , emptyAGraph, withFreshLabel, withUnique , mkMiddle, mkMiddles, mkLast, mkZTail, mkBranch, mkLabel, mkIfThenElse, mkWhileDo , outOfLine @@ -9,14 +9,16 @@ module MkZipCfg ) where +import BlockId (BlockId(..), emptyBlockEnv) import ZipCfg import Outputable import Unique import UniqFM import UniqSupply +import Util -import Prelude hiding (zip, unzip, last, sequence) +import Prelude hiding (zip, unzip, last) #include "HsVersions.h" @@ -154,7 +156,7 @@ representation is agnostic on this point.) infixr 3 <*> (<*>) :: AGraph m l -> AGraph m l -> AGraph m l -sequence :: [AGraph m l] -> AGraph m l +catAGraphs :: [AGraph m l] -> AGraph m l -- | A graph is built up by splicing together graphs each containing a -- single node (where a label is considered a 'first' node. The empty @@ -163,9 +165,9 @@ sequence :: [AGraph m l] -> AGraph m l -- splicing operation <*>, are constant-time operations. emptyAGraph :: AGraph m l -mkLabel :: LastNode l => +mkLabel :: (LastNode l) => BlockId -> AGraph m l -- graph contains the label -mkMiddle :: m -> AGraph m l -- graph contains the node +mkMiddle :: m -> AGraph m l -- graph contains the node mkLast :: (Outputable m, Outputable l, LastNode l) => l -> AGraph m l -- graph contains the node @@ -194,9 +196,11 @@ outOfLine :: (LastNode l, Outputable m, Outputable l) -- below for convenience -mkMiddles :: [m] -> AGraph m l -mkZTail :: (Outputable m, Outputable l, LastNode l) => ZTail m l -> AGraph m l -mkBranch :: (Outputable m, Outputable l, LastNode l) => BlockId -> AGraph m l +mkMiddles :: [m] -> AGraph m l +mkZTail :: (Outputable m, Outputable l, LastNode l) => + ZTail m l -> AGraph m l +mkBranch :: (Outputable m, Outputable l, LastNode l) => + BlockId -> AGraph m l -- | For the structured control-flow constructs, a condition is -- represented as a function that takes as arguments the labels to @@ -225,8 +229,8 @@ mkWhileDo :: (Outputable m, Outputable l, LastNode l) -- in the number of basic blocks. The conversion is also monadic -- because it may require the allocation of fresh, unique labels. -graphOfAGraph :: AGraph m l -> UniqSM (Graph m l) -lgraphOfAGraph :: AGraph m l -> UniqSM (LGraph m l) +graphOfAGraph :: AGraph m l -> UniqSM (Graph m l) +lgraphOfAGraph :: AGraph m l -> UniqSM (LGraph m l) -- ^ allocate a fresh label for the entry point labelAGraph :: BlockId -> AGraph m l -> UniqSM (LGraph m l) -- ^ use the given BlockId as the label of the entry point @@ -250,7 +254,7 @@ newtype AGraph m l = AGraph (Graph m l -> UniqSM (Graph m l)) AGraph f1 <*> AGraph f2 = AGraph f where f g = f2 g >>= f1 -- note right associativity -sequence = foldr (<*>) emptyAGraph +catAGraphs = foldr (<*>) emptyAGraph emptyAGraph = AGraph return @@ -300,7 +304,7 @@ withFreshLabel name ofId = AGraph f f' g withUnique ofU = AGraph f - where f g = do u <- getUniqueUs + where f g = do u <- getUniqueM let AGraph f' = ofU u f' g @@ -357,7 +361,5 @@ Emitting a Branch at this point is fine: -- a string. freshBlockId :: String -> UniqSM BlockId -freshBlockId _ = do { u <- getUniqueUs; return $ BlockId u } +freshBlockId _ = do { u <- getUniqueM; return $ BlockId u } -_unused :: FS.FastString -_unused = undefined