[project @ 1999-04-23 13:53:28 by simonm]

Support for

	dataToTag# :: a -> Int#  (if a is a data type)

and (partial) support for

	tagToEnum# :: Int# -> a  (if a is an enumerated type)

The con2tag functions generated by derived Eq,Ord and Enum instances
are now replaced by dataToTag# for data types with a large number of
constructors.

3 files changed, 64 insertions, 37 deletions

diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index 99eb1ab89e..2182c17b8d 100644
--- 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.25 1999/03/22 16:57:10 simonm Exp $
+% $Id: CgCase.lhs,v 1.26 1999/04/23 13:53:28 simonm Exp $
 %
 %********************************************************
 %*							*
@@ -27,12 +27,12 @@ import AbsCUtils	( mkAbstractCs, mkAbsCStmts, mkAlgAltsCSwitch,
 			)
 import CoreSyn		( isDeadBinder )
 import CgUpdate		( reserveSeqFrame )
-import CgBindery	( getVolatileRegs, getArgAmodes,
+import CgBindery	( getVolatileRegs, getArgAmodes, getArgAmode,
 			  bindNewToReg, bindNewToTemp,
 			  bindNewPrimToAmode,
 			  rebindToStack, getCAddrMode,
 			  getCAddrModeAndInfo, getCAddrModeIfVolatile,
-			  buildContLivenessMask, nukeDeadBindings
+			  buildContLivenessMask, nukeDeadBindings,
 			)
 import CgCon		( bindConArgs, bindUnboxedTupleComponents )
 import CgHeapery	( altHeapCheck, yield )
@@ -62,8 +62,9 @@ import PrimRep		( getPrimRepSize, retPrimRepSize, PrimRep(..)
 import TyCon		( TyCon, isEnumerationTyCon, isUnboxedTupleTyCon,
 			  isNewTyCon, isAlgTyCon, isFunTyCon, isPrimTyCon,
 			  tyConDataCons, tyConFamilySize )
-import Type		( Type, typePrimRep, splitAlgTyConApp, splitTyConApp_maybe,
-			  splitFunTys, applyTys )
+import Type		( Type, typePrimRep, splitAlgTyConApp, 
+			  splitTyConApp_maybe,
+			   splitFunTys, applyTys )
 import Unique           ( Unique, Uniquable(..) )
 import Maybes		( maybeToBool )
 import Outputable
@@ -116,14 +117,6 @@ Against:
 
 	This never hurts us if there is only one alternative.
 
-
-*** NOT YET DONE ***  The difficulty is that \tr{!B!}, \tr{!C!} need
-to take account of what is live, and that includes all live volatile
-variables, even if they also have stable analogues.  Furthermore, the
-stack pointers must be lined up properly so that GC sees tidy stacks.
-If these things are done, then the heap checks can be done at \tr{!B!} and
-\tr{!C!} without a full save-volatile-vars sequence.
-
 \begin{code}
 cgCase	:: StgExpr
 	-> StgLiveVars
@@ -137,7 +130,26 @@ cgCase	:: StgExpr
 Several special cases for inline primitive operations.
 
 \begin{code}
-cgCase (StgCon (PrimOp op) args res_ty) live_in_whole_case live_in_alts bndr srt alts
+cgCase (StgCon (PrimOp TagToEnumOp) [arg] res_ty)
+         live_in_whole_case live_in_alts bndr srt alts
+  | isEnumerationTyCon tycon
+  = getArgAmode arg `thenFC` \amode ->
+    let
+	[res] = getPrimAppResultAmodes (getUnique bndr) alts
+    in
+    absC (CAssign res (CTableEntry 
+		     	(CLbl (mkClosureTblLabel tycon) PtrRep)
+		      	amode PtrRep)) `thenC`
+
+	-- Scrutinise the result
+    cgInlineAlts bndr alts
+
+  | otherwise = panic "cgCase: tagToEnum# of non-enumerated type"
+   where
+	(Just (tycon,_)) = splitTyConApp_maybe res_ty
+
+cgCase (StgCon (PrimOp op) args res_ty) 
+	live_in_whole_case live_in_alts bndr srt alts
   | not (primOpOutOfLine op)
   =
 	-- Get amodes for the arguments and results
@@ -338,22 +350,22 @@ getPrimAppResultAmodes
 	-> [CAddrMode]
 \end{code}
 
-\begin{code}
--- If there's an StgBindDefault which does use the bound
--- variable, then we can only handle it if the type involved is
--- an enumeration type.   That's important in the case
--- of comparisions:
---
---	case x ># y of
---	  r -> f r
---
--- The only reason for the restriction to *enumeration* types is our
--- inability to invent suitable temporaries to hold the results;
--- Elaborating the CTemp addr mode to have a second uniq field
--- (which would simply count from 1) would solve the problem.
--- Anyway, cgInlineAlts is now capable of handling all cases;
--- it's only this function which is being wimpish.
+If there's an StgBindDefault which does use the bound
+variable, then we can only handle it if the type involved is
+an enumeration type.   That's important in the case
+of comparisions:
 
+	case x ># y of
+	  r -> f r
+
+The only reason for the restriction to *enumeration* types is our
+inability to invent suitable temporaries to hold the results;
+Elaborating the CTemp addr mode to have a second uniq field
+(which would simply count from 1) would solve the problem.
+Anyway, cgInlineAlts is now capable of handling all cases;
+it's only this function which is being wimpish.
+
+\begin{code}
 getPrimAppResultAmodes uniq (StgAlgAlts ty alts 
 				(StgBindDefault rhs))
   | isEnumerationTyCon spec_tycon = [tag_amode]
diff --git a/ghc/compiler/codeGen/CgConTbls.lhs b/ghc/compiler/codeGen/CgConTbls.lhs
index 6e4a1493c1..12c50649ff 100644
--- a/ghc/compiler/codeGen/CgConTbls.lhs
+++ b/ghc/compiler/codeGen/CgConTbls.lhs
@@ -20,7 +20,7 @@ import ClosureInfo	( layOutStaticClosure, layOutDynCon,
 			)
 import CostCentre	( dontCareCCS )
 import FiniteMap	( fmToList, FiniteMap )
-import DataCon		( DataCon, dataConTag, dataConName, dataConRawArgTys )
+import DataCon		( DataCon, dataConName, dataConRawArgTys )
 import Const		( Con(..) )
 import Name		( getOccString )
 import PrimRep		( getPrimRepSize, PrimRep(..) )
@@ -142,8 +142,6 @@ genConInfo comp_info tycon data_con
 
     static_code  = CClosureInfoAndCode static_ci body Nothing con_descr
 
-    tag	    	 = dataConTag data_con
-
     cost_centre  = mkCCostCentreStack dontCareCCS -- not worried about static data costs
 
     -- For zero-arity data constructors, or, more accurately,
diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs
index 6e02c259f0..7b11429f4e 100644
--- a/ghc/compiler/codeGen/CgExpr.lhs
+++ b/ghc/compiler/codeGen/CgExpr.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgExpr.lhs,v 1.22 1999/03/25 13:13:51 simonm Exp $
+% $Id: CgExpr.lhs,v 1.23 1999/04/23 13:53:29 simonm Exp $
 %
 %********************************************************
 %*							*
@@ -22,7 +22,7 @@ import AbsCUtils	( mkAbstractCs )
 import CLabel		( mkClosureTblLabel )
 
 import SMRep		( fixedHdrSize )
-import CgBindery	( getArgAmodes, CgIdInfo, nukeDeadBindings )
+import CgBindery	( getArgAmodes, getArgAmode, CgIdInfo, nukeDeadBindings)
 import CgCase		( cgCase, saveVolatileVarsAndRegs, 
 			  restoreCurrentCostCentre, freeCostCentreSlot,
 			  splitTyConAppThroughNewTypes )
@@ -48,7 +48,7 @@ import PrimOp		( primOpOutOfLine,
 import PrimRep		( getPrimRepSize, PrimRep(..), isFollowableRep )
 import TyCon		( maybeTyConSingleCon,
 			  isUnboxedTupleTyCon, isEnumerationTyCon )
-import Type		( Type, typePrimRep )
+import Type		( Type, typePrimRep, splitTyConApp_maybe )
 import Maybes		( assocMaybe, maybeToBool )
 import Unique		( mkBuiltinUnique )
 import BasicTypes	( TopLevelFlag(..), RecFlag(..) )
@@ -116,12 +116,30 @@ NOTE about _ccall_GC_:
 A _ccall_GC_ is treated as an out-of-line primop for the case
 expression code, because we want a proper stack frame on the stack
 when we perform it.  When we get here, however, we need to actually
-perform the call, so we treat it an an inline primop.
+perform the call, so we treat it as an inline primop.
 
 \begin{code}
 cgExpr (StgCon (PrimOp op@(CCallOp _ _ may_gc@True _)) args res_ty)
   = primRetUnboxedTuple op args res_ty
 
+-- tagToEnum# is special: we need to pull the constructor out of the table,
+-- and perform an appropriate return.
+
+cgExpr (StgCon (PrimOp TagToEnumOp) [arg] res_ty) 
+  | isEnumerationTyCon tycon =
+	getArgAmode arg `thenFC` \amode ->
+	performReturn (CAssign (CReg node) 
+			(CTableEntry 
+		          (CLbl (mkClosureTblLabel tycon) PtrRep)
+		          amode PtrRep))
+		  (\ sequel -> mkDynamicAlgReturnCode tycon amode sequel)
+
+  | otherwise = panic "cgExpr: tagToEnum# of non-enumerated type"
+
+   where
+	(Just (tycon,_)) = splitTyConApp_maybe res_ty
+
+
 cgExpr x@(StgCon (PrimOp op) args res_ty)
   | primOpOutOfLine op = tailCallPrimOp op args
   | otherwise
@@ -144,7 +162,6 @@ cgExpr x@(StgCon (PrimOp op) args res_ty)
 	ReturnsAlg tycon
 	    | isUnboxedTupleTyCon tycon -> primRetUnboxedTuple op args res_ty
 
-
 	    | isEnumerationTyCon  tycon ->
 	     	performReturn
 	      	     (COpStmt [dyn_tag] op arg_amodes [{-no vol_regs-}])