[project @ 2000-03-02 15:36:46 by panne]

More steps towards class/type/constructor deprecation

diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 24e51c9..b6dba20 100644 (file)
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -237,13 +237,15 @@ ifaceDeprecations if_hdl [] = return ()
 ifaceDeprecations if_hdl deprecations
   = printForIface if_hdl (vcat [
                ptext SLIT("{-## __D"),
-               vcat [ pprIfaceDeprec d <> semi | d <- deprecations ],
+               vcat [ pprIE ie <+> doubleQuotes (ppr txt) <> semi | Deprecation ie txt <- deprecations ],
                ptext SLIT("##-}")
        ])
   where
-    -- SUP: TEMPORARY HACK, ignoring module deprecations and constructors for now
-    pprIfaceDeprec (Deprecation (IEModuleContents _) txt) =           doubleQuotes (ppr txt)
-    pprIfaceDeprec (Deprecation (IEVar            n) txt) = ppr n <+> doubleQuotes (ppr txt)
+    pprIE (IEVar            n   ) = ppr n
+    pprIE (IEThingAbs       n   ) = ppr n
+    pprIE (IEThingAll       n   ) = hcat [ppr n, text "(..)"]
+    pprIE (IEThingWith      n ns) = ppr n <> parens (hcat (punctuate comma (map ppr ns)))
+    pprIE (IEModuleContents _   ) = empty
 \end{code}
 
 %************************************************************************

diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index f821b31..a893d60 100644 (file)
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -375,7 +375,8 @@ deprec              : STRING                { Deprecation (IEModuleContents undefined) $1 }
 
 -- SUP: TEMPORARY HACK
 deprec_name    :: { RdrNameIE }
-               : var_name              { IEVar $1 }
+               : var_name              { IEVar      $1 }
+               | data_name             { IEThingAbs $1 }
 
 -----------------------------------------------------------------------------
 

diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs
index d107ecc..d06319d 100644 (file)
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -519,6 +519,8 @@ renameSigs sigs_required binders lookup_occ_nm sigs
 -- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
 -- Doesn't seem worth much trouble to sort this.
 
+renameSig :: (RdrName -> RnMS Name) -> Sig RdrName -> RnMS (Sig Name, FreeVars)
+
 renameSig lookup_occ_nm (Sig v ty src_loc)
   = pushSrcLocRn src_loc $
     lookup_occ_nm v                            `thenRn` \ new_v ->
@@ -541,11 +543,10 @@ 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)
 
--- SUP: TEMPORARY HACK, ignoring module deprecations and constructors for now
-renameSig lookup_occ_nm (DeprecSig (Deprecation (IEVar v) txt) src_loc)
+renameSig lookup_occ_nm (DeprecSig (Deprecation ie txt) src_loc)
   = pushSrcLocRn src_loc $
-    lookup_occ_nm v            `thenRn` \ new_v ->
-    returnRn (DeprecSig (Deprecation (IEVar new_v) txt) src_loc, unitFV new_v)
+    renameIE lookup_occ_nm ie  `thenRn` \ (new_ie, fvs) ->
+    returnRn (DeprecSig (Deprecation new_ie txt) src_loc, fvs)
 
 renameSig lookup_occ_nm (InlineSig v p src_loc)
   = pushSrcLocRn src_loc $
@@ -558,15 +559,37 @@ renameSig lookup_occ_nm (NoInlineSig v p src_loc)
     returnRn (NoInlineSig new_v p src_loc, unitFV new_v)
 \end{code}
 
+\begin{code}
+renameIE :: (RdrName -> RnMS Name) -> IE RdrName -> RnMS (IE Name, FreeVars)
+renameIE lookup_occ_nm (IEVar v)
+  = lookup_occ_nm v            `thenRn` \ new_v ->
+    returnRn (IEVar new_v, unitFV new_v)
+
+renameIE lookup_occ_nm (IEThingAbs v)
+  = lookup_occ_nm v            `thenRn` \ new_v ->
+    returnRn (IEThingAbs new_v, unitFV new_v)
+
+renameIE lookup_occ_nm (IEThingAll v)
+  = lookup_occ_nm v            `thenRn` \ new_v ->
+    returnRn (IEThingAll new_v, unitFV new_v)
+
+renameIE lookup_occ_nm (IEThingWith v vs)
+  = lookup_occ_nm v            `thenRn` \ new_v ->
+    mapRn lookup_occ_nm vs     `thenRn` \ new_vs ->
+    returnRn (IEThingWith new_v new_vs, plusFVs [ unitFV x | x <- new_v:new_vs ])
+
+renameIE lookup_occ_nm (IEModuleContents m)
+  = returnRn (IEModuleContents m, emptyFVs)
+\end{code}
+
 Checking for distinct signatures; oh, so boring
 
 
 \begin{code}
 cmp_sig :: RenamedSig -> RenamedSig -> Ordering
 cmp_sig (Sig n1 _ _)         (Sig n2 _ _)         = n1 `compare` n2
