Commit ccac7b17 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Fix warnings in CgCase

parent 8b683ed0
......@@ -4,13 +4,6 @@
%
\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
......@@ -109,8 +102,8 @@ cgCase :: StgExpr
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))
......@@ -125,8 +118,8 @@ allocating more heap than strictly necessary, but it will sometimes
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
......@@ -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}
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}
......@@ -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}
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.
......@@ -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)
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
......@@ -276,7 +269,10 @@ anywhere within the record).
%************************************************************************
\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,
......@@ -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 }
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.
......@@ -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))
cgInlinePrimOp primop arg_amodes bndr PolyAlt live_in_alts alts
cgInlinePrimOp _ _ bndr _ _ _
= 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
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
......@@ -426,6 +422,8 @@ cgEvalAlts cc_slot bndr alt_type alts
fam_sz = case alt_type of
AlgAlt tc -> tyConFamilySize tc
PolyAlt -> 0
PrimAlt _ -> panic "cgEvalAlts: PrimAlt"
UbxTupAlt _ -> panic "cgEvalAlts: UbxTupAlt"
\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
other -> Nothing
_ -> Nothing
branches = [(dataConTagZ con, blks)
| (DataAlt con, blks) <- alts]
......@@ -476,15 +474,16 @@ cgAlgAlt :: GCFlag
-> 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
bind_con_args DEFAULT args = nopC
bind_con_args DEFAULT _ = nopC
bind_con_args (DataAlt dc) args = bindConArgs dc args
bind_con_args (LitAlt _) _ = panic "cgAlgAlt: LitAlt"
\end{code}
......@@ -525,9 +524,10 @@ cgPrimAlt :: GCFlag
-> 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) }
cgPrimAlt _ _ _ = panic "cgPrimAlt: non-empty lists"
\end{code}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment