From: simonpj Date: Thu, 5 May 2005 07:43:29 +0000 (+0000) Subject: [project @ 2005-05-05 07:43:28 by simonpj] X-Git-Tag: Initial_conversion_from_CVS_complete~604 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=192c9dd5f5d87ad52253bed53d9ff39db8b71439;p=ghc-hetmet.git [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 --- 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 --- 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 --- 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 --- 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 --- 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 - You can deprecate a function, class, or type, with the + You can deprecate a function, class, type, or data constructor, with the following top-level declaration: {-# DEPRECATED f, C, T "Don't use these" #-} @@ -4339,6 +4339,13 @@ Assertion failures can be caught, see the documentation for the When you compile any module that imports and uses any of the specified entities, GHC will print the specified message. + 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 T + refers to either the type constructor T + or the data constructor T, 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 ). Any use of the deprecated item, or of anything from a deprecated