[project @ 2000-03-25 12:38:40 by panne]

[ghc-hetmet.git] / ghc / compiler / codeGen / CgCase.lhs

diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index 4e755ca..8bf74fa 100644 (file)
--- a/ghc/compiler/codeGen/CgCase.lhs
+++ b/ghc/compiler/codeGen/CgCase.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgCase.lhs,v 1.36 1999/11/01 17:10:06 simonpj Exp $
+% $Id: CgCase.lhs,v 1.39 2000/03/25 12:38:40 panne Exp $
 %
 %********************************************************
 %*                                                     *
@@ -49,12 +49,11 @@ import CLabel               ( CLabel, mkVecTblLabel, mkReturnPtLabel,
 import ClosureInfo     ( mkLFArgument )
 import CmdLineOpts     ( opt_SccProfilingOn, opt_GranMacros )
 import CostCentre      ( CostCentre )
-import CoreSyn         ( isDeadBinder )
-import Id              ( Id, idPrimRep )
+import Id              ( Id, idPrimRep, isDeadBinder )
 import DataCon         ( DataCon, dataConTag, fIRST_TAG, ConTag,
-                         isUnboxedTupleCon, dataConType )
+                         isUnboxedTupleCon )
 import VarSet          ( varSetElems )
-import Const           ( Con(..), Literal )
+import Literal         ( Literal )
 import PrimOp          ( primOpOutOfLine, PrimOp(..) )
 import PrimRep         ( getPrimRepSize, retPrimRepSize, PrimRep(..)
                        )
@@ -63,6 +62,7 @@ import TyCon          ( TyCon, isEnumerationTyCon, isUnboxedTupleTyCon,
                          tyConDataCons, tyConFamilySize )
 import Type            ( Type, typePrimRep, splitAlgTyConApp, 
                          splitTyConApp_maybe, repType )
+import PprType          ( {- instance Outputable Type -} )
 import Unique           ( Unique, Uniquable(..), mkPseudoUnique1 )
 import Maybes          ( maybeToBool )
 import Util
@@ -150,7 +150,7 @@ mkBuiltinUnique, because that occasionally clashes with some
 temporaries generated for _ccall_GC, amongst others (see CgExpr.lhs).
 
 \begin{code}
-cgCase (StgCon (PrimOp op) args res_ty)
+cgCase (StgPrimApp op args res_ty)
          live_in_whole_case live_in_alts bndr srt (StgAlgAlts ty alts deflt)
   | isEnumerationTyCon tycon
   = getArgAmodes args `thenFC` \ arg_amodes ->
@@ -197,7 +197,7 @@ cgCase (StgCon (PrimOp op) args res_ty)
 Special case #2: inline PrimOps.
 
 \begin{code}
-cgCase (StgCon (PrimOp op) args res_ty) 
+cgCase (StgPrimApp op args res_ty) 
        live_in_whole_case live_in_alts bndr srt alts
   | not (primOpOutOfLine op)
   =
@@ -602,9 +602,10 @@ cgAlgDefault gc_flag is_fun uniq cc_slot must_label_branch
   =    -- We have arranged that Node points to the thing
     restoreCurrentCostCentre cc_slot `thenFC` \restore_cc ->
     getAbsC (absC restore_cc `thenC`
-             (if opt_GranMacros && emit_yield
-                then yield [node] False
-                else absC AbsCNop)                            `thenC`     
+             -- HWL: maybe need yield here
+             --(if emit_yield
+             --   then yield [node] True
+             --   else absC AbsCNop)                            `thenC`     
             possibleHeapCheck gc_flag is_fun [node] [] Nothing (cgExpr rhs)
        -- Node is live, but doesn't need to point at the thing itself;
        -- it's ok for Node to point to an indirection or FETCH_ME
@@ -633,9 +634,10 @@ cgAlgAlt gc_flag uniq cc_slot must_label_branch
   = 
     restoreCurrentCostCentre cc_slot `thenFC` \restore_cc ->
     getAbsC (absC restore_cc `thenC`
-            (if opt_GranMacros && emit_yield
-               then yield [node] True          -- XXX live regs wrong
-               else absC AbsCNop)                               `thenC`     
+             -- HWL: maybe need yield here
+            -- (if emit_yield
+            --    then yield [node] True               -- XXX live regs wrong
+            --    else absC AbsCNop)                               `thenC`    
             (case gc_flag of
                NoGC        -> mapFCs bindNewToTemp args `thenFC` \_ -> nopC
                GCMayHappen -> bindConArgs con args
@@ -667,9 +669,10 @@ cgUnboxedTupleAlt lbl cc_slot emit_yield (con,args,use_mask,rhs)
         restoreCurrentCostCentre cc_slot `thenFC` \restore_cc ->
        absC restore_cc `thenC`
 
-       (if opt_GranMacros && emit_yield
-           then yield live_regs True           -- XXX live regs wrong?
-           else absC AbsCNop)                         `thenC`     
+        -- HWL: maybe need yield here
+       -- (if emit_yield
+       --    then yield live_regs True         -- XXX live regs wrong?
+       --    else absC AbsCNop)                         `thenC`     
        let 
              -- ToDo: could maybe use Nothing here if stack_res is False
              -- since the heap-check can just return to the top of the