Commit 06619533 authored by panne's avatar panne
Browse files

[project @ 2000-02-15 22:18:16 by panne]

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...
parent 2c64208b
......@@ -257,8 +257,13 @@ data Sig name
| 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}
......@@ -273,6 +278,7 @@ sigsForMe f sigs
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
......@@ -288,6 +294,7 @@ isPragSig (SpecSig _ _ _) = True
isPragSig (InlineSig _ _ _) = True
isPragSig (NoInlineSig _ _ _) = True
isPragSig (SpecInstSig _ _) = True
isPragSig (DeprecSig _ _) = True
isPragSig other = False
\end{code}
......@@ -311,16 +318,19 @@ ppr_sig (SpecSig var ty _)
]
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}
......
......@@ -62,6 +62,7 @@ data HsModule name pat
-- 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}
......@@ -70,8 +71,11 @@ instance (Outputable name, Outputable pat)
=> 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 [
......
......@@ -74,7 +74,7 @@ parseModule = do
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#
......@@ -222,7 +222,7 @@ doIt (core_cmds, stg_cmds)
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
......
......@@ -158,6 +158,7 @@ data Token
| ITunfold InlinePragInfo
| ITstrict ([Demand], Bool)
| ITrules
| ITdeprecated
| ITcprinfo (CprInfo)
| IT__scc
| ITsccAllCafs
......@@ -167,6 +168,7 @@ data Token
| ITinline_prag
| ITnoinline_prag
| ITrules_prag
| ITdeprecated_prag
| ITline_prag
| ITclose_prag
......@@ -244,7 +246,8 @@ pragmaKeywordsFM = listToUFM $
( "NOTINLINE", ITnoinline_prag ),
( "LINE", ITline_prag ),
( "RULES", ITrules_prag ),
( "RULEZ", ITrules_prag ) -- american spelling :-)
( "RULEZ", ITrules_prag ), -- american spelling :-)
( "DEPRECATED", ITdeprecated_prag )
]
haskellKeywordsFM = listToUFM $
......@@ -318,6 +321,7 @@ ghcExtensionKeywordsFM = 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.
......@@ -36,6 +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 :-)
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)
......@@ -107,6 +108,7 @@ Conflicts: 14 shift/reduce
'{-# INLINE' { ITinline_prag }
'{-# NOINLINE' { ITnoinline_prag }
'{-# RULES' { ITrules_prag }
'{-# DEPRECATED' { ITdeprecated_prag }
'#-}' { ITclose_prag }
{-
......@@ -189,7 +191,7 @@ Conflicts: 14 shift/reduce
PRIMSTRING { ITprimstring $$ }
PRIMINTEGER { ITprimint $$ }
PRIMFLOAT { ITprimfloat $$ }
PRIMDOUBLE { ITprimdouble $$ }
PRIMDOUBLE { ITprimdouble $$ }
CLITLIT { ITlitlit $$ }
UNKNOWN { ITunknown $$ }
......@@ -203,11 +205,22 @@ Conflicts: 14 shift/reduce
-----------------------------------------------------------------------------
-- 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 }
......@@ -379,6 +392,7 @@ decl :: { RdrBinding }
| '{-# SPECIALISE' srcloc 'instance' inst_type '#-}'
{ RdrSig (SpecInstSig $4 $2) }
| '{-# RULES' rules '#-}' { $2 }
| '{-# DEPRECATED' deprecations '#-}' { $2 }
opt_phase :: { Maybe Int }
: INTEGER { Just (fromInteger $1) }
......@@ -457,6 +471,27 @@ rule_var :: { RdrNameRuleBndr }
: varid { RuleBndr $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
......
......@@ -69,7 +69,7 @@ renameModule :: UniqSupply
, [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) >>=
......@@ -90,7 +90,7 @@ renameModule us this_mod@(HsModule mod_name vers exports imports local_decls loc
\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 ->
......@@ -146,6 +146,7 @@ rename this_mod@(HsModule mod_name vers _ imports local_decls loc)
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 ->
......
......@@ -69,7 +69,7 @@ getGlobalNames :: RdrNameHsModule
))
-- 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, _) ->
......
......@@ -131,7 +131,7 @@ tcModule :: RnNameSupply -- for renaming derivings
-> 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 ,_) ->
......
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