1 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}
3 -- This is the module to import to be able to build C-- programs.
4 -- It should not be necessary to import MkZipCfg or ZipCfgCmmRep.
5 -- If you find it necessary to import these other modules, please
6 -- complain to Norman Ramsey.
9 ( mkNop, mkAssign, mkStore, mkCall, mkCmmCall, mkUnsafeCall, mkFinalCall
10 , mkJump, mkCbranch, mkSwitch, mkReturn, mkComment, mkCmmIfThenElse
12 , (<*>), sequence, mkLabel, mkBranch
13 , emptyAGraph, withFreshLabel, withUnique, outOfLine
14 , lgraphOfAGraph, graphOfAGraph, labelAGraph
15 , CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph, Middle, Last, Convention(..)
19 #include "HsVersions.h"
22 import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
23 , CmmCallTarget(..), CmmActuals, CmmFormals
25 import ZipCfgCmmRep hiding (CmmGraph, CmmAGraph, CmmBlock, CmmZ, CmmTopZ)
26 -- ^ to make this module more self-contained, these definitions are duplicated below
34 import Prelude hiding( sequence )
36 type CmmGraph = LGraph Middle Last
37 type CmmAGraph = AGraph Middle Last
38 type CmmBlock = Block Middle Last
39 type CmmZ = GenCmm CmmStatic CmmInfo CmmGraph
40 type CmmTopZ = GenCmmTop CmmStatic CmmInfo CmmGraph
44 mkComment :: FastString -> CmmAGraph
46 ---------- Assignment and store
47 mkAssign :: CmmReg -> CmmExpr -> CmmAGraph
48 mkStore :: CmmExpr -> CmmExpr -> CmmAGraph
51 mkCall :: CmmExpr -> CCallConv -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
52 mkCmmCall :: CmmExpr -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
53 -- Native C-- calling convention
54 mkUnsafeCall :: CmmCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph
55 mkFinalCall :: CmmExpr -> CCallConv -> CmmActuals -> CmmAGraph
56 -- Never returns; like exit() or barf()
58 ---------- Control transfer
59 mkJump :: CmmExpr -> CmmActuals -> CmmAGraph
60 mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
61 mkSwitch :: CmmExpr -> [Maybe BlockId] -> CmmAGraph
62 mkReturn :: CmmActuals -> CmmAGraph
63 mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> CmmAGraph
64 mkCmmWhileDo :: CmmExpr -> CmmAGraph -> CmmAGraph
66 -- Not to be forgotten, but exported by MkZipCfg:
67 -- mkBranch :: BlockId -> CmmAGraph
68 -- mkLabel :: BlockId -> CmmAGraph
69 -- outOfLine :: CmmAGraph -> CmmAGraph
70 -- withUnique :: (Unique -> CmmAGraph) -> CmmAGraph
71 -- withFreshLabel :: String -> (BlockId -> CmmAGraph) -> CmmAGraph
73 --------------------------------------------------------------------------
75 mkCmmIfThenElse e = mkIfThenElse (mkCbranch e)
76 mkCmmWhileDo e = mkWhileDo (mkCbranch e)
79 -- ================ IMPLEMENTATION ================--
82 mkComment fs = mkMiddle $ MidComment fs
83 mkAssign l r = mkMiddle $ MidAssign l r
84 mkStore l r = mkMiddle $ MidStore l r
86 mkCbranch pred ifso ifnot = mkLast $ LastCondBranch pred ifso ifnot
87 mkSwitch e tbl = mkLast $ LastSwitch e tbl
89 mkUnsafeCall tgt results actuals = mkMiddle $ MidUnsafeCall tgt results actuals
91 cmmArgConv, cmmResConv :: Convention
92 cmmArgConv = ConventionStandard CmmCallConv Arguments
93 cmmResConv = ConventionStandard CmmCallConv Arguments
95 mkJump e actuals = mkMiddle (CopyOut cmmArgConv actuals) <*> mkLast (LastJump e)
96 mkReturn actuals = mkMiddle (CopyOut cmmResConv actuals) <*> mkLast LastReturn
98 mkFinalCall f conv actuals =
99 mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
100 mkLast (LastCall f Nothing)
102 mkCmmCall f results actuals srt = mkCall f CmmCallConv results actuals srt
104 mkCall f conv results actuals srt =
105 withFreshLabel "call successor" $ \k ->
106 mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
107 mkLast (LastCall f (Just k)) <*>
109 mkMiddle (CopyIn (ConventionStandard conv Results) results srt)