From 48eec5685167006e5e0932d334f8bd2017d7f5d3 Mon Sep 17 00:00:00 2001 From: panne Date: Thu, 17 Feb 2000 14:47:32 +0000 Subject: [PATCH] [project @ 2000-02-17 14:47:21 by panne] Result of my daily DEPRECATED-hour: Now it's possible to use the pragma without harm, but nothing spectacular happens yet, only the usual renamer checks (duplication, var in scope). --- ghc/compiler/hsSyn/HsBinds.lhs | 7 ++++--- ghc/compiler/parser/Parser.y | 12 ++++++------ ghc/compiler/rename/Rename.lhs | 4 ++-- ghc/compiler/rename/RnBinds.lhs | 8 ++++++++ 4 files changed, 20 insertions(+), 11 deletions(-) diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs index 2e048ec..dea4faf 100644 --- a/ghc/compiler/hsSyn/HsBinds.lhs +++ b/ghc/compiler/hsSyn/HsBinds.lhs @@ -259,6 +259,7 @@ data Sig name | DeprecSig name -- DEPRECATED DeprecTxt + SrcLoc data FixitySig name = FixitySig name Fixity SrcLoc @@ -278,7 +279,7 @@ sigsForMe f sigs sig_for_me (NoInlineSig n _ _) = f n sig_for_me (SpecInstSig _ _) = False sig_for_me (FixSig (FixitySig n _ _)) = f n - sig_for_me (DeprecSig n _) = f n + sig_for_me (DeprecSig n _ _) = f n isFixitySig :: Sig name -> Bool isFixitySig (FixSig _) = True @@ -294,7 +295,7 @@ isPragSig (SpecSig _ _ _) = True isPragSig (InlineSig _ _ _) = True isPragSig (NoInlineSig _ _ _) = True isPragSig (SpecInstSig _ _) = True -isPragSig (DeprecSig _ _) = True +isPragSig (DeprecSig _ _ _) = True isPragSig other = False \end{code} @@ -328,7 +329,7 @@ ppr_sig (SpecInstSig ty _) ppr_sig (FixSig fix_sig) = ppr fix_sig -ppr_sig (DeprecSig n txt) +ppr_sig (DeprecSig n txt _) = hsep [text "{-# DEPRECATED", ppr n, doubleQuotes(ppr txt), text "#-}"] ppr_phase Nothing = empty diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y index 88ba099..d45e396 100644 --- a/ghc/compiler/parser/Parser.y +++ b/ghc/compiler/parser/Parser.y @@ -1,6 +1,6 @@ {- ----------------------------------------------------------------------------- -$Id: Parser.y,v 1.21 2000/02/15 22:18:34 panne Exp $ +$Id: Parser.y,v 1.22 2000/02/17 14:47:26 panne Exp $ Haskell grammar. @@ -482,15 +482,15 @@ deprecations :: { RdrBinding } deprecation :: { RdrBinding } : deprecated_names STRING - { foldr1 RdrAndBindings [ RdrSig (DeprecSig n $2) | n <- $1 ] } + { foldr1 RdrAndBindings [ RdrSig (DeprecSig n $2 l) | (l,n) <- $1 ] } -deprecated_names :: { [RdrName] } +deprecated_names :: { [(SrcLoc,RdrName)] } : deprecated_names ',' deprecated_name { $3 : $1 } | deprecated_name { [$1] } -deprecated_name :: { RdrName } - : var { $1 } - | tycon { $1 } +deprecated_name :: { (SrcLoc,RdrName) } + : srcloc var { ($1, $2) } + | srcloc tycon { ($1, $2) } ----------------------------------------------------------------------------- -- Foreign import/export diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index 21e8dd9..c3ede2f 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -90,7 +90,7 @@ renameModule us this_mod@(HsModule mod_name vers exports imports local_decls _ l \begin{code} -rename this_mod@(HsModule mod_name vers _ imports local_decls _ loc) +rename this_mod@(HsModule mod_name vers _ imports local_decls deprec loc) = -- FIND THE GLOBAL NAME ENVIRONMENT getGlobalNames this_mod `thenRn` \ maybe_stuff -> @@ -146,7 +146,7 @@ rename this_mod@(HsModule mod_name vers _ imports local_decls _ loc) renamed_module = HsModule mod_name vers trashed_exports trashed_imports rn_all_decls - Nothing + deprec loc in rnDump rn_imp_decls rn_all_decls `thenRn` \ dump_action -> diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs index 0036a53..defbee5 100644 --- a/ghc/compiler/rename/RnBinds.lhs +++ b/ghc/compiler/rename/RnBinds.lhs @@ -541,6 +541,11 @@ renameSig lookup_occ_nm (FixSig (FixitySig v fix src_loc)) lookup_occ_nm v `thenRn` \ new_v -> returnRn (FixSig (FixitySig new_v fix src_loc), unitFV new_v) +renameSig lookup_occ_nm (DeprecSig v txt src_loc) + = pushSrcLocRn src_loc $ + lookup_occ_nm v `thenRn` \ new_v -> + returnRn (DeprecSig new_v txt src_loc, unitFV new_v) + renameSig lookup_occ_nm (InlineSig v p src_loc) = pushSrcLocRn src_loc $ lookup_occ_nm v `thenRn` \ new_v -> @@ -557,6 +562,7 @@ Checking for distinct signatures; oh, so boring \begin{code} cmp_sig :: RenamedSig -> RenamedSig -> Ordering cmp_sig (Sig n1 _ _) (Sig n2 _ _) = n1 `compare` n2 +cmp_sig (DeprecSig n1 _ _) (DeprecSig n2 _ _) = n1 `compare` n2 cmp_sig (InlineSig n1 _ _) (InlineSig n2 _ _) = n1 `compare` n2 cmp_sig (NoInlineSig n1 _ _) (NoInlineSig n2 _ _) = n1 `compare` n2 cmp_sig (SpecInstSig ty1 _) (SpecInstSig ty2 _) = cmpHsType compare ty1 ty2 @@ -575,6 +581,7 @@ sig_tag (InlineSig n1 _ _) = ILIT(3) sig_tag (NoInlineSig n1 _ _) = ILIT(4) sig_tag (SpecInstSig _ _) = ILIT(5) sig_tag (FixSig _) = ILIT(6) +sig_tag (DeprecSig _ _ _) = ILIT(7) sig_tag _ = panic# "tag(RnBinds)" \end{code} @@ -607,6 +614,7 @@ sig_doc (InlineSig _ _ loc) = (SLIT("INLINE pragma"),loc) sig_doc (NoInlineSig _ _ loc) = (SLIT("NOINLINE pragma"),loc) sig_doc (SpecInstSig _ loc) = (SLIT("SPECIALISE instance pragma"),loc) sig_doc (FixSig (FixitySig _ _ loc)) = (SLIT("fixity declaration"), loc) +sig_doc (DeprecSig _ _ loc) = (SLIT("DEPRECATED pragma"), loc) missingSigWarn var = sep [ptext SLIT("definition but no type signature for"), quotes (ppr var)] -- 1.7.10.4