X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmExpr.hs;h=eee4a08bc78b72780abb80eb20baa02d767f7704;hb=5cd39aa33f970ff42e22b1c9c73502e4229dc488;hp=c9b67bd2ff8ca895bed4596a2379cd44f457d3d8;hpb=d708100212551a1a4c3c05a7830c9092b4498e7c;p=ghc-hetmet.git

diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index c9b67bd..eee4a08 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -27,9 +27,8 @@ import StgCmmClosure
 
 import StgSyn
 
-import MkZipCfgCmm
+import MkGraph
 import BlockId
-import Cmm()
 import CmmExpr
 import CoreSyn
 import DataCon
@@ -40,6 +39,7 @@ import SMRep
 import TyCon
 import Type
 import CostCentre	( CostCentreStack, currentCCS )
+import Control.Monad (when)
 import Maybes
 import Util
 import FastString
@@ -304,9 +304,10 @@ cgCase (OpApp ) bndr srt AlgAlt [(DataAlt flase, a2]
 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 }
@@ -314,15 +315,12 @@ cgCase (StgApp v []) bndr _ alt_type@(PrimAlt _) alts
     reps_compatible = idCgRep v == idCgRep bndr
 
 cgCase scrut@(StgApp v []) _ _ (PrimAlt _) _ 
-  | lifted 
   = -- 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
@@ -457,10 +455,8 @@ cgAltRhss gc_plan bndr alts
 	   ; 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
@@ -551,8 +547,8 @@ if the assignment to the binder will be dead code (use isDeadBndr).
 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
@@ -612,3 +608,4 @@ we should still generate the same code:
    L2:
       <default-case code>
 -}
+