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
11 , mkCmmIfThenElse, mkCmmIfThen, mkCmmWhileDo
13 , (<*>), catAGraphs, mkLabel, mkBranch
14 , emptyAGraph, withFreshLabel, withUnique, outOfLine
15 , lgraphOfAGraph, graphOfAGraph, labelAGraph
16 , CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph, Middle, Last, Convention(..)
20 #include "HsVersions.h"
23 import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
24 , CmmCallTarget(..), CmmActuals, CmmFormals
26 import ZipCfgCmmRep hiding (CmmGraph, CmmAGraph, CmmBlock, CmmZ, CmmTopZ)
27 -- ^ to make this module more self-contained, these definitions are duplicated below
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
67 mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> CmmAGraph
68 mkCmmIfThen :: CmmExpr -> CmmAGraph -> CmmAGraph
69 mkCmmWhileDo :: CmmExpr -> CmmAGraph -> CmmAGraph
71 -- Not to be forgotten, but exported by MkZipCfg:
72 -- mkBranch :: BlockId -> CmmAGraph
73 -- mkLabel :: BlockId -> CmmAGraph
74 -- outOfLine :: CmmAGraph -> CmmAGraph
75 -- withUnique :: (Unique -> CmmAGraph) -> CmmAGraph
76 -- withFreshLabel :: String -> (BlockId -> CmmAGraph) -> CmmAGraph
78 --------------------------------------------------------------------------
80 mkCmmWhileDo e = mkWhileDo (mkCbranch e)
81 mkCmmIfThenElse e = mkIfThenElse (mkCbranch e)
84 = withFreshLabel "end of if" $ \endif ->
85 withFreshLabel "start of then" $ \tid ->
86 mkCbranch e tid endif <*>
87 mkLabel tid <*> tbranch <*> mkBranch endif <*>
92 -- ================ IMPLEMENTATION ================--
95 mkComment fs = mkMiddle $ MidComment fs
96 mkAssign l r = mkMiddle $ MidAssign l r
97 mkStore l r = mkMiddle $ MidStore l r
99 mkCbranch pred ifso ifnot = mkLast $ LastCondBranch pred ifso ifnot
100 mkSwitch e tbl = mkLast $ LastSwitch e tbl
102 mkUnsafeCall tgt results actuals = mkMiddle $ MidUnsafeCall tgt results actuals
103 mkAddToContext ra actuals = mkMiddle $ MidAddToContext ra actuals
105 cmmArgConv, cmmResConv :: Convention
106 cmmArgConv = ConventionStandard CmmCallConv Arguments
107 cmmResConv = ConventionStandard CmmCallConv Arguments
109 mkJump e actuals = mkMiddle (CopyOut cmmArgConv actuals) <*> mkLast (LastJump e)
110 mkReturn actuals = mkMiddle (CopyOut cmmResConv actuals) <*> mkLast LastReturn
112 mkFinalCall f conv actuals =
113 mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
114 mkLast (LastCall f Nothing)
116 mkCmmCall f results actuals srt = mkCall f CmmCallConv results actuals srt
118 mkCall f conv results actuals srt =
119 withFreshLabel "call successor" $ \k ->
120 mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
121 mkLast (LastCall f (Just k)) <*>
123 mkMiddle (CopyIn (ConventionStandard conv Results) results srt)