X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCPSGen.hs;h=94d4b7bdfbaefbd6252e37d424eba757d8cbfbdb;hb=66110b25c9faced2bf31bb9739222605057512f5;hp=fc3c39146fec5af264a665c94ab894cb934c3051;hpb=bb66ce578f2ef5cbeb35de9719f0839a32fbeb35;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs
index fc3c391..94d4b7b 100644
--- a/compiler/cmm/CmmCPSGen.hs
+++ b/compiler/cmm/CmmCPSGen.hs
@@ -1,3 +1,10 @@
+{-# OPTIONS -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/Commentary/CodingStyle#Warnings
+-- for details
+
 module CmmCPSGen (
   -- | Converts continuations into full proceedures.
   -- The main work of the CPS transform that everything else is setting-up.
@@ -50,7 +57,7 @@ data Continuation info =
      info              -- Left <=> Continuation created by the CPS
                        -- Right <=> Function or Proc point
      CLabel            -- Used to generate both info & entry labels
-     CmmFormals        -- Argument locals live on entry (C-- procedure params)
+     CmmFormalsWithoutKinds        -- Argument locals live on entry (C-- procedure params)
      Bool              -- ^ True <=> GC block so ignore stack size
      [BrokenBlock]     -- Code, may be empty.  The first block is
                        -- the entry point.  The order is otherwise initially 
@@ -63,7 +70,7 @@ data Continuation info =
 
 data ContinuationFormat
     = ContinuationFormat {
-        continuation_formals :: CmmFormals,
+        continuation_formals :: CmmFormalsWithoutKinds,
         continuation_label :: Maybe CLabel,	-- The label occupying the top slot
         continuation_frame_size :: WordOff,	-- Total frame size in words (not including arguments)
         continuation_stack :: [Maybe LocalReg]	-- local reg offsets from stack top
@@ -81,8 +88,10 @@ continuationToProc :: (WordOff, WordOff, [(CLabel, ContinuationFormat)])
                    -> CmmTop
 continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
                    (Continuation info label formals _ blocks) =
-    CmmProc info label formals (concat $ zipWith3 continuationToProc' uniques blocks (True : repeat False))
+    CmmProc info label formals (ListGraph blocks')
     where
+      blocks' = concat $ zipWith3 continuationToProc' uniques blocks
+                         (True : repeat False)
       curr_format = maybe unknown_block id $ lookup label formats
       unknown_block = panic "unknown BlockId in continuationToProc"
       curr_stack = continuation_frame_size curr_format
@@ -221,7 +230,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
 
 formal_to_actual reg = (CmmReg (CmmLocal reg), NoHint)
 
-foreignCall :: [Unique] -> CmmCallTarget -> CmmHintFormals -> CmmActuals -> [CmmStmt]
+foreignCall :: [Unique] -> CmmCallTarget -> CmmFormals -> CmmActuals -> [CmmStmt]
 foreignCall uniques call results arguments =
     arg_stmts ++
     saveThreadState ++
@@ -248,8 +257,8 @@ foreignCall uniques call results arguments =
           loadArgsIntoTemps argument_uniques arguments
       (caller_save, caller_load) =
           callerSaveVolatileRegs (Just [{-only system regs-}])
-      new_base = LocalReg base_unique (cmmRegRep (CmmGlobal BaseReg)) KindNonPtr
-      id = LocalReg id_unique wordRep KindNonPtr
+      new_base = LocalReg base_unique (cmmRegRep (CmmGlobal BaseReg)) GCKindNonPtr
+      id = LocalReg id_unique wordRep GCKindNonPtr
       tso_unique : base_unique : id_unique : argument_uniques = uniques
 
 -- -----------------------------------------------------------------------------
@@ -290,7 +299,7 @@ loadThreadState tso_unique =
   then [CmmStore curCCSAddr 
 	(CmmLoad (cmmOffset (CmmReg (CmmLocal tso)) tso_CCCS) wordRep)]
   else []
-  where tso = LocalReg tso_unique wordRep KindNonPtr -- TODO FIXME NOW
+  where tso = LocalReg tso_unique wordRep GCKindNonPtr -- TODO FIXME NOW
 
 
 openNursery = [