[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).

diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs
index 2e048ec..dea4faf 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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)]