-- 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
+data Deprecation name
+ = DeprecMod DeprecTxt -- deprecation of a whole module
+ | DeprecName name DeprecTxt -- deprecation of a single name
+
type DeprecTxt = FAST_STRING -- reason/explanation for deprecation
\end{code}
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 (DeprecMod _) _) = False
+ sig_for_me (DeprecSig (DeprecName n _) _) = f n
isFixitySig :: Sig name -> Bool
isFixitySig (FixSig _) = True
isPragSig (InlineSig _ _ _) = True
isPragSig (NoInlineSig _ _ _) = True
isPragSig (SpecInstSig _ _) = True
-isPragSig (DeprecSig _ _ _) = True
+isPragSig (DeprecSig _ _) = True
isPragSig other = False
\end{code}
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 (DeprecMod txt)
+ = hsep [text "{-# DEPRECATED", doubleQuotes (ppr txt), text "#-}"]
+ ppr (DeprecName n txt)
+ = hsep [text "{-# DEPRECATED", ppr n, doubleQuotes (ppr txt), text "#-}"]
ppr_sig (Sig var ty _)
= sep [ppr var <+> dcolon, nest 4 (ppr 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
ppr_phase Nothing = empty
ppr_phase (Just n) = int n
\begin{code}
data HsModule name pat
= HsModule
- ModuleName -- module name
- (Maybe Version) -- source interface version number
- (Maybe [IE name]) -- export list; Nothing => export everything
- -- Just [] => export *nothing* (???)
- -- Just [...] => as you would expect...
- [ImportDecl name] -- We snaffle interesting stuff out of the
- -- imported interfaces early on, adding that
- -- info to TyDecls/etc; so this list is
- -- often empty, downstream.
- [HsDecl name pat] -- Type, class, value, and interface signature decls
- (Maybe DeprecTxt) -- reason/explanation for deprecation of this module
+ ModuleName -- module name
+ (Maybe Version) -- source interface version number
+ (Maybe [IE name]) -- export list; Nothing => export everything
+ -- Just [] => export *nothing* (???)
+ -- Just [...] => as you would expect...
+ [ImportDecl name] -- We snaffle interesting stuff out of the
+ -- imported interfaces early on, adding that
+ -- info to TyDecls/etc; so this list is
+ -- often empty, downstream.
+ [HsDecl name pat] -- Type, class, value, and interface signature decls
+ (Maybe (Deprecation name)) -- reason/explanation for deprecation of this module
SrcLoc
\end{code}
where
pp_header rest = case deprec of
Nothing -> pp_modname <+> rest
- Just dt -> vcat [
- pp_modname,
- hsep [ptext SLIT("{-# DEPRECATED"), doubleQuotes (ppr dt), ptext SLIT("#-}")],
- rest
- ]
+ Just d -> vcat [ pp_modname, ppr d, rest ]
pp_modname = ptext SLIT("module") <+> pprModuleName name
\end{code}
\begin{code}
-startIface mod (has_orphans, import_usages, ExportEnv avails fixities _)
+startIface mod (InterfaceDetails has_orphans import_usages (ExportEnv avails fixities _) _)
= case opt_ProduceHi of
Nothing -> return Nothing ; -- not producing any .hi file
{-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.22 2000/02/17 14:47:26 panne Exp $
+$Id: Parser.y,v 1.23 2000/02/20 17:51:45 panne Exp $
Haskell grammar.
-----------------------------------------------------------------------------
Conflicts: 14 shift/reduce
(note: it's currently 21 -- JRL, 31/1/2000)
- (note2: it' currently 36, but not because of me -- SUP, 15/2/2000 :-)
+ (note2: it's currently 36, but not because of me -- SUP, 15/2/2000 :-)
8 for abiguity in 'if x then y else z + 1'
(shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
| srcloc body
{ HsModule mAIN_Name Nothing Nothing (fst $2) (snd $2) Nothing $1 }
-maybemoddeprec :: { Maybe FAST_STRING }
- : '{-# DEPRECATED' STRING '#-}' { Just $2 }
+maybemoddeprec :: { Maybe (Deprecation RdrName) }
+ : '{-# DEPRECATED' STRING '#-}' { Just (DeprecMod $2) }
| {- empty -} { Nothing }
body :: { ([RdrNameImportDecl], [RdrNameHsDecl]) }
deprecation :: { RdrBinding }
: deprecated_names STRING
- { foldr1 RdrAndBindings [ RdrSig (DeprecSig n $2 l) | (l,n) <- $1 ] }
+ { foldr1 RdrAndBindings [ RdrSig (DeprecSig (DeprecName n $2) l) | (l,n) <- $1 ] }
deprecated_names :: { [(SrcLoc,RdrName)] }
: deprecated_names ',' deprecated_name { $3 : $1 }
\begin{code}
-rename this_mod@(HsModule mod_name vers _ imports local_decls deprec loc)
+rename this_mod@(HsModule mod_name vers _ imports local_decls mod_deprec loc)
= -- FIND THE GLOBAL NAME ENVIRONMENT
getGlobalNames this_mod `thenRn` \ maybe_stuff ->
slurpImpDecls real_source_fvs `thenRn` \ rn_imp_decls ->
let
rn_all_decls = rn_local_decls ++ rn_imp_decls
+
+ -- COLLECT ALL DEPRECATIONS
+ deprec_sigs = [ ds | ValD bnds <- rn_local_decls, ds <- collectDeprecs bnds ]
+
+ (rn_mod_deprec, deprecs) = case mod_deprec of
+ Nothing -> (Nothing, deprec_sigs)
+ Just (DeprecMod t) -> let dm = DeprecMod t in (Just dm, dm:deprec_sigs)
+
+ collectDeprecs EmptyBinds = []
+ collectDeprecs (ThenBinds x y) = collectDeprecs x ++ collectDeprecs y
+ collectDeprecs (MonoBind _ sigs _) = [ d | DeprecSig d _ <- sigs ]
in
-- EXIT IF ERRORS FOUND
renamed_module = HsModule mod_name vers
trashed_exports trashed_imports
rn_all_decls
- deprec
+ rn_mod_deprec
loc
in
rnDump rn_imp_decls rn_all_decls `thenRn` \ dump_action ->
returnRn (Just (mkThisModule mod_name,
renamed_module,
- (has_orphans, my_usages, export_env),
+ (InterfaceDetails has_orphans my_usages export_env deprecs),
name_supply,
direct_import_mods), dump_action)
where
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)
+renameSig lookup_occ_nm (DeprecSig (DeprecName v txt) src_loc)
= pushSrcLocRn src_loc $
lookup_occ_nm v `thenRn` \ new_v ->
- returnRn (DeprecSig new_v txt src_loc, unitFV new_v)
+ returnRn (DeprecSig (DeprecName new_v txt) src_loc, unitFV new_v)
renameSig lookup_occ_nm (InlineSig v p src_loc)
= pushSrcLocRn src_loc $
\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
-cmp_sig (SpecSig n1 ty1 _) (SpecSig n2 ty2 _)
+cmp_sig (Sig n1 _ _) (Sig n2 _ _) = n1 `compare` n2
+cmp_sig (DeprecSig (DeprecName n1 _) _) (DeprecSig (DeprecName 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
+cmp_sig (SpecSig n1 ty1 _) (SpecSig n2 ty2 _)
= -- may have many specialisations for one value;
-- but not ones that are exactly the same...
thenCmp (n1 `compare` n2) (cmpHsType compare ty1 ty2)
sig_tag (NoInlineSig n1 _ _) = ILIT(4)
sig_tag (SpecInstSig _ _) = ILIT(5)
sig_tag (FixSig _) = ILIT(6)
-sig_tag (DeprecSig _ _ _) = ILIT(7)
+sig_tag (DeprecSig _ _) = ILIT(7)
sig_tag _ = panic# "tag(RnBinds)"
\end{code}
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)
+sig_doc (DeprecSig _ loc) = (SLIT("DEPRECATED pragma"), loc)
missingSigWarn var
= sep [ptext SLIT("definition but no type signature for"), quotes (ppr var)]
pi_deprecs :: [(Maybe FAST_STRING, FAST_STRING)] -- Deprecations, the type is currently only a hack
}
-type InterfaceDetails = (WhetherHasOrphans,
- VersionInfo Name, -- Version information for what this module imports
- ExportEnv) -- What modules this one depends on
+data InterfaceDetails
+ = InterfaceDetails WhetherHasOrphans
+ (VersionInfo Name) -- Version information for what this module imports
+ ExportEnv -- What modules this one depends on
+ [Deprecation Name]
-- needed by Main to fish out the fixities assoc list.
getIfaceFixities :: InterfaceDetails -> Fixities
-getIfaceFixities (_, _, ExportEnv _ fs _) = fs
+getIfaceFixities (InterfaceDetails _ _ (ExportEnv _ fs _) _) = fs
type RdrNamePragma = () -- Fudge for now
projects / ghc-hetmet.git / commitdiff