Commit b78eb7be authored by panne's avatar panne
Browse files

[project @ 2000-02-22 15:47:56 by panne]

Load deprecations from interface files into a deprecation environment
which maps Names to RenamedDeprecations. This map is not used yet, but
very soon it will...

This commit fixes a bug related to implicit parameters, too:
Previously, an interface file containing the name "with" could not be
read by the interface parser. This broke Malcolm's HaXml 0.9 (released
today). Remember Sven's glaexts-commandment (Jeffrey? :-) : Always
keep Lex.lhs's ghcExtensionKeywordsFM and ParseIface.y's var_fs
production in synch!
parent c01dc71d
......@@ -280,6 +280,7 @@ haskellKeywordsFM = listToUFM $
( "_scc_", ITscc )
]
-- IMPORTANT: Keep this in synch with ParseIface.y's var_fs production! (SUP)
ghcExtensionKeywordsFM = listToUFM $
map (\ (x,y) -> (_PK_ x,y))
[ ( "forall", ITforall ),
......
......@@ -36,6 +36,7 @@ module RdrHsSyn (
RdrNameTyClDecl,
RdrNameRuleDecl,
RdrNameRuleBndr,
RdrNameDeprecation,
RdrNameHsRecordBinds,
RdrBinding(..),
......@@ -111,6 +112,7 @@ type RdrNameStmt = Stmt RdrName RdrNamePat
type RdrNameTyClDecl = TyClDecl RdrName RdrNamePat
type RdrNameRuleBndr = RuleBndr RdrName
type RdrNameRuleDecl = RuleDecl RdrName RdrNamePat
type RdrNameDeprecation = Deprecation RdrName
type RdrNameHsRecordBinds = HsRecordBinds RdrName RdrNamePat
......
......@@ -79,6 +79,7 @@ import Ratio ( (%) )
'label' { ITlabel }
'dynamic' { ITdynamic }
'unsafe' { ITunsafe }
'with' { ITwith }
'__interface' { ITinterface } -- interface keywords
'__export' { IT__export }
......@@ -331,7 +332,7 @@ pragma : src_loc PRAGMA { parseIface $2 PState{ bol = 0#, atbol = 1#,
-----------------------------------------------------------------------------
rules_and_deprecs :: { ([RdrNameRuleDecl], [(Maybe FAST_STRING, FAST_STRING)]) }
rules_and_deprecs :: { ([RdrNameRuleDecl], [RdrNameDeprecation]) }
rules_and_deprecs : {- empty -} { ([], []) }
| rules_and_deprecs rule_or_deprec
{ let
......@@ -342,7 +343,7 @@ rules_and_deprecs : {- empty -} { ([], []) }
in append2 $1 $2
}
rule_or_deprec :: { ([RdrNameRuleDecl], [(Maybe FAST_STRING, FAST_STRING)]) }
rule_or_deprec :: { ([RdrNameRuleDecl], [RdrNameDeprecation]) }
rule_or_deprec : pragma { case $1 of
POk _ (PRules rules) -> (rules,[])
POk _ (PDeprecs deprecs) -> ([],deprecs)
......@@ -364,17 +365,17 @@ rule_forall : '__forall' '{' core_bndrs '}' { $3 }
-----------------------------------------------------------------------------
deprecs :: { [(Maybe FAST_STRING, FAST_STRING)] }
deprecs :: { [RdrNameDeprecation] }
deprecs : {- empty -} { [] }
| deprecs deprec ';' { $2 : $1 }
deprec :: { (Maybe FAST_STRING, FAST_STRING) }
deprec : STRING { (Nothing, $1) }
| deprec_name STRING { (Just $1, $2) }
deprec :: { RdrNameDeprecation }
deprec : STRING { DeprecMod $1 }
| deprec_name STRING { DeprecName $1 $2 }
deprec_name :: { FAST_STRING }
: var_fs { $1 }
| tc_fs { $1 }
deprec_name :: { RdrName }
: var_name { $1 }
| tc_name { $1 }
-----------------------------------------------------------------------------
......@@ -510,6 +511,7 @@ var_fs :: { EncodedFS }
| 'label' { SLIT("label") }
| 'dynamic' { SLIT("dynamic") }
| 'unsafe' { SLIT("unsafe") }
| 'with' { SLIT("with") }
qvar_fs :: { (EncodedFS, EncodedFS) }
: QVARID { $1 }
......@@ -853,7 +855,7 @@ data IfaceStuff = PIface EncodedFS{-.hi module name-} ParsedIface
| PIdInfo [HsIdInfo RdrName]
| PType RdrNameHsType
| PRules [RdrNameRuleDecl]
| PDeprecs [(Maybe FAST_STRING, FAST_STRING)]
| PDeprecs [RdrNameDeprecation]
mkConDecl name (ex_tvs, ex_ctxt) details loc = ConDecl name ex_tvs ex_ctxt details loc
}
......@@ -57,6 +57,7 @@ import Maybes ( mapMaybe )
%*********************************************************
\begin{code}
newImportedGlobalName :: ModuleName -> OccName -> Module -> RnM d Name
newImportedGlobalName mod_name occ mod
= getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) ->
let
......@@ -94,6 +95,7 @@ mkImportedGlobalName mod_name occ
= lookupModuleRn mod_name `thenRn` \ mod ->
newImportedGlobalName mod_name occ mod --(mkVanillaModule mod_name)
mkImportedGlobalFromRdrName :: RdrName -> RnM d Name
mkImportedGlobalFromRdrName rdr_name
| isQual rdr_name
= mkImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
......
......@@ -45,6 +45,7 @@ type RenamedRecordBinds = HsRecordBinds Name RenamedPat
type RenamedSig = Sig Name
type RenamedStmt = Stmt Name RenamedPat
type RenamedFixitySig = FixitySig Name
type RenamedDeprecation = Deprecation Name
type RenamedClassOpPragmas = ClassOpPragmas Name
type RenamedClassPragmas = ClassPragmas Name
......
......@@ -24,11 +24,11 @@ import HsSyn ( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..),
HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
ForeignDecl(..), ForKind(..), isDynamic,
FixitySig(..), RuleDecl(..),
isClassOpSig
isClassOpSig, Deprecation(..)
)
import BasicTypes ( Version, NewOrData(..), defaultFixity )
import RdrHsSyn ( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyClDecl, RdrNameRuleDecl,
extractHsTyRdrNames
extractHsTyRdrNames, RdrNameDeprecation
)
import RnEnv ( mkImportedGlobalName, newImportedBinder, mkImportedGlobalFromRdrName,
lookupOccRn, lookupImplicitOccRn,
......@@ -37,7 +37,7 @@ import RnEnv ( mkImportedGlobalName, newImportedBinder, mkImportedGlobalFromRdr
FreeVars, emptyFVs
)
import RnMonad
import RnHsSyn ( RenamedHsDecl )
import RnHsSyn ( RenamedHsDecl, RenamedDeprecation )
import ParseIface ( parseIface, IfaceStuff(..) )
import FiniteMap ( FiniteMap, sizeFM, emptyFM, delFromFM, listToFM,
......@@ -148,13 +148,16 @@ loadInterface doc_str mod_name from
let
rd_decls = pi_decls iface
in
foldlRn (loadDecl mod) (iDecls ifaces) rd_decls `thenRn` \ new_decls ->
foldlRn (loadInstDecl mod) (iInsts ifaces) (pi_insts iface) `thenRn` \ new_insts ->
(if (opt_IgnoreIfacePragmas)
foldlRn (loadDecl mod) (iDecls ifaces) rd_decls `thenRn` \ new_decls ->
foldlRn (loadInstDecl mod) (iInsts ifaces) (pi_insts iface) `thenRn` \ new_insts ->
(if opt_IgnoreIfacePragmas
then returnRn emptyBag
else foldlRn (loadRule mod) (iRules ifaces) (pi_rules iface)) `thenRn` \ new_rules ->
foldlRn (loadFixDecl mod_name) (iFixes ifaces) rd_decls `thenRn` \ new_fixities ->
mapRn (loadExport this_mod_nm) (pi_exports iface) `thenRn` \ avails_s ->
else foldlRn (loadRule mod) (iRules ifaces) (pi_rules iface)) `thenRn` \ new_rules ->
(if opt_IgnoreIfacePragmas
then returnRn emptyNameEnv
else foldlRn (loadDeprec mod) (iDeprecs ifaces) (pi_deprecs iface)) `thenRn` \ new_deprecs ->
foldlRn (loadFixDecl mod_name) (iFixes ifaces) rd_decls `thenRn` \ new_fixities ->
mapRn (loadExport this_mod_nm) (pi_exports iface) `thenRn` \ avails_s ->
let
-- For an explicit user import, add to mod_map info about
-- the things the imported module depends on, extracted
......@@ -170,8 +173,9 @@ loadInterface doc_str mod_name from
new_ifaces = ifaces { iImpModInfo = mod_map2,
iDecls = new_decls,
iFixes = new_fixities,
iInsts = new_insts,
iRules = new_rules,
iInsts = new_insts }
iDeprecs = new_deprecs }
in
setIfacesRn new_ifaces `thenRn_`
returnRn (mod, new_ifaces)
......@@ -336,6 +340,16 @@ loadRule mod rules decl@(IfaceRuleDecl var body src_loc)
= setModuleRn (moduleName mod) $
mkImportedGlobalFromRdrName var `thenRn` \ var_name ->
returnRn ((unitNameSet var_name, (mod, RuleD decl)) `consBag` rules)
loadDeprec :: Module -> DeprecationEnv -> RdrNameDeprecation -> RnM d DeprecationEnv
loadDeprec mod deprec_env (DeprecMod txt)
= traceRn (text "module deprecation not yet implemented:" <+> ppr mod <> colon <+> ppr txt) `thenRn_`
returnRn deprec_env
loadDeprec mod deprec_env (DeprecName rdr_name 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 (DeprecName name txt))
\end{code}
......
......@@ -31,7 +31,7 @@ import IOExts ( IORef, newIORef, readIORef, writeIORef, unsafePerformIO )
import HsSyn
import RdrHsSyn
import RnHsSyn ( RenamedFixitySig )
import RnHsSyn ( RenamedFixitySig, RenamedDeprecation )
import BasicTypes ( Version )
import SrcLoc ( noSrcLoc )
import ErrUtils ( addShortErrLocLine, addShortWarnLocLine,
......@@ -193,6 +193,9 @@ type FixityEnv = NameEnv RenamedFixitySig
-- We keep the whole fixity sig so that we
-- can report line-number info when there is a duplicate
-- fixity declaration
--------------------------------
type DeprecationEnv = NameEnv RenamedDeprecation
\end{code}
\begin{code}
......@@ -284,7 +287,7 @@ data ParsedIface
pi_decls :: [(Version, RdrNameHsDecl)], -- Local definitions
pi_insts :: [RdrNameInstDecl], -- Local instance declarations
pi_rules :: [RdrNameRuleDecl], -- Rules
pi_deprecs :: [(Maybe FAST_STRING, FAST_STRING)] -- Deprecations, the type is currently only a hack
pi_deprecs :: [RdrNameDeprecation] -- Deprecations
}
data InterfaceDetails
......@@ -330,8 +333,10 @@ data Ifaces = Ifaces {
-- Each is 'gated' by the names that must be available before
-- this instance decl is needed.
iRules :: Bag GatedDecl
iRules :: Bag GatedDecl,
-- Ditto transformation rules
iDeprecs :: DeprecationEnv
}
type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
......@@ -419,7 +424,8 @@ emptyIfaces = Ifaces { iImpModInfo = emptyFM,
-- and we don't want thereby to try to suck it in!
iVSlurp = [],
iInsts = emptyBag,
iRules = emptyBag
iRules = emptyBag,
iDeprecs = emptyNameEnv
}
-- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
......
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