X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCPSGen.hs;h=0d409aba7096e119f30a82f55a0b365a45d4836a;hp=914795760a3afe2087edca349d13668e318f6e99;hb=30c122df62ec75f9ed7f392f24c2925675bf1d06;hpb=ad94d40948668032189ad22a0ad741ac1f645f50

diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs
index 9147957..0d409ab 100644
--- a/compiler/cmm/CmmCPSGen.hs
+++ b/compiler/cmm/CmmCPSGen.hs
@@ -2,7 +2,7 @@
 -- 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/CodingStyle#Warnings
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
 -- for details
 
 module CmmCPSGen (
@@ -33,6 +33,7 @@ import StaticFlags
 import Unique
 import Maybe
 import List
+import FastString
 
 import Panic
 
@@ -57,7 +58,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 
@@ -70,7 +71,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
@@ -88,8 +89,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
@@ -226,22 +229,22 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
                                 foreignCall call_uniques (CmmPrim target)
                                             results arguments
 
-formal_to_actual reg = (CmmReg (CmmLocal reg), NoHint)
+formal_to_actual reg = CmmHinted (CmmReg (CmmLocal reg)) NoHint
 
-foreignCall :: [Unique] -> CmmCallTarget -> CmmHintFormals -> CmmActuals -> [CmmStmt]
+foreignCall :: [Unique] -> CmmCallTarget -> CmmFormals -> CmmActuals -> [CmmStmt]
 foreignCall uniques call results arguments =
     arg_stmts ++
     saveThreadState ++
     caller_save ++
     [CmmCall (CmmCallee suspendThread CCallConv)
-		 [ (id,PtrHint) ]
-		 [ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
+		 [ CmmHinted id PtrHint ]
+		 [ CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint ]
 		 CmmUnsafe
                  CmmMayReturn,
      CmmCall call results new_args CmmUnsafe CmmMayReturn,
      CmmCall (CmmCallee resumeThread CCallConv)
-                 [ (new_base, PtrHint) ]
-		 [ (CmmReg (CmmLocal id), PtrHint) ]
+                 [ CmmHinted new_base PtrHint ]
+		 [ CmmHinted (CmmReg (CmmLocal id)) PtrHint ]
 		 CmmUnsafe
                  CmmMayReturn,
      -- Assign the result to BaseReg: we
@@ -249,14 +252,14 @@ foreignCall uniques call results arguments =
      CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base))] ++
     caller_load ++
     loadThreadState tso_unique ++
-    [CmmJump (CmmReg spReg) (map (formal_to_actual . fst) results)]
+    [CmmJump (CmmReg spReg) (map (formal_to_actual . hintlessCmm) results)]
     where
       (_, arg_stmts, new_args) =
           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
 
 -- -----------------------------------------------------------------------------
@@ -297,7 +300,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 = [
@@ -361,12 +364,12 @@ tail_call spRel target arguments
   = store_arguments ++ adjust_sp_reg spRel ++ jump where
     store_arguments =
         [stack_put spRel expr offset
-         | ((expr, _), StackParam offset) <- argument_formats] ++
+         | ((CmmHinted expr _), StackParam offset) <- argument_formats] ++
         [global_put expr global
-         | ((expr, _), RegisterParam global) <- argument_formats]
+         | ((CmmHinted expr _), RegisterParam global) <- argument_formats]
     jump = [CmmJump target arguments]
 
-    argument_formats = assignArguments (cmmExprRep . fst) arguments
+    argument_formats = assignArguments (cmmExprRep . hintlessCmm) arguments
 
 adjust_sp_reg spRel =
     if spRel == 0