projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix warnings in CgCallConv
[ghc-hetmet.git]
/
compiler
/
codeGen
/
CgCase.lhs
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}