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

Final wibbles, I hope

diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs
index 0f7d74b..cce7cbd 100644 (file)
--- 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 f2c70c3..547ed7a 100644 (file)
--- 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 fb66916..780bda2 100644 (file)
--- 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 9c1bcdf..fe7d1e3 100644 (file)
--- 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 7327436..de3ae9e 100644 (file)
--- 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 c509c67..6d441b2 100644 (file)
--- 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