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
11 , mkCmmWhileDo, mkAddToContext
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 ---------- Context manipulation ('return via')
59 mkAddToContext :: CmmExpr -> [CmmExpr] -> CmmAGraph
61 ---------- Control transfer
62 mkJump :: CmmExpr -> CmmActuals -> CmmAGraph
63 mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
64 mkSwitch :: CmmExpr -> [Maybe BlockId] -> CmmAGraph
65 mkReturn :: CmmActuals -> CmmAGraph
66 mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> CmmAGraph
67 mkCmmWhileDo :: CmmExpr -> CmmAGraph -> CmmAGraph
69 -- Not to be forgotten, but exported by MkZipCfg:
70 -- mkBranch :: BlockId -> CmmAGraph
71 -- mkLabel :: BlockId -> CmmAGraph
72 -- outOfLine :: CmmAGraph -> CmmAGraph
73 -- withUnique :: (Unique -> CmmAGraph) -> CmmAGraph
74 -- withFreshLabel :: String -> (BlockId -> CmmAGraph) -> CmmAGraph
76 --------------------------------------------------------------------------
78 mkCmmIfThenElse e = mkIfThenElse (mkCbranch e)
79 mkCmmWhileDo e = mkWhileDo (mkCbranch e)
82 -- ================ IMPLEMENTATION ================--
85 mkComment fs = mkMiddle $ MidComment fs
86 mkAssign l r = mkMiddle $ MidAssign l r
87 mkStore l r = mkMiddle $ MidStore l r
89 mkCbranch pred ifso ifnot = mkLast $ LastCondBranch pred ifso ifnot
90 mkSwitch e tbl = mkLast $ LastSwitch e tbl
92 mkUnsafeCall tgt results actuals = mkMiddle $ MidUnsafeCall tgt results actuals
93 mkAddToContext ra actuals = mkMiddle $ MidAddToContext ra actuals
95 cmmArgConv, cmmResConv :: Convention
96 cmmArgConv = ConventionStandard CmmCallConv Arguments
97 cmmResConv = ConventionStandard CmmCallConv Arguments
99 mkJump e actuals = mkMiddle (CopyOut cmmArgConv actuals) <*> mkLast (LastJump e)
100 mkReturn actuals = mkMiddle (CopyOut cmmResConv actuals) <*> mkLast LastReturn
102 mkFinalCall f conv actuals =
103 mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
104 mkLast (LastCall f Nothing)
106 mkCmmCall f results actuals srt = mkCall f CmmCallConv results actuals srt
108 mkCall f conv results actuals srt =
109 withFreshLabel "call successor" $ \k ->
110 mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
111 mkLast (LastCall f (Just k)) <*>
113 mkMiddle (CopyIn (ConventionStandard conv Results) results srt)