AvailInfo, GenAvailInfo(..), Avails, Deprecations(..)
)
import HsSyn ( TyClDecl(..), InstDecl(..),
- HsType(..), ConDecl(..),
- FixitySig(..), RuleDecl(..),
- tyClDeclNames
+ HsType(..), FixitySig(..), RuleDecl(..),
+ tyClDeclNames, tyClDeclSysNames
)
import RdrHsSyn ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl,
extractHsTyRdrNames
)
import Name ( mkNameEnv, extendNameEnv )
import Module ( Module,
- moduleName, isModuleInThisPackage,
+ moduleName, isHomeModule,
ModuleName, WhereFrom(..),
extendModuleEnv, mkVanillaModule
)
tryLoadInterface doc_str mod_name from
= getHomeIfaceTableRn `thenRn` \ hit ->
getIfacesRn `thenRn` \ ifaces@(Ifaces { iPIT = pit }) ->
-
+
-- CHECK WHETHER WE HAVE IT ALREADY
case lookupIfaceByModName hit pit mod_name of {
Just iface | case from of
-- about, it should be from a different package to this one
WARN( not (maybeToBool mod_info) &&
case from of { ImportBySystem -> True; other -> False } &&
- isModuleInThisPackage mod,
+ isHomeModule mod,
ppr mod )
loadDecls mod (iDecls ifaces) (pi_decls iface) `thenRn` \ (decls_vers, new_decls) ->
mi_fixities = fix_env, mi_deprecs = deprec_env,
mi_usages = [], -- Will be filled in later
mi_decls = panic "No mi_decls in PIT",
- mi_globals = panic "No mi_globals in PIT"
+ mi_globals = mkIfaceGlobalRdrEnv avails
}
new_ifaces = ifaces { iPIT = new_pit,
-- and in that case, forget about the boot indicator
filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface))]
filtered_new_deps
- | isModuleInThisPackage mod
+ | isHomeModule mod
= [ (imp_mod, (has_orphans, is_boot))
| (imp_mod, has_orphans, is_boot, _) <- new_deps,
not (is_loaded imp_mod)
returnRn (vers, (decls_map', n_slurped))
loadDecl mod (version_map, decls_map) (version, decl)
- = getIfaceDeclBinders mod decl `thenRn` \ full_avail ->
+ = getTyClDeclBinders mod decl `thenRn` \ (avail, sys_names) ->
let
+ full_avail = case avail of
+ Avail n -> avail
+ AvailTC n ns -> AvailTC n (sys_names ++ ns)
main_name = availName full_avail
new_decls_map = extendNameEnvList decls_map stuff
stuff = [ (name, (full_avail, name==main_name, (mod, decl)))
are handled by the sourc-code specific stuff in @RnNames@.
\begin{code}
-getIfaceDeclBinders, getTyClDeclBinders
+getTyClDeclBinders
:: Module
-> RdrNameTyClDecl
- -> RnM d AvailInfo
-
-getIfaceDeclBinders mod tycl_decl
- = getTyClDeclBinders mod tycl_decl `thenRn` \ avail ->
- getSysTyClDeclBinders mod tycl_decl `thenRn` \ extras ->
- returnRn (addSysAvails avail extras)
- -- Add the sys-binders to avail. When we import the decl,
- -- it's full_avail that will get added to the 'already-slurped' set (iSlurp)
- -- If we miss out sys-binders, we'll read the decl multiple times!
+ -> RnM d (AvailInfo, [Name]) -- The [Name] are the system names
-getTyClDeclBinders mod (IfaceSig var ty prags src_loc)
+-----------------
+getTyClDeclBinders mod (IfaceSig {tcdName = var, tcdLoc = src_loc})
= newTopBinder mod var src_loc `thenRn` \ var_name ->
- returnRn (Avail var_name)
+ returnRn (Avail var_name, [])
getTyClDeclBinders mod tycl_decl
- = mapRn do_one (tyClDeclNames tycl_decl) `thenRn` \ (main_name:sub_names) ->
- returnRn (AvailTC main_name (main_name : sub_names))
- where
- do_one (name,loc) = newTopBinder mod name loc
-\end{code}
-
-@getDeclSysBinders@ gets the implicit binders introduced by a decl.
-A the moment that's just the tycon and datacon that come with a class decl.
-They aren't returned by @getDeclBinders@ because they aren't in scope;
-but they {\em should} be put into the @DeclsMap@ of this module.
+ = new_top_bndrs mod (tyClDeclNames tycl_decl) `thenRn` \ names@(main_name:_) ->
+ new_top_bndrs mod (tyClDeclSysNames tycl_decl) `thenRn` \ sys_names ->
+ returnRn (AvailTC main_name names, sys_names)
-Note that this excludes the default-method names of a class decl,
-and the dict fun of an instance decl, because both of these have
-bindings of their own elsewhere.
-
-\begin{code}
-getSysTyClDeclBinders mod (ClassDecl _ cname _ _ sigs _ names src_loc)
- = sequenceRn [newTopBinder mod n src_loc | n <- names]
-
-getSysTyClDeclBinders mod (TyData _ _ _ _ cons _ _ _ _ _)
- = sequenceRn [newTopBinder mod wkr_name src_loc | ConDecl _ wkr_name _ _ _ src_loc <- cons]
-
-getSysTyClDeclBinders mod other_decl
- = returnRn []
+-----------------
+new_top_bndrs mod names_w_locs
+ = sequenceRn [newTopBinder mod name loc | (name,loc) <- names_w_locs]
\end{code}
+
%*********************************************************
%* *
\subsection{Reading an interface file}
-- Nothing <=> file not found, or unreadable, or illegible
-- Just x <=> successfully found and parsed
readIface file_path
- = traceRn (ptext SLIT("readIFace") <+> text file_path) `thenRn_`
+ = --ioToRnM (putStrLn ("reading iface " ++ file_path)) `thenRn_`
+ traceRn (ptext SLIT("readIFace") <+> text file_path) `thenRn_`
ioToRnM (hGetStringBuffer False file_path) `thenRn` \ read_result ->
case read_result of {
projects / ghc-hetmet.git / blobdiff