[project @ 2005-05-05 07:43:28 by simonpj]

Make it so that you can deprecate a data constructor.
Previously {-# DEPRECATED T "no" #-} referred only to the type
or class T.  Now it refers to the data constructor T as well,
just like in fixity declarations.

There's no way to deprecate the data constructor T without also
deprecating the type T, alas.  Same problem in fixity decls.
Main problem is coming up with a suitable concrete syntax to do
so.

We could consider merging this to the STABLE branch.

NB: Sven, the manual fixes are not XML-valideated!  I'm at home.

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index 55caa22..4fd33c4 100644 (file)
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -652,6 +652,11 @@ data Deprecs a
 
 type IfaceDeprecs = Deprecs [(OccName,DeprecTxt)]
 type Deprecations = Deprecs (NameEnv (OccName,DeprecTxt))
+       -- Keep the OccName so we can flatten the NameEnv to
+       -- get an IfaceDeprecs from a Deprecations
+       -- Only an OccName is needed, because a deprecation always
+       -- applies to things defined in the module in which the
+       -- deprecation appears.
 
 mkIfaceDepCache:: IfaceDeprecs -> Name -> Maybe DeprecTxt
 mkIfaceDepCache NoDeprecs        = \n -> Nothing

diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp
index c909f5d..4e670c6 100644 (file)
--- a/ghc/compiler/parser/Parser.y.pp
+++ b/ghc/compiler/parser/Parser.y.pp
@@ -280,6 +280,14 @@ TH_TY_QUOTE        { L _ ITtyQuote       }      -- ''T
 %%
 
 -----------------------------------------------------------------------------
+-- Identifiers; one of the entry points
+identifier :: { Located RdrName }
+       : qvar                          { $1 }
+       | qcon                          { $1 }
+       | qvarop                        { $1 }
+       | qconop                        { $1 }
+
+-----------------------------------------------------------------------------
 -- Module Header
 
 -- The place for module deprecation is really too restrictive, but if it
@@ -361,7 +369,7 @@ qcnames :: { [RdrName] }
 
 qcname         :: { Located RdrName }  -- Variable or data constructor
        :  qvar                                 { $1 }
-       |  gcon                                 { $1 }
+       |  qcon                                 { $1 }
 
 -----------------------------------------------------------------------------
 -- Import Declarations
@@ -859,7 +867,7 @@ gadt_constrs :: { Located [LConDecl RdrName] }
         | gadt_constr                   { L1 [$1] } 
 
 gadt_constr :: { LConDecl RdrName }
-        : qcon '::' sigtype
+        : con '::' sigtype
               { LL (GadtDecl $1 $3) } 
 
 constrs :: { Located [LConDecl RdrName] }
@@ -1073,7 +1081,7 @@ aexp2     :: { LHsExpr RdrName }
        | '$(' exp ')'          { LL $ HsSpliceE (mkHsSplice $2) }               -- $( exp )
 
        | TH_VAR_QUOTE qvar     { LL $ HsBracket (VarBr (unLoc $2)) }
-       | TH_VAR_QUOTE gcon     { LL $ HsBracket (VarBr (unLoc $2)) }
+       | TH_VAR_QUOTE qcon     { LL $ HsBracket (VarBr (unLoc $2)) }
        | TH_TY_QUOTE tyvar     { LL $ HsBracket (VarBr (unLoc $2)) }
        | TH_TY_QUOTE gtycon    { LL $ HsBracket (VarBr (unLoc $2)) }
        | '[|' exp '|]'         { LL $ HsBracket (ExpBr $2) }                       
@@ -1263,14 +1271,12 @@ dbinds  :: { Located [LIPBind RdrName] }
 dbind  :: { LIPBind RdrName }
 dbind  : ipvar '=' exp                 { LL (IPBind (unLoc $1) $3) }
 
------------------------------------------------------------------------------
--- Variables, Constructors and Operators.
+ipvar  :: { Located (IPName RdrName) }
+       : IPDUPVARID            { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
+       | IPSPLITVARID          { L1 (Linear  (mkUnqual varName (getIPSPLITVARID $1))) }
 
-identifier :: { Located RdrName }
-       : qvar                          { $1 }
-       | gcon                          { $1 }
-       | qvarop                        { $1 }
-       | qconop                        { $1 }
+-----------------------------------------------------------------------------
+-- Deprecations
 
 depreclist :: { Located [RdrName] }
 depreclist : deprec_var                        { L1 [unLoc $1] }
@@ -1278,49 +1284,25 @@ depreclist : deprec_var                 { L1 [unLoc $1] }
 
 deprec_var :: { Located RdrName }
 deprec_var : var                       { $1 }
-          | tycon                      { $1 }
-
-gcon   :: { Located RdrName }  -- Data constructor namespace
-       : sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
-       | qcon                  { $1 }
--- the case of '[:' ':]' is part of the production `parr'
-
-sysdcon        :: { Located DataCon }  -- Wired in data constructors
-       : '(' ')'               { LL unitDataCon }
-       | '(' commas ')'        { LL $ tupleCon Boxed $2 }
-       | '[' ']'               { LL nilDataCon }
-
-var    :: { Located RdrName }
-       : varid                 { $1 }
-       | '(' varsym ')'        { LL (unLoc $2) }
-
-qvar   :: { Located RdrName }
-       : qvarid                { $1 }
-       | '(' varsym ')'        { LL (unLoc $2) }
-       | '(' qvarsym1 ')'      { LL (unLoc $2) }
--- We've inlined qvarsym here so that the decision about
--- whether it's a qvar or a var can be postponed until
--- *after* we see the close paren.
-
-ipvar  :: { Located (IPName RdrName) }
-       : IPDUPVARID            { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
-       | IPSPLITVARID          { L1 (Linear  (mkUnqual varName (getIPSPLITVARID $1))) }
+          | con                        { $1 }
 
+-----------------------------------------
+-- Data constructors
 qcon   :: { Located RdrName }
        : qconid                { $1 }
        | '(' qconsym ')'       { LL (unLoc $2) }
+       | sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
+-- The case of '[:' ':]' is part of the production `parr'
 
-varop  :: { Located RdrName }
-       : varsym                { $1 }
-       | '`' varid '`'         { LL (unLoc $2) }
-
-qvarop :: { Located RdrName }
-       : qvarsym               { $1 }
-       | '`' qvarid '`'        { LL (unLoc $2) }
+con    :: { Located RdrName }
+       : conid                 { $1 }
+       | '(' consym ')'        { LL (unLoc $2) }
+       | sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
 
-qvaropm :: { Located RdrName }
-       : qvarsym_no_minus      { $1 }
-       | '`' qvarid '`'        { LL (unLoc $2) }
+sysdcon        :: { Located DataCon }  -- Wired in data constructors
+       : '(' ')'               { LL unitDataCon }
+       | '(' commas ')'        { LL $ tupleCon Boxed $2 }
+       | '[' ']'               { LL nilDataCon }
 
 conop :: { Located RdrName }
        : consym                { $1 }  
@@ -1364,12 +1346,16 @@ tyconsym :: { Located RdrName }
        : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
 
 -----------------------------------------------------------------------------
--- Any operator
+-- Operators
 
 op     :: { Located RdrName }   -- used in infix decls
        : varop                 { $1 }
        | conop                 { $1 }
 
+varop  :: { Located RdrName }
+       : varsym                { $1 }
+       | '`' varid '`'         { LL (unLoc $2) }
+
 qop    :: { LHsExpr RdrName }   -- used in sections
        : qvarop                { L1 $ HsVar (unLoc $1) }
        | qconop                { L1 $ HsVar (unLoc $1) }
@@ -1378,23 +1364,16 @@ qopm    :: { LHsExpr RdrName }   -- used in sections
        : qvaropm               { L1 $ HsVar (unLoc $1) }
        | qconop                { L1 $ HsVar (unLoc $1) }
 
------------------------------------------------------------------------------
--- VarIds
-
-qvarid :: { Located RdrName }
-       : varid                 { $1 }
-       | QVARID                { L1 $ mkQual varName (getQVARID $1) }
+qvarop :: { Located RdrName }
+       : qvarsym               { $1 }
+       | '`' qvarid '`'        { LL (unLoc $2) }
 
-varid :: { Located RdrName }
-       : varid_no_unsafe       { $1 }
-       | 'unsafe'              { L1 $! mkUnqual varName FSLIT("unsafe") }
-       | 'safe'                { L1 $! mkUnqual varName FSLIT("safe") }
-       | 'threadsafe'          { L1 $! mkUnqual varName FSLIT("threadsafe") }
+qvaropm :: { Located RdrName }
+       : qvarsym_no_minus      { $1 }
+       | '`' qvarid '`'        { LL (unLoc $2) }
 
-varid_no_unsafe :: { Located RdrName }
-       : VARID                 { L1 $! mkUnqual varName (getVARID $1) }
-       | special_id            { L1 $! mkUnqual varName (unLoc $1) }
-       | 'forall'              { L1 $! mkUnqual varName FSLIT("forall") }
+-----------------------------------------------------------------------------
+-- Type variables
 
 tyvar   :: { Located RdrName }
 tyvar   : tyvarid              { $1 }
@@ -1417,23 +1396,36 @@ tyvarsym :: { Located RdrName }
 --              or "*", because that's used for kinds
 tyvarsym : VARSYM              { L1 $! mkUnqual tvName (getVARSYM $1) }
 
--- These special_ids are treated as keywords in various places, 
--- but as ordinary ids elsewhere.   'special_id' collects all these
--- except 'unsafe' and 'forall' whose treatment differs depending on context
-special_id :: { Located UserFS }
-special_id
-       : 'as'                  { L1 FSLIT("as") }
-       | 'qualified'           { L1 FSLIT("qualified") }
-       | 'hiding'              { L1 FSLIT("hiding") }
-       | 'export'              { L1 FSLIT("export") }
-       | 'label'               { L1 FSLIT("label")  }
-       | 'dynamic'             { L1 FSLIT("dynamic") }
-       | 'stdcall'             { L1 FSLIT("stdcall") }
-       | 'ccall'               { L1 FSLIT("ccall") }
-
 -----------------------------------------------------------------------------
 -- Variables 
 
+var    :: { Located RdrName }
+       : varid                 { $1 }
+       | '(' varsym ')'        { LL (unLoc $2) }
+
+qvar   :: { Located RdrName }
+       : qvarid                { $1 }
+       | '(' varsym ')'        { LL (unLoc $2) }
+       | '(' qvarsym1 ')'      { LL (unLoc $2) }
+-- We've inlined qvarsym here so that the decision about
+-- whether it's a qvar or a var can be postponed until
+-- *after* we see the close paren.
+
+qvarid :: { Located RdrName }
+       : varid                 { $1 }
+       | QVARID                { L1 $ mkQual varName (getQVARID $1) }
+
+varid :: { Located RdrName }
+       : varid_no_unsafe       { $1 }
+       | 'unsafe'              { L1 $! mkUnqual varName FSLIT("unsafe") }
+       | 'safe'                { L1 $! mkUnqual varName FSLIT("safe") }
+       | 'threadsafe'          { L1 $! mkUnqual varName FSLIT("threadsafe") }
+
+varid_no_unsafe :: { Located RdrName }
+       : VARID                 { L1 $! mkUnqual varName (getVARID $1) }
+       | special_id            { L1 $! mkUnqual varName (unLoc $1) }
+       | 'forall'              { L1 $! mkUnqual varName FSLIT("forall") }
+
 qvarsym :: { Located RdrName }
        : varsym                { $1 }
        | qvarsym1              { $1 }
@@ -1454,7 +1446,20 @@ varsym_no_minus :: { Located RdrName } -- varsym not including '-'
        | special_sym           { L1 $ mkUnqual varName (unLoc $1) }
 
 
--- See comments with special_id
+-- These special_ids are treated as keywords in various places, 
+-- but as ordinary ids elsewhere.   'special_id' collects all these
+-- except 'unsafe' and 'forall' whose treatment differs depending on context
+special_id :: { Located UserFS }
+special_id
+       : 'as'                  { L1 FSLIT("as") }
+       | 'qualified'           { L1 FSLIT("qualified") }
+       | 'hiding'              { L1 FSLIT("hiding") }
+       | 'export'              { L1 FSLIT("export") }
+       | 'label'               { L1 FSLIT("label")  }
+       | 'dynamic'             { L1 FSLIT("dynamic") }
+       | 'stdcall'             { L1 FSLIT("stdcall") }
+       | 'ccall'               { L1 FSLIT("ccall") }
+
 special_sym :: { Located UserFS }
 special_sym : '!'      { L1 FSLIT("!") }
            | '.'       { L1 FSLIT(".") }

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 9ef2729..2fb2549 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -10,7 +10,7 @@ module RnEnv (
        lookupLocatedTopBndrRn, lookupTopBndrRn,
        lookupLocatedOccRn, lookupOccRn, 
        lookupLocatedGlobalOccRn, lookupGlobalOccRn,
-       lookupTopFixSigNames, lookupSrcOcc_maybe,
+       lookupLocalDataTcNames, lookupSrcOcc_maybe,
        lookupFixityRn, lookupLocatedSigOccRn, 
        lookupLocatedInstDeclBndr,
        lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
@@ -361,16 +361,21 @@ lookupQualifiedName rdr_name
 %*********************************************************
 
 \begin{code}
-lookupTopFixSigNames :: RdrName -> RnM [Name]
+lookupLocalDataTcNames :: RdrName -> RnM [Name]
 -- GHC extension: look up both the tycon and data con 
 -- for con-like things
-lookupTopFixSigNames rdr_name
+-- Complain if neither is in scope
+lookupLocalDataTcNames rdr_name
   | Just n <- isExact_maybe rdr_name   
        -- Special case for (:), which doesn't get into the GlobalRdrEnv
   = return [n] -- For this we don't need to try the tycon too
   | otherwise
   = do { mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name)
-       ; return [gre_name gre | Just gre <- mb_gres] }
+       ; case [gre_name gre | Just gre <- mb_gres] of
+           [] -> do { addErr (unknownNameErr rdr_name)
+                    ; return [] }
+           names -> return names
+    }
 
 --------------------------------
 bindLocalFixities :: [FixitySig RdrName] -> RnM a -> RnM a

diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 653f312..8d60be1 100644 (file)
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -20,7 +20,7 @@ import RnExpr         ( rnLExpr, checkTH )
 import RnTypes         ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
 import RnBinds         ( rnTopBinds, rnBinds, rnMethodBinds, 
                          rnBindsAndThen, renameSigs, checkSigs )
-import RnEnv           ( lookupTopBndrRn, lookupTopFixSigNames,
+import RnEnv           ( lookupTopBndrRn, lookupLocalDataTcNames,
                          lookupLocatedTopBndrRn, lookupLocatedOccRn,
                          lookupOccRn, newLocalsRn, 
                          bindLocatedLocalsFV, bindPatSigTyVarsFV,
@@ -164,12 +164,8 @@ rnFixityDecl fix_env (L loc (FixitySig rdr_name fixity))
        -- for con-like things
        -- If neither are in scope, report an error; otherwise
        -- add both to the fixity env
-     addLocM lookupTopFixSigNames rdr_name     `thenM` \ names ->
-     if null names then
-         addLocErr rdr_name unknownNameErr     `thenM_`
-         returnM fix_env
-     else
-         foldlM add fix_env names
+     addLocM lookupLocalDataTcNames rdr_name   `thenM` \ names ->
+     foldlM add fix_env names
   where
     add fix_env name
       = case lookupNameEnv fix_env name of
@@ -208,12 +204,12 @@ rnSrcDeprecDecls []
   = returnM NoDeprecs
 
 rnSrcDeprecDecls decls
-  = mappM (addLocM rn_deprec) decls    `thenM` \ pairs ->
-    returnM (DeprecSome (mkNameEnv (catMaybes pairs)))
+  = mappM (addLocM rn_deprec) decls    `thenM` \ pairs_s ->
+    returnM (DeprecSome (mkNameEnv (concat pairs_s)))
  where
    rn_deprec (Deprecation rdr_name txt)
-     = lookupTopBndrRn rdr_name        `thenM` \ name ->
-       returnM (Just (name, (rdrNameOcc rdr_name, txt)))
+     = lookupLocalDataTcNames rdr_name `thenM` \ names ->
+       returnM [(name, (nameOccName name, txt)) | name <- names]
 
 checkModDeprec :: Maybe DeprecTxt -> Deprecations
 -- Check for a module deprecation; done once at top level

diff --git a/ghc/docs/users_guide/glasgow_exts.xml b/ghc/docs/users_guide/glasgow_exts.xml
index aecfcbc..2df223b 100644 (file)
--- a/ghc/docs/users_guide/glasgow_exts.xml
+++ b/ghc/docs/users_guide/glasgow_exts.xml
@@ -4331,7 +4331,7 @@ Assertion failures can be caught, see the documentation for the
        </listitem>
 
        <listitem>
-         <para>You can deprecate a function, class, or type, with the
+         <para>You can deprecate a function, class, type, or data constructor, with the
          following top-level declaration:</para>
 <programlisting>
    {-# DEPRECATED f, C, T "Don't use these" #-}
@@ -4339,6 +4339,13 @@ Assertion failures can be caught, see the documentation for the
          <para>When you compile any module that imports and uses any
           of the specified entities, GHC will print the specified
           message.</para>
+         <para> You can only depecate entities declared at top level in the module
+         being compiled, and you can only use unqualified names in the list of
+         entities being deprecated.  A capitalised name, such as <literal>T</literal>
+         refers to <emphasis>either</emphasis> the type constructor <literal>T</literal>
+         <emphasis>or</emphasis> the data constructor <literal>T</literal>, or both if
+         both are in scope.  If both are in scope, there is currently no way to deprecate 
+         one without the other (c.f. fixities <xref linkend="infix-tycons"/>).</para>
        </listitem>
       </itemizedlist>
       Any use of the deprecated item, or of anything from a deprecated