[project @ 2000-02-25 14:55:31 by panne]

[ghc-hetmet.git] / ghc / compiler / hsSyn / HsBinds.lhs

diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs
index dea4faf..60a2996 100644 (file)
--- a/ghc/compiler/hsSyn/HsBinds.lhs
+++ b/ghc/compiler/hsSyn/HsBinds.lhs
@@ -15,6 +15,7 @@ import {-# SOURCE #-} HsMatches ( pprMatches, Match, pprGRHSs, GRHSs )
 
 -- friends:
 import HsTypes         ( HsType )
+import HsImpExp                ( IE(..), ieName )
 import CoreSyn         ( CoreExpr )
 import PprCore         ()         -- Instances for Outputable
 
@@ -255,15 +256,18 @@ data Sig name
                                -- current instance decl
                SrcLoc
 
-  | FixSig     (FixitySig name)                -- Fixity declaration
+  | FixSig     (FixitySig name)        -- Fixity declaration
 
-  | DeprecSig  name            -- DEPRECATED
-               DeprecTxt
+  | DeprecSig  (Deprecation name)      -- DEPRECATED
                SrcLoc
 
 
 data FixitySig name  = FixitySig name Fixity SrcLoc
 
+-- We use exported entities for things to deprecate. Cunning trick (hack?):
+-- `IEModuleContents undefined' is used for module deprecation.
+data Deprecation name = Deprecation (IE name) DeprecTxt
+
 type DeprecTxt = FAST_STRING   -- reason/explanation for deprecation
 \end{code}
 
@@ -272,14 +276,17 @@ sigsForMe :: (name -> Bool) -> [Sig name] -> [Sig name]
 sigsForMe f sigs
   = filter sig_for_me sigs
   where
-    sig_for_me (Sig         n _ _)       = f n
-    sig_for_me (ClassOpSig  n _ _ _ _)           = f n
-    sig_for_me (SpecSig     n _ _)       = f n
-    sig_for_me (InlineSig   n _   _)     = f n  
-    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 (Sig         n _ _)                         = f n
+    sig_for_me (ClassOpSig  n _ _ _ _)                     = f n
+    sig_for_me (SpecSig     n _ _)                         = f n
+    sig_for_me (InlineSig   n _   _)                       = f n
+    sig_for_me (NoInlineSig n _   _)                       = f n
+    sig_for_me (SpecInstSig _ _)                           = False
+    sig_for_me (FixSig (FixitySig n _ _))                  = f n
+    sig_for_me
+       (DeprecSig (Deprecation (IEModuleContents _) _) _) = False
+    sig_for_me
+       (DeprecSig (Deprecation d                    _) _) = f (ieName d)
 
 isFixitySig :: Sig name -> Bool
 isFixitySig (FixSig _) = True
@@ -295,7 +302,7 @@ isPragSig (SpecSig _ _ _)     = True
 isPragSig (InlineSig   _ _ _) = True
 isPragSig (NoInlineSig _ _ _) = True
 isPragSig (SpecInstSig _ _)   = True
-isPragSig (DeprecSig _ _ _)   = True
+isPragSig (DeprecSig _ _)     = True
 isPragSig other                      = False
 \end{code}
 
@@ -303,10 +310,7 @@ isPragSig other                  = False
 instance (Outputable name) => Outputable (Sig name) where
     ppr sig = ppr_sig sig
 
-instance Outputable name => Outputable (FixitySig name) where
-  ppr (FixitySig name fixity loc) = sep [ppr fixity, ppr name]
-
-
+ppr_sig :: Outputable name => Sig name -> SDoc
 ppr_sig (Sig var ty _)
       = sep [ppr var <+> dcolon, nest 4 (ppr ty)]
 
@@ -329,10 +333,19 @@ ppr_sig (SpecInstSig ty _)
 
 ppr_sig (FixSig fix_sig) = ppr fix_sig
 
-ppr_sig (DeprecSig n txt _)
-      = hsep [text "{-# DEPRECATED", ppr n, doubleQuotes(ppr txt), text "#-}"]
+ppr_sig (DeprecSig deprec _) = ppr deprec
+
+instance Outputable name => Outputable (FixitySig name) where
+  ppr (FixitySig name fixity loc) = sep [ppr fixity, ppr name]
+
+instance Outputable name => Outputable (Deprecation name) where
+   ppr (Deprecation (IEModuleContents _) txt)
+      = hsep [text "{-# DEPRECATED",            doubleQuotes (ppr txt), text "#-}"]
+   ppr (Deprecation thing txt)
+      = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
 
-ppr_phase Nothing = empty
+ppr_phase :: Maybe Int -> SDoc
+ppr_phase Nothing  = empty
 ppr_phase (Just n) = int n
 \end{code}