X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fcmm%2FCmmBrokenBlock.hs;h=2d2f8209eb9d47611ac99293b0bb8f0189d93f25;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hp=cc968f175897af67e93e4a16f187698483950c33;hpb=1c5499d4d5d506ce0cc971e98c09bfbf7bc290a1;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs
index cc968f1..2d2f820 100644
--- a/compiler/cmm/CmmBrokenBlock.hs
+++ b/compiler/cmm/CmmBrokenBlock.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/CodingStyle#Warnings
+-- for details
+
 module CmmBrokenBlock (
   BrokenBlock(..),
   BlockEntryInfo(..),
@@ -143,6 +150,7 @@ data FinalStmt
                                 -- (redundant with ContinuationEntry)
       CmmActuals                -- ^ Arguments to call
       C_SRT                     -- ^ SRT for the continuation's info table
+      CmmReturnInfo             -- ^ Does the function return?
       Bool                      -- ^ True <=> GC block so ignore stack size
 
   | FinalSwitch                 -- ^ Same as a 'CmmSwitch'
@@ -258,7 +266,7 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
 
             -- Detect this special case to remain an inverse of
             -- 'cmmBlockFromBrokenBlock'
-            [CmmCall target results arguments (CmmSafe srt),
+            [CmmCall target results arguments (CmmSafe srt) ret,
              CmmBranch next_id] ->
                 ([cont_info], [block])
                 where
@@ -266,15 +274,15 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
                                ContFormat results srt
                                               (ident `elem` gc_block_idents))
                   block = do_call current_id entry accum_stmts exits next_id
-                                target results arguments srt
+                                target results arguments srt ret
 
             -- Break the block on safe calls (the main job of this function)
-            (CmmCall target results arguments (CmmSafe srt) : stmts) ->
+            (CmmCall target results arguments (CmmSafe srt) ret : stmts) ->
                 (cont_info : cont_infos, block : blocks)
                 where
                   next_id = BlockId $ head uniques
                   block = do_call current_id entry accum_stmts exits next_id
-                                  target results arguments srt
+                                  target results arguments srt ret
 
                   cont_info = (next_id,	-- Entry convention for the 
 					-- continuation of the call
@@ -287,12 +295,12 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
 
             -- Unsafe calls don't need a continuation
             -- but they do need to be expanded
-            (CmmCall target results arguments CmmUnsafe : stmts) ->
+            (CmmCall target results arguments CmmUnsafe ret : stmts) ->
                 breakBlock' remaining_uniques current_id entry exits
                             (accum_stmts ++
                              arg_stmts ++
                              caller_save ++
-                             [CmmCall target results new_args CmmUnsafe] ++
+                             [CmmCall target results new_args CmmUnsafe ret] ++
                              caller_load)
                             stmts
                 where
@@ -309,9 +317,9 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
                             stmts
 
       do_call current_id entry accum_stmts exits next_id
-              target results arguments srt =
+              target results arguments srt ret =
           BrokenBlock current_id entry accum_stmts (next_id:exits)
-                      (FinalCall next_id target results arguments srt
+                      (FinalCall next_id target results arguments srt ret
                                      (current_id `elem` gc_block_idents))
 
       cond_branch_target (CmmCondBranch _ target) = [target]
@@ -350,7 +358,7 @@ adaptBlockToFormat :: [(BlockId, ContFormat)]
 adaptBlockToFormat formats unique
                    block@(BrokenBlock ident entry stmts targets
                                       exit@(FinalCall next target formals
-                                                      actuals srt is_gc)) =
+                                                      actuals srt ret is_gc)) =
     if format_formals == formals &&
        format_srt == srt &&
        format_is_gc == is_gc
@@ -367,7 +375,7 @@ adaptBlockToFormat formats unique
       revised_targets = adaptor_ident : delete next targets
       revised_exit = FinalCall
                        adaptor_ident -- ^ The only part that changed
-                       target formals actuals srt is_gc
+                       target formals actuals srt ret is_gc
 
       adaptor_block = mk_adaptor_block adaptor_ident
                   (ContinuationEntry (map fst formals) srt is_gc)
@@ -401,8 +409,8 @@ cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
             FinalReturn arguments -> [CmmReturn arguments]
             FinalJump target arguments -> [CmmJump target arguments]
             FinalSwitch expr targets -> [CmmSwitch expr targets]
-            FinalCall branch_target call_target results arguments srt _ ->
-                [CmmCall call_target results arguments (CmmSafe srt),
+            FinalCall branch_target call_target results arguments srt ret _ ->
+                [CmmCall call_target results arguments (CmmSafe srt) ret,
                  CmmBranch branch_target]
 
 -----------------------------------------------------------------------------