eliminate the last vestige of UniqSM from ZipCfg

[ghc-hetmet.git] / compiler / cmm / MkZipCfgCmm.hs

diff --git a/compiler/cmm/MkZipCfgCmm.hs b/compiler/cmm/MkZipCfgCmm.hs
index 6792559..f834449 100644 (file)
--- a/compiler/cmm/MkZipCfgCmm.hs
+++ b/compiler/cmm/MkZipCfgCmm.hs
@@ -6,10 +6,10 @@
 -- complain to Norman Ramsey.
 
 module MkZipCfgCmm
-  ( mkNop, mkAssign, mkStore, mkCall, mkUnsafeCall, mkFinalCall
+  ( mkNop, mkAssign, mkStore, mkCall, mkCmmCall, mkUnsafeCall, mkFinalCall
          , mkJump, mkCbranch, mkSwitch, mkReturn, mkComment, mkCmmIfThenElse
          , mkCmmWhileDo
-  , (<*>), mkLabel, mkBranch
+  , (<*>), sequence, mkLabel, mkBranch
   , emptyAGraph, withFreshLabel, withUnique, outOfLine
   , lgraphOfAGraph, graphOfAGraph, labelAGraph
   , CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph, Middle, Last, Convention(..)
@@ -31,6 +31,7 @@ import FastString
 import ForeignCall
 import ZipCfg 
 import MkZipCfg
+import Prelude hiding( sequence )
 
 type CmmGraph  = LGraph Middle Last
 type CmmAGraph = AGraph Middle Last
@@ -38,24 +39,37 @@ type CmmBlock  = Block  Middle Last
 type CmmZ      = GenCmm    CmmStatic CmmInfo CmmGraph
 type CmmTopZ   = GenCmmTop CmmStatic CmmInfo CmmGraph
 
+---------- No-ops
 mkNop        :: CmmAGraph
+mkComment    :: FastString -> CmmAGraph
+
+---------- Assignment and store
 mkAssign     :: CmmReg  -> CmmExpr -> CmmAGraph
 mkStore      :: CmmExpr -> CmmExpr -> CmmAGraph
-mkCall       :: CmmCallTarget -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
-mkUnsafeCall :: CmmCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph
-mkFinalCall  :: CmmCallTarget -> CmmActuals -> CmmAGraph -- never returns
-mkJump       :: CmmExpr -> CmmActuals -> CmmAGraph
-mkCbranch    :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
-mkSwitch     :: CmmExpr -> [Maybe BlockId] -> CmmAGraph
-mkReturn     :: CmmActuals -> CmmAGraph
-mkComment    :: FastString -> CmmAGraph
 
--- Not to be forgotten, but exported by MkZipCfg:
---mkBranch      :: BlockId -> CmmAGraph
---mkLabel       :: BlockId -> CmmAGraph
+---------- Calls
+mkCall       :: CmmExpr -> CCallConv -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
+mkCmmCall    :: CmmExpr -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
+                       -- Native C-- calling convention
+mkUnsafeCall :: CmmCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph
+mkFinalCall  :: CmmExpr -> CCallConv -> CmmActuals -> CmmAGraph
+                -- Never returns; like exit() or barf()
+
+---------- Control transfer
+mkJump         :: CmmExpr -> CmmActuals -> CmmAGraph
+mkCbranch      :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
+mkSwitch       :: CmmExpr -> [Maybe BlockId] -> CmmAGraph
+mkReturn       :: CmmActuals -> CmmAGraph
 mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> CmmAGraph
 mkCmmWhileDo    :: CmmExpr -> CmmAGraph -> CmmAGraph 
 
+-- Not to be forgotten, but exported by MkZipCfg:
+-- mkBranch      :: BlockId -> CmmAGraph
+-- mkLabel       :: BlockId -> CmmAGraph
+-- outOfLine     :: CmmAGraph -> CmmAGraph
+-- withUnique    :: (Unique -> CmmAGraph) -> CmmAGraph
+-- withFreshLabel :: String -> (BlockId -> CmmAGraph) -> CmmAGraph
+
 --------------------------------------------------------------------------
 
 mkCmmIfThenElse e = mkIfThenElse (mkCbranch e)
@@ -64,21 +78,32 @@ mkCmmWhileDo    e = mkWhileDo    (mkCbranch e)
 
 -- ================ IMPLEMENTATION ================--
 
-mkNop                     = mkMiddle $ MidNop
+mkNop                     = emptyAgraph
 mkComment fs              = mkMiddle $ MidComment fs
 mkAssign l r              = mkMiddle $ MidAssign l r
 mkStore  l r              = mkMiddle $ MidStore  l r
 
-mkJump e args             = mkLast   $ LastJump e args
 mkCbranch pred ifso ifnot = mkLast   $ LastCondBranch pred ifso ifnot
-mkReturn actuals          = mkLast   $ LastReturn actuals
 mkSwitch e tbl            = mkLast   $ LastSwitch e tbl
 
 mkUnsafeCall tgt results actuals = mkMiddle $ MidUnsafeCall tgt results actuals
-mkFinalCall  tgt actuals         = mkLast   $ LastCall      tgt actuals Nothing
 
-mkCall tgt results actuals srt =
-  withFreshLabel "call successor" $ \k ->
-    mkLast (LastCall tgt actuals (Just k)) <*>
-    mkLabel k <*>
-    mkMiddle (CopyIn (Result CmmCallConv) results srt)
+cmmArgConv, cmmResConv :: Convention
+cmmArgConv = ConventionStandard CmmCallConv Arguments
+cmmResConv = ConventionStandard CmmCallConv Arguments
+
+mkJump e actuals = mkMiddle (CopyOut cmmArgConv actuals) <*> mkLast (LastJump e)
+mkReturn actuals = mkMiddle (CopyOut cmmResConv actuals) <*> mkLast LastReturn
+
+mkFinalCall  f conv actuals =
+    mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
+    mkLast   (LastCall f Nothing)
+
+mkCmmCall f results actuals srt = mkCall f CmmCallConv results actuals srt
+
+mkCall f conv results actuals srt = 
+    withFreshLabel "call successor" $ \k ->
+      mkMiddle (CopyOut (ConventionStandard conv Arguments) actuals) <*>
+      mkLast (LastCall f (Just k)) <*>
+      mkLabel k <*>
+      mkMiddle (CopyIn (ConventionStandard conv Results) results srt)