module MkZipCfgCmm
( mkNop, mkAssign, mkStore, mkCall, mkCmmCall, mkUnsafeCall, mkFinalCall
- , mkJump, mkCbranch, mkSwitch, mkReturn, mkComment, mkCmmIfThenElse
- , mkCmmWhileDo
- , (<*>), 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
mkFinalCall :: CmmExpr -> CCallConv -> CmmActuals -> CmmAGraph
-- Never returns; like exit() or barf()
+---------- Context manipulation ('return via')
+mkAddToContext :: CmmExpr -> [CmmExpr] -> 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
+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 ================--
mkSwitch e tbl = mkLast $ LastSwitch e tbl
mkUnsafeCall tgt results actuals = mkMiddle $ MidUnsafeCall tgt results actuals
+mkAddToContext ra actuals = mkMiddle $ MidAddToContext ra actuals
cmmArgConv, cmmResConv :: Convention
cmmArgConv = ConventionStandard CmmCallConv Arguments