X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCPS.hs;h=7bfdf8437e054485c7b3f64602f3def17f53ed89;hb=8350c21760d8610b0b2f329095ffb80bb1bc20d9;hp=acdd2a6bc4f2687d4bde54b717a5d3e26c6fc2d6;hpb=e6243a818496aad82b6f47511d3bd9bc800f747d;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs
index acdd2a6..7bfdf84 100644
--- a/compiler/cmm/CmmCPS.hs
+++ b/compiler/cmm/CmmCPS.hs
@@ -1,10 +1,3 @@
-{-# 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 CmmCPS (
   -- | Converts C-- with full proceedures and parameters
   -- to a CPS transformed C-- with the stack made manifest.
@@ -35,13 +28,10 @@ import ErrUtils
 import Maybes
 import Outputable
 import UniqSupply
-import UniqFM
 import UniqSet
 import Unique
 
-import Monad
-import IO
-import Data.List
+import Control.Monad
 
 -----------------------------------------------------------------------------
 -- |Top level driver for the CPS pass
@@ -52,7 +42,7 @@ cmmCPS :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm
 cmmCPS dflags cmm_with_calls
   = do	{ when (dopt Opt_DoCmmLinting dflags) $
 	       do showPass dflags "CmmLint"
-		  case firstJust $ map cmmLint cmm_with_calls of
+		  case firstJusts $ map cmmLint cmm_with_calls of
 		    Just err -> do printDump err
 				   ghcExit dflags 1
 		    Nothing  -> return ()
@@ -89,11 +79,11 @@ cpsProc :: UniqSupply
 		      --   multiple output procedures
 
 -- Data blocks don't need to be CPS transformed
-cpsProc uniqSupply proc@(CmmData _ _) = [proc]
+cpsProc _ proc@(CmmData _ _) = [proc]
 
 -- Empty functions just don't work with the CPS algorithm, but
 -- they don't need the transformation anyway so just output them directly
-cpsProc uniqSupply proc@(CmmProc _ _ _ (ListGraph []))
+cpsProc _ proc@(CmmProc _ _ _ (ListGraph []))
   = pprTrace "cpsProc: unexpected empty proc" (ppr proc) [proc]
 
 -- CPS transform for those procs that actually need it
@@ -189,6 +179,8 @@ cpsProc uniqSupply (CmmProc info ident params (ListGraph blocks)) = cps_procs
       cps_procs :: [CmmTop]
       cps_procs = zipWith (continuationToProc formats' stack_use) proc_uniques continuations'
 
+make_stack_check :: BlockId -> CmmInfo -> CmmReg -> BlockId
+                 -> GenBasicBlock CmmStmt
 make_stack_check stack_check_block_id info stack_use next_block_id =
     BasicBlock stack_check_block_id $
                    check_stmts ++ [CmmBranch next_block_id]
@@ -243,6 +235,7 @@ gatherBlocksIntoContinuation live proc_points blocks start =
       children = (collectNonProcPointTargets proc_points blocks (unitUniqSet start) [start]) `minusUniqSet` (unitUniqSet start)
       start_block = lookupWithDefaultBEnv blocks unknown_block start
       children_blocks = map (lookupWithDefaultBEnv blocks unknown_block) (uniqSetToList children)
+      unknown_block :: a    -- Used at more than one type
       unknown_block = panic "unknown block in gatherBlocksIntoContinuation"
       body = start_block : children_blocks
 
@@ -282,7 +275,7 @@ selectContinuationFormat live continuations =
     where
       -- User written continuations
       selectContinuationFormat' (Continuation
-                          (Right (CmmInfo _ _ (CmmInfoTable _ _ _ (ContInfo format srt))))
+                          (Right (CmmInfo _ _ (CmmInfoTable _ _ _ (ContInfo format _))))
                           label formals _ _) =
           (formals, Just label, format)
       -- Either user written non-continuation code
@@ -290,7 +283,7 @@ selectContinuationFormat live continuations =
       selectContinuationFormat' (Continuation (Right _) _ formals _ _) =
           (formals, Nothing, [])
       -- CPS generated continuations
-      selectContinuationFormat' (Continuation (Left srt) label formals _ blocks) =
+      selectContinuationFormat' (Continuation (Left _) label formals _ blocks) =
           -- TODO: assumes the first block is the entry block
           let ident = brokenBlockId $ head blocks -- TODO: CLabel isn't a uniquable, but we need a better way than this
           in (formals,
@@ -362,7 +355,7 @@ continuationMaxStack formats (Continuation _ label _ False blocks) =
           argumentsSize (cmmExprType . hintlessCmm) args
       final_arg_size (FinalJump _ args) =
           argumentsSize (cmmExprType . hintlessCmm) args
-      final_arg_size (FinalCall next _ _ args _ _ True) = 0
+      final_arg_size (FinalCall _    _ _ _    _ _ True) = 0
       final_arg_size (FinalCall next _ _ args _ _ False) =
           -- We have to account for the stack used when we build a frame
           -- for the *next* continuation from *this* continuation
@@ -399,7 +392,7 @@ applyContinuationFormat formats
       unknown_block = panic "unknown BlockId in applyContinuationFormat"
 
 -- Either user written non-continuation code or CPS generated proc-point
-applyContinuationFormat formats (Continuation
+applyContinuationFormat _ (Continuation
                           (Right info) label formals is_gc blocks) =
     Continuation info label formals is_gc blocks