--- SUP: TEMPORARY HACK, ignoring module deprecations and constructors for now
-cmp_sig (DeprecSig (Deprecation (IEVar n1) _) _)
-        (DeprecSig (Deprecation (IEVar n2) _) _)  = n1 `compare` n2
+cmp_sig (DeprecSig (Deprecation ie1 _) _)
+        (DeprecSig (Deprecation ie2 _) _)         = cmp_ie ie1 ie2
 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
@@ -579,6 +602,14 @@ cmp_sig other_1 other_2                                    -- Tags *must* be different
   | (sig_tag other_1) _LT_ (sig_tag other_2) = LT 
   | otherwise                               = GT
 
+cmp_ie :: IE Name -> IE Name -> Ordering
+cmp_ie (IEVar            n1  ) (IEVar            n2  ) = n1 `compare` n2
+cmp_ie (IEThingAbs       n1  ) (IEThingAbs       n2  ) = n1 `compare` n2
+cmp_ie (IEThingAll       n1  ) (IEThingAll       n2  ) = n1 `compare` n2
+-- Hmmm...
+cmp_ie (IEThingWith      n1 _) (IEThingWith      n2 _) = n1 `compare` n2
+cmp_ie (IEModuleContents _   ) (IEModuleContents _   ) = EQ
+
 sig_tag (Sig n1 _ _)              = (ILIT(1) :: FAST_INT)
 sig_tag (SpecSig n1 _ _)          = ILIT(2)
 sig_tag (InlineSig n1 _ _)        = ILIT(3)

diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 52b2a56..569ef96 100644 (file)
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -341,16 +341,23 @@ loadRule mod rules decl@(IfaceRuleDecl var body src_loc)
     mkImportedGlobalFromRdrName var            `thenRn` \ var_name ->
     returnRn ((unitNameSet var_name, (mod, RuleD decl)) `consBag` rules)
 
--- SUP: TEMPORARY HACK, ignoring module deprecations and constructors for now
+-- SUP: TEMPORARY HACK, ignoring module deprecations for now
 loadDeprec :: Module -> DeprecationEnv -> RdrNameDeprecation -> RnM d DeprecationEnv
 loadDeprec mod deprec_env (Deprecation (IEModuleContents _) txt)
   = traceRn (text "module deprecation not yet implemented:" <+> ppr mod <> colon <+> ppr txt) `thenRn_`
     returnRn deprec_env
-loadDeprec mod deprec_env (Deprecation (IEVar rdr_name) txt)
+loadDeprec mod deprec_env (Deprecation ie txt)
   = setModuleRn (moduleName mod) $
-    mkImportedGlobalFromRdrName rdr_name `thenRn` \ name ->
-    traceRn (text "loaded deprecation for" <+> ppr name <> colon <+> ppr txt) `thenRn_`
-    returnRn (addToNameEnv deprec_env name txt)
+    mapRn mkImportedGlobalFromRdrName (namesFromIE ie) `thenRn` \ names ->
+    traceRn (text "loaded deprecation(s) for" <+> hcat (punctuate comma (map ppr names)) <> colon <+> ppr txt) `thenRn_`
+    returnRn (extendNameEnv deprec_env (zip names (repeat txt)))
+
+namesFromIE :: IE a -> [a]
+namesFromIE (IEVar            n   ) = [n]
+namesFromIE (IEThingAbs       n   ) = [n]
+namesFromIE (IEThingAll       n   ) = [n]
+namesFromIE (IEThingWith      n ns) = n:ns
+namesFromIE (IEModuleContents _   ) = []
 \end{code}