compiler/cmm/MkZipCfgCmm.hs

   1 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}
   2
   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.
   7
   8 module MkZipCfgCmm
   9   ( mkNop, mkAssign, mkStore, mkCall, mkUnsafeCall, mkFinalCall
  10          , mkJump, mkCbranch, mkSwitch, mkReturn, mkComment, mkCmmIfThenElse
  11          , mkCmmWhileDo
  12   , (<*>), mkLabel, mkBranch
  13   , emptyAGraph, withFreshLabel, withUnique, outOfLine
  14   , lgraphOfAGraph, graphOfAGraph, labelAGraph
  15   , CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph, Middle, Last, Convention(..)
  16   )
  17 where
  18
  19 #include "HsVersions.h"
  20
  21 import CmmExpr
  22 import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
  23            , CmmCallTarget(..), CmmActuals, CmmFormals
  24            )
  25 import ZipCfgCmmRep hiding (CmmGraph, CmmAGraph, CmmBlock, CmmZ, CmmTopZ)
  26   -- ^ to make this module more self-contained, these definitions are duplicated below
  27 import PprCmm()
  28
  29 import ClosureInfo
  30 import FastString
  31 import ForeignCall
  32 import ZipCfg
  33 import MkZipCfg
  34
  35 type CmmGraph  = LGraph Middle Last
  36 type CmmAGraph = AGraph Middle Last
  37 type CmmBlock  = Block  Middle Last
  38 type CmmZ      = GenCmm    CmmStatic CmmInfo CmmGraph
  39 type CmmTopZ   = GenCmmTop CmmStatic CmmInfo CmmGraph
  40
  41 mkNop        :: CmmAGraph
  42 mkAssign     :: CmmReg  -> CmmExpr -> CmmAGraph
  43 mkStore      :: CmmExpr -> CmmExpr -> CmmAGraph
  44 mkCall       :: CmmExpr -> CCallConv -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
  45 mkUnsafeCall :: CmmCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph
  46 mkFinalCall  :: CmmExpr -> CCallConv -> CmmActuals -> CmmAGraph
  47                  -- Never returns; like exit() or barf()
  48 mkJump       :: CmmExpr -> CmmActuals -> CmmAGraph
  49 mkCbranch    :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
  50 mkSwitch     :: CmmExpr -> [Maybe BlockId] -> CmmAGraph
  51 mkReturn     :: CmmActuals -> CmmAGraph
  52 mkComment    :: FastString -> CmmAGraph
  53
  54 -- Not to be forgotten, but exported by MkZipCfg:
  55 --mkBranch      :: BlockId -> CmmAGraph
  56 --mkLabel       :: BlockId -> CmmAGraph
  57 mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> CmmAGraph
  58 mkCmmWhileDo    :: CmmExpr -> CmmAGraph -> CmmAGraph
  59
  60 --------------------------------------------------------------------------
  61
  62 mkCmmIfThenElse e = mkIfThenElse (mkCbranch e)
  63 mkCmmWhileDo    e = mkWhileDo    (mkCbranch e)
  64
  65
  66 -- ================ IMPLEMENTATION ================--
  67
  68 mkNop                     = mkMiddle $ MidNop
  69 mkComment fs              = mkMiddle $ MidComment fs
  70 mkAssign l r              = mkMiddle $ MidAssign l r
  71 mkStore  l r              = mkMiddle $ MidStore  l r
  72
  73 mkCbranch pred ifso ifnot = mkLast   $ LastCondBranch pred ifso ifnot
  74 mkSwitch e tbl            = mkLast   $ LastSwitch e tbl
  75
  76 mkUnsafeCall tgt results actuals = mkMiddle $ MidUnsafeCall tgt results actuals
  77
  78 cmmArgConv, cmmResConv :: Convention
  79 cmmArgConv = ConventionStandard CmmCallConv Arguments
  80 cmmResConv = ConventionStandard CmmCallConv Arguments
  81
  82 mkJump e actuals = mkMiddle (CopyOut cmmArgConv actuals) <*> mkLast (LastJump e)
  83 mkReturn actuals = mkMiddle (CopyOut cmmResConv actuals) <*> mkLast LastReturn
  84
  85 mkFinalCall  f conv actuals =
  86     mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
  87     mkLast   (LastCall f Nothing)
  88
  89 mkCall f conv results actuals srt =
  90     withFreshLabel "call successor" $ \k ->
  91       mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
  92       mkLast (LastCall f (Just k)) <*>
  93       mkLabel k <*>
  94       mkMiddle (CopyIn (ConventionStandard conv Results) results srt)