diff options
| -rw-r--r-- | compiler/cmm/Cmm.hs | 6 | ||||
| -rw-r--r-- | compiler/cmm/MkZipCfg.hs | 8 | ||||
| -rw-r--r-- | compiler/cmm/MkZipCfgCmm.hs | 20 | ||||
| -rw-r--r-- | compiler/cmm/ZipCfg.hs | 5 |
4 files changed, 26 insertions, 13 deletions
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index fef00c76e5..b535c8dbd2 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -21,8 +21,8 @@ module Cmm ( CmmSafety(..), CmmCallTarget(..), CmmStatic(..), Section(..), - module CmmExpr, - BlockId(..), + + BlockId(..), mkBlockId, BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv, BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet, ) where @@ -40,7 +40,7 @@ import FastString import Data.Word -import ZipCfg ( BlockId(..) +import ZipCfg ( BlockId(..), mkBlockId , BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv , BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet ) diff --git a/compiler/cmm/MkZipCfg.hs b/compiler/cmm/MkZipCfg.hs index d098bb620f..6019549dde 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 @@ -16,7 +16,7 @@ import Unique import UniqFM import UniqSupply -import Prelude hiding (zip, unzip, last, sequence) +import Prelude hiding (zip, unzip, last) #include "HsVersions.h" @@ -154,7 +154,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 @@ -250,7 +250,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 diff --git a/compiler/cmm/MkZipCfgCmm.hs b/compiler/cmm/MkZipCfgCmm.hs index 890b37c3bc..d52b32ed56 100644 --- a/compiler/cmm/MkZipCfgCmm.hs +++ b/compiler/cmm/MkZipCfgCmm.hs @@ -7,9 +7,10 @@ module MkZipCfgCmm ( mkNop, mkAssign, mkStore, mkCall, mkCmmCall, mkUnsafeCall, mkFinalCall - , mkJump, mkCbranch, mkSwitch, mkReturn, mkComment, mkCmmIfThenElse - , mkCmmWhileDo, mkAddToContext - , (<*>), sequence, mkLabel, mkBranch + , mkJump, mkCbranch, mkSwitch, mkReturn, mkComment + , mkCmmIfThenElse, mkCmmIfThen, mkCmmWhileDo + , mkAddToContext + , (<*>), catAGraphs, mkLabel, mkBranch , emptyAGraph, withFreshLabel, withUnique, outOfLine , lgraphOfAGraph, graphOfAGraph, labelAGraph , CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph, Middle, Last, Convention(..) @@ -31,7 +32,6 @@ import FastString import ForeignCall import ZipCfg import MkZipCfg -import Prelude hiding( sequence ) type CmmGraph = LGraph Middle Last type CmmAGraph = AGraph Middle Last @@ -63,7 +63,9 @@ mkJump :: CmmExpr -> CmmActuals -> CmmAGraph mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph mkSwitch :: CmmExpr -> [Maybe BlockId] -> CmmAGraph mkReturn :: CmmActuals -> CmmAGraph + mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> CmmAGraph +mkCmmIfThen :: CmmExpr -> CmmAGraph -> CmmAGraph mkCmmWhileDo :: CmmExpr -> CmmAGraph -> CmmAGraph -- Not to be forgotten, but exported by MkZipCfg: @@ -75,8 +77,16 @@ mkCmmWhileDo :: CmmExpr -> CmmAGraph -> CmmAGraph -------------------------------------------------------------------------- +mkCmmWhileDo e = mkWhileDo (mkCbranch e) mkCmmIfThenElse e = mkIfThenElse (mkCbranch e) -mkCmmWhileDo e = mkWhileDo (mkCbranch e) + +mkCmmIfThen e tbranch + = withFreshLabel "end of if" $ \endif -> + withFreshLabel "start of then" $ \tid -> + mkCbranch e tid endif <*> + mkLabel tid <*> tbranch <*> mkBranch endif <*> + mkLabel endif + -- ================ IMPLEMENTATION ================-- diff --git a/compiler/cmm/ZipCfg.hs b/compiler/cmm/ZipCfg.hs index 80017764ab..30843e5bb8 100644 --- a/compiler/cmm/ZipCfg.hs +++ b/compiler/cmm/ZipCfg.hs @@ -1,6 +1,6 @@ module ZipCfg ( -- These data types and names are carefully thought out - BlockId(..) -- ToDo: BlockId should be abstract, but it isn't yet + BlockId(..), mkBlockId -- ToDo: BlockId should be abstract, but it isn't yet , BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, insertBlock, mkBlockEnv , BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet, mkBlockSet , Graph(..), LGraph(..), FGraph(..) @@ -639,6 +639,9 @@ newtype BlockId = BlockId Unique instance Uniquable BlockId where getUnique (BlockId u) = u +mkBlockId :: Unique -> BlockId +mkBlockId uniq = BlockId uniq + instance Show BlockId where show (BlockId u) = show u |