From f33b7c7044e8f007aff400633ef01fe91d2fb567 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Fri, 14 Sep 2007 17:01:19 +0000
Subject: [PATCH] Wibbles to MkZipCfgCmm stuff

Watch out: I've added MkZipCfg.sequence, which clashes with the
Prelude (like some other names in MkZipCfg.  Maybe you can think
of a better name for it.
---
 compiler/cmm/MkZipCfg.hs    |    9 +++++++--
 compiler/cmm/MkZipCfgCmm.hs |   35 +++++++++++++++++++++++++----------
 2 files changed, 32 insertions(+), 12 deletions(-)

diff --git a/compiler/cmm/MkZipCfg.hs b/compiler/cmm/MkZipCfg.hs
index 7df775f..a0dcf11 100644
--- a/compiler/cmm/MkZipCfg.hs
+++ b/compiler/cmm/MkZipCfg.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module MkZipCfg
-    ( AGraph, (<*>), emptyAGraph, withFreshLabel, withUnique
+    ( AGraph, (<*>), sequence
+    , emptyAGraph, withFreshLabel, withUnique
     , mkMiddle, mkMiddles, mkLast, mkZTail, mkBranch, mkLabel, mkIfThenElse, mkWhileDo
     , outOfLine
     , emptyGraph, graphOfMiddles, graphOfZTail
@@ -15,7 +16,7 @@ import Unique
 import UniqFM
 import UniqSupply
 
-import Prelude hiding (zip, unzip, last)
+import Prelude hiding (zip, unzip, last, sequence)
 
 #include "HsVersions.h"
 
@@ -153,6 +154,8 @@ representation is agnostic on this point.)
 infixr 3 <*>
 (<*>) :: AGraph m l -> AGraph m l -> AGraph m l
 
+sequence :: [AGraph m l] -> AGraph m l
+
 -- | A graph is built up by splicing together graphs each containing a
 -- single node (where a label is considered a 'first' node.  The empty
 -- graph is a left and right unit for splicing.  All of the AGraph
@@ -247,6 +250,8 @@ newtype AGraph m l = AGraph (Graph m l -> UniqSM (Graph m l))
 AGraph f1 <*> AGraph f2 = AGraph f 
     where f g = f2 g >>= f1 -- note right associativity
 
+sequence = foldr (<*>) emptyAGraph
+
 emptyAGraph = AGraph return
 
 graphOfAGraph (AGraph f) = f emptyGraph
diff --git a/compiler/cmm/MkZipCfgCmm.hs b/compiler/cmm/MkZipCfgCmm.hs
index f6521b3..f067d98 100644
--- 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,25 +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
+
+---------- 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()
-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
+---------- 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)
@@ -86,6 +99,8 @@ 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) <*>
-- 
1.7.10.4