%
\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
-> StgLiveVars
-> StgLiveVars
-> Id
- -> SRT
-> AltType
-> [StgAlt]
-> Code
Special case #1: case of literal.
\begin{code}
-cgCase (StgLit lit) live_in_whole_case live_in_alts bndr srt
+cgCase (StgLit lit) live_in_whole_case live_in_alts bndr
alt_type@(PrimAlt tycon) alts
= do { tmp_reg <- bindNewToTemp bndr
; cm_lit <- cgLit lit
eliminate a heap check altogether.
\begin{code}
-cgCase (StgApp v []) live_in_whole_case live_in_alts bndr srt
+cgCase (StgApp v []) live_in_whole_case live_in_alts bndr
alt_type@(PrimAlt tycon) 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
\begin{code}
cgCase (StgOpApp op@(StgPrimOp primop) args _)
- live_in_whole_case live_in_alts bndr srt alt_type alts
+ 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}
\begin{code}
cgCase (StgOpApp op@(StgFCallOp fcall _) args _)
- live_in_whole_case live_in_alts bndr srt alt_type alts
+ live_in_whole_case live_in_alts bndr alt_type alts
| unsafe_foreign_call
= ASSERT( isSingleton alts )
do -- *must* be an unboxed tuple alt.
-- exactly like the cgInlinePrimOp case for unboxed tuple alts..
{ res_tmps <- mapFCs bindNewToTemp non_void_res_ids
; let res_hints = map (typeHint.idType) non_void_res_ids
- ; cgForeignCall (zip res_tmps res_hints) fcall args live_in_alts
+ ; cgForeignCall (zipWith CmmKinded res_tmps res_hints) fcall args live_in_alts
; cgExpr rhs }
where
(_, res_ids, _, rhs) = head alts
\begin{code}
cgCase (StgApp fun args)
- live_in_whole_case live_in_alts bndr srt alt_type alts
+ live_in_whole_case live_in_alts bndr alt_type alts
= do { fun_info <- getCgIdInfo fun
; arg_amodes <- getArgAmodes args
<- forkEval alts_eob_info
(allocStackTop retAddrSizeW >> nopC)
(do { deAllocStackTop retAddrSizeW
- ; cgEvalAlts maybe_cc_slot bndr srt alt_type alts })
+ ; cgEvalAlts maybe_cc_slot bndr alt_type alts })
; setEndOfBlockInfo scrut_eob_info
(performTailCall fun_info arg_amodes save_assts) }
Finally, here is the general case.
\begin{code}
-cgCase expr live_in_whole_case live_in_alts bndr srt alt_type alts
+cgCase expr live_in_whole_case live_in_alts bndr alt_type alts
= do { -- Figure out what volatile variables to save
nukeDeadBindings live_in_whole_case
; allocStackTop retAddrSizeW -- space for retn address
; nopC })
(do { deAllocStackTop retAddrSizeW
- ; cgEvalAlts maybe_cc_slot bndr srt alt_type alts })
+ ; cgEvalAlts maybe_cc_slot bndr alt_type alts })
; setEndOfBlockInfo scrut_eob_info (cgExpr expr)
}
(do { tmp_reg <- bindNewToTemp bndr
; stmtC (CmmAssign
(CmmLocal tmp_reg)
- (tagToClosure this_pkg tycon tag_amode)) })
+ (tagToClosure tycon tag_amode)) })
-- Compile the alts
; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
\begin{code}
cgEvalAlts :: Maybe VirtualSpOffset -- Offset of cost-centre to be restored, if any
-> Id
- -> SRT -- SRT for the continuation
-> AltType
-> [StgAlt]
-> FCode Sequel -- Any addr modes inside are guaranteed
-- to be a label so that we can duplicate it
-- without risk of duplicating code
-cgEvalAlts cc_slot bndr srt alt_type@(PrimAlt tycon) alts
+cgEvalAlts cc_slot bndr alt_type@(PrimAlt tycon) alts
= do { let rep = tyConCgRep tycon
reg = dataReturnConvPrim rep -- Bottom for voidRep
; restoreCurrentCostCentre cc_slot True
; cgPrimAlts GCMayHappen alt_type reg alts }
- ; lbl <- emitReturnTarget (idName bndr) abs_c srt
+ ; lbl <- emitReturnTarget (idName bndr) abs_c
; returnFC (CaseAlts lbl Nothing bndr) }
-cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)]
+cgEvalAlts cc_slot bndr (UbxTupAlt _) [(con,args,_,rhs)]
= -- Unboxed tuple case
-- By now, the simplifier should have have turned it
-- into case e of (# a,b #) -> e
-- and finally the code for the alternative
; unbxTupleHeapCheck live_regs ptrs nptrs noStmts
(cgExpr rhs) }
- ; lbl <- emitReturnTarget (idName bndr) abs_c srt
+ ; lbl <- emitReturnTarget (idName bndr) abs_c
; returnFC (CaseAlts lbl Nothing bndr) }
-cgEvalAlts cc_slot bndr srt alt_type alts
+cgEvalAlts cc_slot bndr alt_type alts
= -- Algebraic and polymorphic case
do { -- Bind the default binder
bindNewToReg bndr nodeReg (mkLFArgument bndr)
; (alts, mb_deflt) <- cgAlgAlts GCMayHappen cc_slot alt_type alts
; (lbl, branches) <- emitAlgReturnTarget (idName bndr)
- alts mb_deflt srt fam_sz
+ alts mb_deflt fam_sz
; returnFC (CaseAlts lbl branches bndr) }
where