import StgSyn
-import MkZipCfgCmm
+import MkGraph
import BlockId
-import Cmm()
import CmmExpr
import CoreSyn
import DataCon
import TyCon
import Type
import CostCentre ( CostCentreStack, currentCCS )
+import Control.Monad (when)
import Maybes
import Util
import FastString
-- code that enters the HValue, then we'll get a runtime panic, because
-- the HValue really is a MutVar#. The types are compatible though,
-- so we can just generate an assignment.
-cgCase scrut@(StgApp v []) bndr _ alt_type@(PrimAlt _) alts
+cgCase (StgApp v []) bndr _ alt_type@(PrimAlt _) alts
| isUnLiftedType (idType v)
|| reps_compatible
- = -- assignment instruction suffices for unlifted types
- do { v_info <- getCgIdInfo v
- ; emit $ mkComment $ mkFastString "New case:"
+ = -- assignment suffices for unlifted types
+ do { when (not reps_compatible) $
+ panic "cgCase: reps do not match, perhaps a dodgy unsafeCoerce?"
+ ; v_info <- getCgIdInfo v
; emit (mkAssign (CmmLocal (idToReg (NonVoid bndr))) (idInfoToAmode v_info))
; _ <- bindArgsToRegs [NonVoid bndr]
; cgAlts NoGcInAlts (NonVoid bndr) alt_type alts }
where
reps_compatible = idCgRep v == idCgRep bndr
-cgCase scrut@(StgApp v []) bndr _ (PrimAlt _) _
- | lifted
+cgCase scrut@(StgApp v []) _ _ (PrimAlt _) _
= -- fail at run-time, not compile-time
do { mb_cc <- maybeSaveCostCentre True
; withSequel (AssignTo [idToReg (NonVoid v)] False) (cgExpr scrut)
; restoreCurrentCostCentre mb_cc
; emit $ mkComment $ mkFastString "should be unreachable code"
; emit $ withFreshLabel "l" (\l -> mkLabel l <*> mkBranch l)}
- where
- lifted = not (isUnLiftedType (idType v))
cgCase scrut bndr srt alt_type alts
= -- the general case
; return con }
maybeAltHeapCheck :: GcPlan -> FCode a -> FCode a
-maybeAltHeapCheck NoGcInAlts code
- = code
-maybeAltHeapCheck (GcInAlts regs _) code
- = altHeapCheck regs code
+maybeAltHeapCheck NoGcInAlts code = code
+maybeAltHeapCheck (GcInAlts regs _) code = altHeapCheck regs code
-----------------------------------------------------------------------------
-- Tail calls
The following example illustrates how badly the code turns out:
STG:
case <=## [ww_s7Hx y_s7HD] of wild2_sbH8 {
- GHC.Bool.False -> <true code> // sbH8 dead
- GHC.Bool.True -> <false code> // sbH8 dead
+ GHC.Types.False -> <true code> // sbH8 dead
+ GHC.Types.True -> <false code> // sbH8 dead
};
Cmm:
_s7HD::F64 = F64[_sbH7::I64 + 7]; // MidAssign
L2:
<default-case code>
-}
+