Watch out: I've added MkZipCfg.sequence, which clashes with the
Prelude (like some other names in MkZipCfg. Maybe you can think
of a better name for it.
{-# LANGUAGE ScopedTypeVariables #-}
module MkZipCfg
{-# LANGUAGE ScopedTypeVariables #-}
module MkZipCfg
- ( AGraph, (<*>), emptyAGraph, withFreshLabel, withUnique
+ ( AGraph, (<*>), sequence
+ , emptyAGraph, withFreshLabel, withUnique
, mkMiddle, mkMiddles, mkLast, mkZTail, mkBranch, mkLabel, mkIfThenElse, mkWhileDo
, outOfLine
, emptyGraph, graphOfMiddles, graphOfZTail
, mkMiddle, mkMiddles, mkLast, mkZTail, mkBranch, mkLabel, mkIfThenElse, mkWhileDo
, outOfLine
, emptyGraph, graphOfMiddles, graphOfZTail
import UniqFM
import UniqSupply
import UniqFM
import UniqSupply
-import Prelude hiding (zip, unzip, last)
+import Prelude hiding (zip, unzip, last, sequence)
infixr 3 <*>
(<*>) :: AGraph m l -> AGraph m l -> AGraph m l
infixr 3 <*>
(<*>) :: AGraph m l -> AGraph m l -> AGraph m l
+sequence :: [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
-- graph is a left and right unit for splicing. All of the AGraph
-- | A graph is built up by splicing together graphs each containing a
-- single node (where a label is considered a 'first' node. The empty
-- graph is a left and right unit for splicing. All of the AGraph
AGraph f1 <*> AGraph f2 = AGraph f
where f g = f2 g >>= f1 -- note right associativity
AGraph f1 <*> AGraph f2 = AGraph f
where f g = f2 g >>= f1 -- note right associativity
+sequence = foldr (<*>) emptyAGraph
+
emptyAGraph = AGraph return
graphOfAGraph (AGraph f) = f emptyGraph
emptyAGraph = AGraph return
graphOfAGraph (AGraph f) = f emptyGraph
-- complain to Norman Ramsey.
module MkZipCfgCmm
-- complain to Norman Ramsey.
module MkZipCfgCmm
- ( mkNop, mkAssign, mkStore, mkCall, mkUnsafeCall, mkFinalCall
+ ( mkNop, mkAssign, mkStore, mkCall, mkCmmCall, mkUnsafeCall, mkFinalCall
, mkJump, mkCbranch, mkSwitch, mkReturn, mkComment, mkCmmIfThenElse
, mkCmmWhileDo
, mkJump, mkCbranch, mkSwitch, mkReturn, mkComment, mkCmmIfThenElse
, mkCmmWhileDo
- , (<*>), mkLabel, mkBranch
+ , (<*>), sequence, mkLabel, mkBranch
, emptyAGraph, withFreshLabel, withUnique, outOfLine
, lgraphOfAGraph, graphOfAGraph, labelAGraph
, CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph, Middle, Last, Convention(..)
, emptyAGraph, withFreshLabel, withUnique, outOfLine
, lgraphOfAGraph, graphOfAGraph, labelAGraph
, CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph, Middle, Last, Convention(..)
import ForeignCall
import ZipCfg
import MkZipCfg
import ForeignCall
import ZipCfg
import MkZipCfg
+import Prelude hiding( sequence )
type CmmGraph = LGraph Middle Last
type CmmAGraph = AGraph Middle Last
type CmmGraph = LGraph Middle Last
type CmmAGraph = AGraph Middle Last
type CmmZ = GenCmm CmmStatic CmmInfo CmmGraph
type CmmTopZ = GenCmmTop CmmStatic CmmInfo CmmGraph
type CmmZ = GenCmm CmmStatic CmmInfo CmmGraph
type CmmTopZ = GenCmmTop CmmStatic CmmInfo CmmGraph
+mkComment :: FastString -> CmmAGraph
+
+---------- Assignment and store
mkAssign :: CmmReg -> CmmExpr -> CmmAGraph
mkStore :: CmmExpr -> CmmExpr -> CmmAGraph
mkAssign :: CmmReg -> CmmExpr -> CmmAGraph
mkStore :: CmmExpr -> CmmExpr -> CmmAGraph
mkCall :: CmmExpr -> CCallConv -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
mkCall :: CmmExpr -> CCallConv -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
+mkCmmCall :: CmmExpr -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
+ -- Native C-- calling convention
mkUnsafeCall :: CmmCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph
mkFinalCall :: CmmExpr -> CCallConv -> CmmActuals -> CmmAGraph
-- Never returns; like exit() or barf()
mkUnsafeCall :: CmmCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph
mkFinalCall :: CmmExpr -> CCallConv -> CmmActuals -> CmmAGraph
-- Never returns; like exit() or barf()
-mkJump :: CmmExpr -> CmmActuals -> CmmAGraph
-mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
-mkSwitch :: CmmExpr -> [Maybe BlockId] -> CmmAGraph
-mkReturn :: CmmActuals -> CmmAGraph
-mkComment :: FastString -> CmmAGraph
--- Not to be forgotten, but exported by MkZipCfg:
---mkBranch :: BlockId -> CmmAGraph
---mkLabel :: BlockId -> CmmAGraph
+---------- Control transfer
+mkJump :: CmmExpr -> CmmActuals -> CmmAGraph
+mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
+mkSwitch :: CmmExpr -> [Maybe BlockId] -> CmmAGraph
+mkReturn :: CmmActuals -> CmmAGraph
mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> CmmAGraph
mkCmmWhileDo :: CmmExpr -> CmmAGraph -> CmmAGraph
mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> CmmAGraph
mkCmmWhileDo :: CmmExpr -> CmmAGraph -> CmmAGraph
+-- Not to be forgotten, but exported by MkZipCfg:
+-- mkBranch :: BlockId -> CmmAGraph
+-- mkLabel :: BlockId -> CmmAGraph
+-- outOfLine :: CmmAGraph -> CmmAGraph
+-- withUnique :: (Unique -> CmmAGraph) -> CmmAGraph
+-- withFreshLabel :: String -> (BlockId -> CmmAGraph) -> CmmAGraph
+
--------------------------------------------------------------------------
mkCmmIfThenElse e = mkIfThenElse (mkCbranch e)
--------------------------------------------------------------------------
mkCmmIfThenElse e = mkIfThenElse (mkCbranch e)
mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
mkLast (LastCall f Nothing)
mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
mkLast (LastCall f Nothing)
+mkCmmCall f results actuals srt = mkCall f CmmCallConv results actuals srt
+
mkCall f conv results actuals srt =
withFreshLabel "call successor" $ \k ->
mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
mkCall f conv results actuals srt =
withFreshLabel "call successor" $ \k ->
mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>