CmmSafety(..),
CmmCallTarget(..),
CmmStatic(..), Section(..),
- module CmmExpr,
- BlockId(..),
+
+ BlockId(..), mkBlockId,
BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv,
BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet,
) where
import Data.Word
-import ZipCfg ( BlockId(..)
+import ZipCfg ( BlockId(..), mkBlockId
, BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv
, BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet
)
{-# LANGUAGE ScopedTypeVariables #-}
module MkZipCfg
- ( AGraph, (<*>), sequence
+ ( AGraph, (<*>), catAGraphs
, emptyAGraph, withFreshLabel, withUnique
, mkMiddle, mkMiddles, mkLast, mkZTail, mkBranch, mkLabel, mkIfThenElse, mkWhileDo
, outOfLine
import UniqFM
import UniqSupply
-import Prelude hiding (zip, unzip, last, sequence)
+import Prelude hiding (zip, unzip, last)
#include "HsVersions.h"
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
AGraph f1 <*> AGraph f2 = AGraph f
where f g = f2 g >>= f1 -- note right associativity
-sequence = foldr (<*>) emptyAGraph
+catAGraphs = foldr (<*>) emptyAGraph
emptyAGraph = AGraph return
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(..)
import ForeignCall
import ZipCfg
import MkZipCfg
-import Prelude hiding( sequence )
type CmmGraph = LGraph Middle Last
type CmmAGraph = AGraph Middle Last
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:
--------------------------------------------------------------------------
+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 ================--
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(..)
instance Uniquable BlockId where
getUnique (BlockId u) = u
+mkBlockId :: Unique -> BlockId
+mkBlockId uniq = BlockId uniq
+
instance Show BlockId where
show (BlockId u) = show u