Fix warnings in CgCase

diff --git a/compiler/codeGen/CgCase.lhs b/compiler/codeGen/CgCase.lhs
index cb426f5..f7bcf5a 100644 (file)
--- a/compiler/codeGen/CgCase.lhs
+++ b/compiler/codeGen/CgCase.lhs
@@ -4,13 +4,6 @@
 %
 
 \begin{code}
 %
 
 \begin{code}

-{-# 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 CgCase (        cgCase, saveVolatileVarsAndRegs, 
                restoreCurrentCostCentre
        ) where
 module CgCase (        cgCase, saveVolatileVarsAndRegs, 
                restoreCurrentCostCentre
        ) where

@@ -109,8 +102,8 @@ cgCase      :: StgExpr
 Special case #1: case of literal.
 
 \begin{code}
 Special case #1: case of literal.
 
 \begin{code}

-cgCase (StgLit lit) live_in_whole_case live_in_alts bndr
-       alt_type@(PrimAlt tycon) alts
+cgCase (StgLit lit) _live_in_whole_case _live_in_alts bndr
+       alt_type@(PrimAlt _) alts

   = do { tmp_reg <- bindNewToTemp bndr
        ; cm_lit <- cgLit lit
        ; stmtC (CmmAssign (CmmLocal tmp_reg) (CmmLit cm_lit))
   = do { tmp_reg <- bindNewToTemp bndr
        ; cm_lit <- cgLit lit
        ; stmtC (CmmAssign (CmmLocal tmp_reg) (CmmLit cm_lit))

@@ -125,8 +118,8 @@ allocating more heap than strictly necessary, but it will sometimes
 eliminate a heap check altogether.
 
 \begin{code}
 eliminate a heap check altogether.
 
 \begin{code}

-cgCase (StgApp v []) live_in_whole_case live_in_alts bndr
-       alt_type@(PrimAlt tycon) alts
+cgCase (StgApp v []) _live_in_whole_case _live_in_alts bndr
+       alt_type@(PrimAlt _) alts

   = do { -- Careful! we can't just bind the default binder to the same thing
          -- as the scrutinee, since it might be a stack location, and having
          -- two bindings pointing at the same stack locn doesn't work (it
   = do { -- Careful! we can't just bind the default binder to the same thing
          -- as the scrutinee, since it might be a stack location, and having
          -- two bindings pointing at the same stack locn doesn't work (it

@@ -141,8 +134,8 @@ cgCase (StgApp v []) live_in_whole_case live_in_alts bndr
 Special case #3: inline PrimOps and foreign calls.
 
 \begin{code}
 Special case #3: inline PrimOps and foreign calls.
 
 \begin{code}

-cgCase (StgOpApp op@(StgPrimOp primop) args _) 
-       live_in_whole_case live_in_alts bndr alt_type alts
+cgCase (StgOpApp (StgPrimOp primop) args _) 
+       _live_in_whole_case live_in_alts bndr alt_type alts

   | not (primOpOutOfLine primop)
   = cgInlinePrimOp primop args bndr alt_type live_in_alts alts
 \end{code}
   | not (primOpOutOfLine primop)
   = cgInlinePrimOp primop args bndr alt_type live_in_alts alts
 \end{code}

@@ -156,8 +149,8 @@ Special case #4: inline foreign calls: an unsafe foreign call can be done
 right here, just like an inline primop.
 
 \begin{code}
 right here, just like an inline primop.
 
 \begin{code}

-cgCase (StgOpApp op@(StgFCallOp fcall _) args _) 
-       live_in_whole_case live_in_alts bndr alt_type alts
+cgCase (StgOpApp (StgFCallOp fcall _) args _) 
+       _live_in_whole_case live_in_alts _bndr _alt_type alts

   | unsafe_foreign_call
   = ASSERT( isSingleton alts )
     do --  *must* be an unboxed tuple alt.
   | unsafe_foreign_call
   = ASSERT( isSingleton alts )
     do --  *must* be an unboxed tuple alt.

@@ -182,7 +175,7 @@ we can reuse/trim the stack slot holding the variable (if it is in one).
 
 \begin{code}
 cgCase (StgApp fun args)
 
 \begin{code}
 cgCase (StgApp fun args)

-       live_in_whole_case live_in_alts bndr alt_type alts
+       _live_in_whole_case live_in_alts bndr alt_type alts

   = do { fun_info <- getCgIdInfo fun
        ; arg_amodes <- getArgAmodes args
 
   = do { fun_info <- getCgIdInfo fun
        ; arg_amodes <- getArgAmodes args
 

@@ -276,7 +269,10 @@ anywhere within the record).
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

-cgInlinePrimOp primop args bndr (PrimAlt tycon) live_in_alts alts
+cgInlinePrimOp :: PrimOp -> [StgArg] -> Id -> AltType -> StgLiveVars
+               -> [(AltCon, [Id], [Bool], StgExpr)]
+               -> Code
+cgInlinePrimOp primop args bndr (PrimAlt _) live_in_alts alts

   | isVoidArg (idCgRep bndr)
   = ASSERT( con == DEFAULT && isSingleton alts && null bs )
     do {       -- VOID RESULT; just sequencing, 
   | isVoidArg (idCgRep bndr)
   = ASSERT( con == DEFAULT && isSingleton alts && null bs )
     do {       -- VOID RESULT; just sequencing, 

@@ -292,7 +288,7 @@ cgInlinePrimOp primop args bndr (PrimAlt tycon) live_in_alts alts
        ; cgPrimOp [tmp_reg] primop args live_in_alts
        ; cgPrimAlts NoGC (PrimAlt tycon) (CmmLocal tmp_reg) alts }
 
        ; cgPrimOp [tmp_reg] primop args live_in_alts
        ; cgPrimAlts NoGC (PrimAlt tycon) (CmmLocal tmp_reg) alts }
 

-cgInlinePrimOp primop args bndr (UbxTupAlt tycon) live_in_alts alts
+cgInlinePrimOp primop args _ (UbxTupAlt _) live_in_alts alts

   = ASSERT( isSingleton alts )
     do {       -- UNBOXED TUPLE ALTS
                -- No heap check, no yield, just get in there and do it.
   = ASSERT( isSingleton alts )
     do {       -- UNBOXED TUPLE ALTS
                -- No heap check, no yield, just get in there and do it.

@@ -342,7 +338,7 @@ cgInlinePrimOp primop args bndr (AlgAlt tycon) live_in_alts alts
           cgPrimOp [tmp] primop args live_in_alts
           returnFC (CmmReg (CmmLocal tmp))
 
           cgPrimOp [tmp] primop args live_in_alts
           returnFC (CmmReg (CmmLocal tmp))
 

-cgInlinePrimOp primop arg_amodes bndr PolyAlt live_in_alts alts
+cgInlinePrimOp _ _ bndr _ _ _

   = pprPanic "cgCase: case of primop has polymorphic type" (ppr bndr)
 \end{code}
 
   = pprPanic "cgCase: case of primop has polymorphic type" (ppr bndr)
 \end{code}
 

@@ -386,7 +382,7 @@ cgEvalAlts cc_slot bndr (UbxTupAlt _) [(con,args,_,rhs)]
        -- into         case e of (# a,b #) -> e
        -- There shouldn't be a 
        --              case e of DEFAULT -> e
        -- into         case e of (# a,b #) -> e
        -- There shouldn't be a 
        --              case e of DEFAULT -> e

-    ASSERT2( case con of { DataAlt _ -> True; other -> False },
+    ASSERT2( case con of { DataAlt _ -> True; _ -> False },

             text "cgEvalAlts: dodgy case of unboxed tuple type" )
     do {       -- forkAbsC for the RHS, so that the envt is
                -- not changed for the emitReturn call
             text "cgEvalAlts: dodgy case of unboxed tuple type" )
     do {       -- forkAbsC for the RHS, so that the envt is
                -- not changed for the emitReturn call

@@ -426,6 +422,8 @@ cgEvalAlts cc_slot bndr alt_type alts
     fam_sz = case alt_type of
                AlgAlt tc -> tyConFamilySize tc
                PolyAlt   -> 0
     fam_sz = case alt_type of
                AlgAlt tc -> tyConFamilySize tc
                PolyAlt   -> 0

+               PrimAlt _ -> panic "cgEvalAlts: PrimAlt"
+               UbxTupAlt _ -> panic "cgEvalAlts: UbxTupAlt"

 \end{code}
 
 
 \end{code}
 
 

@@ -462,7 +460,7 @@ cgAlgAlts gc_flag cc_slot alt_type alts
        let
            mb_deflt = case alts of -- DEFAULT is always first, if present
                         ((DEFAULT,blks) : _) -> Just blks
        let
            mb_deflt = case alts of -- DEFAULT is always first, if present
                         ((DEFAULT,blks) : _) -> Just blks

-                        other                -> Nothing
+                        _                    -> Nothing

 
            branches = [(dataConTagZ con, blks) 
                       | (DataAlt con, blks) <- alts]
 
            branches = [(dataConTagZ con, blks) 
                       | (DataAlt con, blks) <- alts]

@@ -476,15 +474,16 @@ cgAlgAlt :: GCFlag
         -> StgAlt
         -> FCode (AltCon, CgStmts)
 
         -> StgAlt
         -> FCode (AltCon, CgStmts)
 

-cgAlgAlt gc_flag cc_slot alt_type (con, args, use_mask, rhs)
+cgAlgAlt gc_flag cc_slot alt_type (con, args, _use_mask, rhs)

   = do { abs_c <- getCgStmts $ do
                { bind_con_args con args
                ; restoreCurrentCostCentre cc_slot True
                ; maybeAltHeapCheck gc_flag alt_type (cgExpr rhs) }
        ; return (con, abs_c) }
   where
   = do { abs_c <- getCgStmts $ do
                { bind_con_args con args
                ; restoreCurrentCostCentre cc_slot True
                ; maybeAltHeapCheck gc_flag alt_type (cgExpr rhs) }
        ; return (con, abs_c) }
   where

-    bind_con_args DEFAULT      args = nopC
+    bind_con_args DEFAULT      _    = nopC

     bind_con_args (DataAlt dc) args = bindConArgs dc args
     bind_con_args (DataAlt dc) args = bindConArgs dc args

+    bind_con_args (LitAlt _)   _    = panic "cgAlgAlt: LitAlt"

 \end{code}
 
 
 \end{code}
 
 

@@ -525,9 +524,10 @@ cgPrimAlt :: GCFlag
          -> FCode (AltCon, CgStmts)    -- Its compiled form
 
 cgPrimAlt gc_flag alt_type (con, [], [], rhs)
          -> FCode (AltCon, CgStmts)    -- Its compiled form
 
 cgPrimAlt gc_flag alt_type (con, [], [], rhs)

-  = ASSERT( case con of { DEFAULT -> True; LitAlt _ -> True; other -> False } )
+  = ASSERT( case con of { DEFAULT -> True; LitAlt _ -> True; _ -> False } )

     do { abs_c <- getCgStmts (maybeAltHeapCheck gc_flag alt_type (cgExpr rhs)) 
        ; returnFC (con, abs_c) }
     do { abs_c <- getCgStmts (maybeAltHeapCheck gc_flag alt_type (cgExpr rhs)) 
        ; returnFC (con, abs_c) }

+cgPrimAlt _ _ _ = panic "cgPrimAlt: non-empty lists"

 \end{code}
 
 
 \end{code}