X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmm.hs;h=0ba437c98234f0efa2e0b2aac00887d70f338e66;hb=421819753b3eb4940a26e578ef0e4c5cd31761fa;hp=61724a1298fff0de9dad7d413fcd133b74cd92d6;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 61724a1..0ba437c 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -6,16 +6,10 @@
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS_GHC -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
--- for details
-
 module Cmm ( 
 	GenCmm(..), Cmm, RawCmm,
 	GenCmmTop(..), CmmTop, RawCmmTop,
+        ListGraph(..),
 	CmmInfo(..), UpdateFrame(..),
         CmmInfoTable(..), ClosureTypeInfo(..), ProfilingInfo(..), ClosureTypeTag,
 	GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
@@ -57,45 +51,45 @@ import Data.Word
 -- GenCmm is abstracted over
 --   d, the type of static data elements in CmmData
 --   h, the static info preceding the code of a CmmProc
---   i, the contents of a basic block within a CmmProc
+--   g, the control-flow graph of a CmmProc
 --
 -- We expect there to be two main instances of this type:
 --   (a) C--, i.e. populated with various C-- constructs
 --		(Cmm and RawCmm below)
 --   (b) Native code, populated with data/instructions
 --
-newtype GenCmm d h i = Cmm [GenCmmTop d h i]
+newtype GenCmm d h g = Cmm [GenCmmTop d h g]
 
 -- | A top-level chunk, abstracted over the type of the contents of
 -- the basic blocks (Cmm or instructions are the likely instantiations).
-data GenCmmTop d h i
+data GenCmmTop d h g
   = CmmProc	-- A procedure
      h	               -- Extra header such as the info table
      CLabel            -- Used to generate both info & entry labels
      CmmFormals        -- Argument locals live on entry (C-- procedure params)
-     [GenBasicBlock i] -- Code, may be empty.  The first block is
-                       -- the entry point, and should be labelled by the code gen
-		       -- with the CLabel.  The order is otherwise initially 
-                       -- unimportant, but at some point the code gen will
-                       -- fix the order.
-
-		       -- The BlockId of the first block does not give rise
-		       -- to a label.  To jump to the first block in a Proc,
-		       -- use the appropriate CLabel.
-
-		       -- BlockIds are only unique within a procedure
+     g                 -- Control-flow graph for the procedure's code
 
   | CmmData 	-- Static data
 	Section 
 	[d]
 
+-- | A control-flow graph represented as a list of extended basic blocks.
+newtype ListGraph i = ListGraph [GenBasicBlock i] 
+   -- ^ Code, may be empty.  The first block is the entry point.  The
+   -- order is otherwise initially unimportant, but at some point the
+   -- code gen will fix the order.
+
+   -- BlockIds must be unique across an entire compilation unit, since
+   -- they are translated to assembly-language labels, which scope
+   -- across a whole compilation unit.
+
 -- | Cmm with the info table as a data type
-type Cmm    = GenCmm    CmmStatic CmmInfo CmmStmt
-type CmmTop = GenCmmTop CmmStatic CmmInfo CmmStmt
+type Cmm    = GenCmm    CmmStatic CmmInfo (ListGraph CmmStmt)
+type CmmTop = GenCmmTop CmmStatic CmmInfo (ListGraph CmmStmt)
 
 -- | Cmm with the info tables converted to a list of 'CmmStatic'
-type RawCmm    = GenCmm    CmmStatic [CmmStatic] CmmStmt
-type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] CmmStmt
+type RawCmm    = GenCmm    CmmStatic [CmmStatic] (ListGraph CmmStmt)
+type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] (ListGraph CmmStmt)
 
 
 -- A basic block containing a single label, at the beginning.
@@ -115,6 +109,7 @@ blockId (BasicBlock blk_id _ ) = blk_id
 blockStmts :: GenBasicBlock i -> [i]
 blockStmts (BasicBlock _ stmts) = stmts
 
+mapBlockStmts :: (i -> i') -> GenBasicBlock i -> GenBasicBlock i'
 mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs)
 
 -----------------------------------------------------------------------------
@@ -344,6 +339,7 @@ cmmRegRep (CmmGlobal reg)	= globalRegRep reg
 localRegRep :: LocalReg -> MachRep
 localRegRep (LocalReg _ rep _) = rep
 
+localRegGCFollow :: LocalReg -> Kind
 localRegGCFollow (LocalReg _ _ p) = p
 
 cmmLitRep :: CmmLit -> MachRep