[project @ 2005-04-05 08:25:06 by simonpj]

Final wibbles, I hope

6 files changed, 22 insertions, 15 deletions

diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs
index 0f7d74bbc6..cce7cbd206 100644
--- a/ghc/compiler/basicTypes/DataCon.lhs
+++ b/ghc/compiler/basicTypes/DataCon.lhs
@@ -100,10 +100,10 @@ The data con has one or two Ids associated with it:
 		- strict args may be flattened
 	The worker is very like a primop, in that it has no binding.
 
-	Newtypes currently do get a worker-Id, but it is never used.
+	Newtypes have no worker Id
 
 
-  The "wrapper Id", $wC, whose type is exactly what it looks like
+  The "wrapper Id", $WC, whose type is exactly what it looks like
 	in the source program. It is an ordinary function,
 	and it gets a top-level binding like any other function.
 
diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index f2c70c3c7b..547ed7adde 100644
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -29,7 +29,7 @@ module Id (
 	isRecordSelector,
 	isPrimOpId, isPrimOpId_maybe, 
 	isFCallId, isFCallId_maybe,
-	isDataConWorkId, isDataConWorkId_maybe, 
+	isDataConWorkId, isDataConWorkId_maybe, idDataCon,
 	isBottomingId, idIsFrom,
 	hasNoBinding, 
 
@@ -100,7 +100,7 @@ import IdInfo
 #ifdef OLD_STRICTNESS
 import qualified Demand	( Demand )
 #endif
-import DataCon		( isUnboxedTupleCon )
+import DataCon		( DataCon, isUnboxedTupleCon )
 import NewDemand	( Demand, StrictSig, topDmd, topSig, isBottomingSig )
 import Name	 	( Name, OccName, nameIsLocalOrFrom, 
 			  mkSystemVarName, mkSystemVarNameEncoded, mkInternalName,
@@ -273,6 +273,17 @@ isDataConWorkId_maybe id = case globalIdDetails id of
 			  DataConWorkId con -> Just con
 			  other	            -> Nothing
 
+idDataCon :: Id -> DataCon
+-- Get from either the worker or the wrapper to the DataCon
+-- Currently used only in the desugarer
+--	 INVARIANT: idDataCon (dataConWrapId d) = d
+-- (Remember, dataConWrapId can return either the wrapper or the worker.)
+idDataCon id = case globalIdDetails id of
+		  DataConWorkId con -> con
+		  DataConWrapId con -> con
+		  other		    -> pprPanic "idDataCon" (ppr id)
+
+
 -- hasNoBinding returns True of an Id which may not have a
 -- binding, even though it is defined in this module.  
 -- Data constructor workers used to be things of this kind, but
diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index fb66916983..780bda2906 100644
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -501,7 +501,7 @@ mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
 
 -- Data constructor workers are made by setting the name space
 -- of the data constructor OccName (which should be a DataName)
--- to DataName
+-- to VarName
 mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ 
 \end{code}
 
diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index 9c1bcdf047..fe7d1e317c 100644
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ b/ghc/compiler/deSugar/DsExpr.lhs
@@ -40,7 +40,7 @@ import CoreSyn
 import CoreUtils	( exprType, mkIfThenElse, bindNonRec )
 
 import CostCentre	( mkUserCC )
-import Id		( Id, idType, idName, isDataConWorkId_maybe )
+import Id		( Id, idType, idName, idDataCon )
 import PrelInfo		( rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID )
 import DataCon		( DataCon, dataConWrapId, dataConFieldLabels, dataConInstOrigArgTys )
 import DataCon		( isVanillaDataCon )
@@ -421,8 +421,8 @@ dsExpr (RecordCon (L _ data_con_id) con_expr rbinds)
 	      []         -> mkErrorAppDs rEC_CON_ERROR_ID arg_ty (showSDoc (ppr lbl))
 	unlabelled_bottom arg_ty = mkErrorAppDs rEC_CON_ERROR_ID arg_ty ""
 
-	labels = dataConFieldLabels (fromJust (isDataConWorkId_maybe data_con_id))
-	-- The data_con_id is guaranteed to be the work id of the constructor
+	labels = dataConFieldLabels (idDataCon data_con_id)
+	-- The data_con_id is guaranteed to be the wrapper id of the constructor
     in
 
     (if null labels
diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs
index 7327436583..de3ae9e8dd 100644
--- a/ghc/compiler/hsSyn/HsExpr.lhs
+++ b/ghc/compiler/hsSyn/HsExpr.lhs
@@ -104,9 +104,6 @@ data HsExpr id
 		Fixity		-- Renamer adds fixity; bottom until then
 		(LHsExpr id)	-- right operand
 
-  -- We preserve prefix negation and parenthesis for the precedence parser.
-  -- They are eventually removed by the type checker.
-
   | NegApp	(LHsExpr id)	-- negated expr
 		(SyntaxExpr id)	-- Name of 'negate'
 
@@ -153,7 +150,7 @@ data HsExpr id
 
 	-- Record construction
   | RecordCon	(Located id)		-- The constructor.  After type checking
-					-- it's the *worker* Id of the constructor
+					-- it's the dataConWrapId of the constructor
 		PostTcExpr		-- Data con Id applied to type args
 		(HsRecordBinds id)
 
diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index c509c67736..6d441b2497 100644
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -49,7 +49,7 @@ import Kind		( openTypeKind, liftedTypeKind, argTypeKind )
 
 import Id		( idType, recordSelectorFieldLabel, isRecordSelector )
 import DataCon		( DataCon, dataConFieldLabels, dataConStrictMarks, 
-			  dataConWrapId, dataConWorkId )
+			  dataConWrapId )
 import Name		( Name )
 import TyCon		( TyCon, FieldLabel, tyConTyVars, tyConStupidTheta, 
 			  tyConDataCons, tyConFields )
@@ -381,7 +381,7 @@ tcExpr expr@(RecordCon con@(L loc con_name) _ rbinds) res_ty
  	-- Check for missing fields
     checkMissingFields data_con rbinds		`thenM_` 
 
-    returnM (RecordCon (L loc (dataConWorkId data_con)) con_expr rbinds')
+    returnM (RecordCon (L loc (dataConWrapId data_con)) con_expr rbinds')
 
 -- The main complication with RecordUpd is that we need to explicitly
 -- handle the *non-updated* fields.  Consider:
@@ -791,7 +791,6 @@ tcId orig id_name	-- Look up the Id and instantiate its type
 	  -> do	{ checkProcLevel id proc_level
 		; tc_local_id id th_level }
 
-	-- THis 
     ;	other -> failWithTc (ppr other <+> ptext SLIT("used where a value identifer was expected"))
     }
   where