Commit 6cce4a58 authored by panne's avatar panne
Browse files

[project @ 2000-02-20 17:51:30 by panne]

Get deprecation info out of the renamer again
parent 770cf880
......@@ -255,15 +255,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
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}
......@@ -272,14 +275,15 @@ 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 (DeprecMod _) _) = False
sig_for_me (DeprecSig (DeprecName n _) _) = f n
isFixitySig :: Sig name -> Bool
isFixitySig (FixSig _) = True
......@@ -295,7 +299,7 @@ isPragSig (SpecSig _ _ _) = True
isPragSig (InlineSig _ _ _) = True
isPragSig (NoInlineSig _ _ _) = True
isPragSig (SpecInstSig _ _) = True
isPragSig (DeprecSig _ _ _) = True
isPragSig (DeprecSig _ _) = True
isPragSig other = False
\end{code}
......@@ -306,6 +310,11 @@ instance (Outputable name) => Outputable (Sig name) where
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)]
......@@ -329,8 +338,7 @@ 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
ppr_phase Nothing = empty
ppr_phase (Just n) = int n
......
......@@ -52,17 +52,17 @@ All we actually declare here is the top-level structure for a module.
\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}
......@@ -86,11 +86,7 @@ instance (Outputable name, Outputable pat)
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
......
......@@ -92,7 +92,7 @@ endIface :: Maybe Handle -> IO ()
\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.
......@@ -36,7 +36,7 @@ import GlaExts
-----------------------------------------------------------------------------
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)
......@@ -218,8 +218,8 @@ module :: { RdrNameHsModule }
| 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]) }
......@@ -482,7 +482,7 @@ deprecations :: { RdrBinding }
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 }
......
......@@ -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 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 ->
......@@ -120,6 +120,17 @@ rename this_mod@(HsModule mod_name vers _ imports local_decls deprec loc)
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
......@@ -146,13 +157,13 @@ rename this_mod@(HsModule mod_name vers _ imports local_decls deprec loc)
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
......
......@@ -541,10 +541,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)
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 $
......@@ -561,12 +561,12 @@ 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
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)
......@@ -581,7 +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 (DeprecSig _ _) = ILIT(7)
sig_tag _ = panic# "tag(RnBinds)"
\end{code}
......@@ -614,7 +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)
sig_doc (DeprecSig _ loc) = (SLIT("DEPRECATED pragma"), loc)
missingSigWarn var
= sep [ptext SLIT("definition but no type signature for"), quotes (ppr var)]
......
......@@ -287,14 +287,16 @@ data ParsedIface
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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment