First steps towards DEPRECATED before Rosebank (12yrs) takes its toll.
Nothing very functional yet, but at least hsc can be compiled and it
still compiles the Prelude.
Parsing the pragma turned out to be a little bit more complicated than
expected, here the comment from Parser.y:
The place for module deprecation is really too restrictive, but if it
was allowed at its natural place just before 'module', we get an ugly
s/r conflict with the second alternative. Another solution would be the
introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
either, and DEPRECATED is only expected to be used by people who really
know what they are doing. :-)
Net result: Module deprecation is allowed exactly behind the module's
name and nowhere else. I probably have to think a little bit more
about this some day...
| FixSig (FixitySig name) -- Fixity declaration
+ | DeprecSig name -- DEPRECATED
+ DeprecTxt
+
data FixitySig name = FixitySig name Fixity SrcLoc
+
+type DeprecTxt = FAST_STRING -- reason/explanation for deprecation
\end{code}
\begin{code}
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
isFixitySig :: Sig name -> Bool
isFixitySig (FixSig _) = True
isPragSig (InlineSig _ _ _) = True
isPragSig (NoInlineSig _ _ _) = True
isPragSig (SpecInstSig _ _) = True
+isPragSig (DeprecSig _ _) = True
isPragSig other = False
\end{code}
]
ppr_sig (InlineSig var phase _)
- = hsep [text "{-# INLINE", ppr_phase phase, ppr var, text "#-}"]
+ = hsep [text "{-# INLINE", ppr_phase phase, ppr var, text "#-}"]
ppr_sig (NoInlineSig var phase _)
- = hsep [text "{-# NOINLINE", ppr_phase phase, ppr var, text "#-}"]
+ = hsep [text "{-# NOINLINE", ppr_phase phase, ppr var, text "#-}"]
ppr_sig (SpecInstSig ty _)
= hsep [text "{-# SPECIALIZE instance", ppr ty, text "#-}"]
ppr_sig (FixSig fix_sig) = ppr fix_sig
+ppr_sig (DeprecSig n txt)
+ = hsep [text "{-# DEPRECATED", ppr n, ppr txt, text "#-}"]
+
ppr_phase Nothing = empty
ppr_phase (Just n) = int n
\end{code}
-- 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
SrcLoc
\end{code}
=> Outputable (HsModule name pat) where
ppr (HsModule name iface_version exports imports
- decls src_loc)
+ decls deprec src_loc)
= vcat [
+ case deprec of
+ Nothing -> empty
+ Just dt -> hsep [ptext SLIT("{-# DEPRECATED"), ppr dt, ptext SLIT("#-}")],
case exports of
Nothing -> hsep [ptext SLIT("module"), pprModuleName name, ptext SLIT("where")]
Just es -> vcat [
ghcExit 1
return (error "parseModule") -- just to get the types right
- POk _ m@(HsModule mod _ _ _ _ _) ->
+ POk _ m@(HsModule mod _ _ _ _ _ _) ->
return (mod, m)
where
glaexts | opt_GlasgowExts = 1#
then \ what -> hPutStr stderr ("*** "++what++":\n")
else \ what -> return ()
-ppSourceStats short (HsModule name version exports imports decls src_loc)
+ppSourceStats short (HsModule name version exports imports decls _ src_loc)
= (if short then hcat else vcat)
(map pp_val
[("ExportAll ", export_all), -- 1 if no export list
| ITunfold InlinePragInfo
| ITstrict ([Demand], Bool)
| ITrules
+ | ITdeprecated
| ITcprinfo (CprInfo)
| IT__scc
| ITsccAllCafs
| ITinline_prag
| ITnoinline_prag
| ITrules_prag
+ | ITdeprecated_prag
| ITline_prag
| ITclose_prag
( "NOTINLINE", ITnoinline_prag ),
( "LINE", ITline_prag ),
( "RULES", ITrules_prag ),
- ( "RULEZ", ITrules_prag ) -- american spelling :-)
+ ( "RULEZ", ITrules_prag ), -- american spelling :-)
+ ( "DEPRECATED", ITdeprecated_prag )
]
haskellKeywordsFM = listToUFM $
("__P", ITspecialise),
("__C", ITnocaf),
("__R", ITrules),
+ ("__D", ITdeprecated),
("__U", ITunfold NoInlinePragInfo),
("__ccall", ITccall (False, False, False)),
{-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.20 2000/02/09 18:32:10 lewie Exp $
+$Id: Parser.y,v 1.21 2000/02/15 22:18:34 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 :-)
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)
'{-# INLINE' { ITinline_prag }
'{-# NOINLINE' { ITnoinline_prag }
'{-# RULES' { ITrules_prag }
+ '{-# DEPRECATED' { ITdeprecated_prag }
'#-}' { ITclose_prag }
{-
PRIMSTRING { ITprimstring $$ }
PRIMINTEGER { ITprimint $$ }
PRIMFLOAT { ITprimfloat $$ }
- PRIMDOUBLE { ITprimdouble $$ }
+ PRIMDOUBLE { ITprimdouble $$ }
CLITLIT { ITlitlit $$ }
UNKNOWN { ITunknown $$ }
-----------------------------------------------------------------------------
-- Module Header
+-- The place for module deprecation is really too restrictive, but if it
+-- was allowed at its natural place just before 'module', we get an ugly
+-- s/r conflict with the second alternative. Another solution would be the
+-- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
+-- either, and DEPRECATED is only expected to be used by people who really
+-- know what they are doing. :-)
+
module :: { RdrNameHsModule }
- : srcloc 'module' modid maybeexports 'where' body
- { HsModule $3 Nothing $4 (fst $6) (snd $6) $1 }
- | srcloc body
- { HsModule mAIN_Name Nothing Nothing (fst $2) (snd $2) $1 }
+ : srcloc 'module' modid maybemoddeprec maybeexports 'where' body
+ { HsModule $3 Nothing $5 (fst $7) (snd $7) $4 $1 }
+ | srcloc body
+ { HsModule mAIN_Name Nothing Nothing (fst $2) (snd $2) Nothing $1 }
+
+maybemoddeprec :: { Maybe FAST_STRING }
+ : '{-# DEPRECATED' STRING '#-}' { Just $2 }
+ | {- empty -} { Nothing }
body :: { ([RdrNameImportDecl], [RdrNameHsDecl]) }
: '{' top '}' { $2 }
| '{-# SPECIALISE' srcloc 'instance' inst_type '#-}'
{ RdrSig (SpecInstSig $4 $2) }
| '{-# RULES' rules '#-}' { $2 }
+ | '{-# DEPRECATED' deprecations '#-}' { $2 }
opt_phase :: { Maybe Int }
: INTEGER { Just (fromInteger $1) }
| '(' varid '::' ctype ')' { RuleBndrSig $2 $4 }
-----------------------------------------------------------------------------
+-- Deprecations
+
+deprecations :: { RdrBinding }
+ : deprecations ';' deprecation { $1 `RdrAndBindings` $3 }
+ | deprecations ';' { $1 }
+ | deprecation { $1 }
+ | {- empty -} { RdrNullBind }
+
+deprecation :: { RdrBinding }
+ : deprecated_names STRING
+ { foldr1 RdrAndBindings [ RdrSig (DeprecSig n $2) | n <- $1 ] }
+
+deprecated_names :: { [RdrName] }
+ : deprecated_names ',' deprecated_name { $3 : $1 }
+ | deprecated_name { [$1] }
+
+deprecated_name :: { RdrName }
+ : var { $1 }
+ | tycon { $1 }
+
+-----------------------------------------------------------------------------
-- Foreign import/export
callconv :: { Int }
, [ModuleName] -- Imported modules; for profiling
))
-renameModule us this_mod@(HsModule mod_name vers exports imports local_decls loc)
+renameModule us this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
= -- Initialise the renamer monad
initRn mod_name us (mkSearchPath opt_HiMap) loc
(rename this_mod) >>=
\begin{code}
-rename this_mod@(HsModule mod_name vers _ imports local_decls loc)
+rename this_mod@(HsModule mod_name vers _ imports local_decls _ loc)
= -- FIND THE GLOBAL NAME ENVIRONMENT
getGlobalNames this_mod `thenRn` \ maybe_stuff ->
renamed_module = HsModule mod_name vers
trashed_exports trashed_imports
rn_all_decls
+ Nothing
loc
in
rnDump rn_imp_decls rn_all_decls `thenRn` \ dump_action ->
))
-- Nothing => no need to recompile
-getGlobalNames (HsModule this_mod _ exports imports decls mod_loc)
+getGlobalNames (HsModule this_mod _ exports imports decls _ mod_loc)
= -- These two fix-loops are to get the right
-- provenance information into a Name
fixRn (\ ~(rec_gbl_env, rec_exported_avails, _) ->
-> TcM s TcResults -- output
tcModule rn_name_supply fixities
- (HsModule mod_name verion exports imports decls src_loc)
+ (HsModule mod_name verion exports imports decls _ src_loc)
= tcAddSrcLoc src_loc $ -- record where we're starting
fixTc (\ ~(unf_env ,_) ->
projects / ghc-hetmet.git / commitdiff