Commit a195d525 authored by simonpj's avatar simonpj
Browse files

[project @ 2003-11-03 15:27:08 by simonpj]

Wibble to subordinate names
parent 37863eec
......@@ -4,7 +4,7 @@
module IfaceEnv (
newGlobalBinder, newIPName, newImplicitBinder,
lookupIfaceTop, lookupIfaceExt,
lookupOrig, lookupImplicitOrig, lookupIfaceTc,
lookupOrig, lookupIfaceTc,
newIfaceName, newIfaceNames,
extendIfaceIdEnv, extendIfaceTyVarEnv,
tcIfaceGlobal, tcIfaceTyCon, tcIfaceClass, tcIfaceExtId,
......@@ -145,24 +145,10 @@ lookupOrig :: ModuleName -> OccName -> TcRnIf a b Name
-- We fake up
-- Module to AnotherPackage
-- SrcLoc to noSrcLoc
-- Parent no Nothing
-- They'll be overwritten, in due course, by LoadIface.loadDecl.
lookupOrig mod_name occ = lookupOrig_help mod_name occ Nothing
lookupImplicitOrig :: Name -> OccName -> TcRnIf m n Name
-- Same as lookupOrig, but install (Just parent) as the
-- parent Name. This is used when looking at the exports
-- of an interface:
-- Suppose module M exports type A.T, and constructor A.MkT
-- Then, we know that A.MkT is an implicit name of A.T,
-- even though we aren't at the binding site of A.T
-- And it's important, because we may simply re-export A.T
-- without ever sucking in the declaration itself.
lookupImplicitOrig name occ
= lookupOrig_help (nameModuleName name) occ (Just name)
lookupOrig_help :: ModuleName -> OccName -> Maybe Name -> TcRnIf a b Name
-- Local helper, not exported
lookupOrig_help mod_name occ mb_parent
lookupOrig mod_name occ
= do { -- First ensure that mod_name and occ are evaluated
-- If not, chaos can ensue:
-- we read the name-cache
......@@ -178,7 +164,7 @@ lookupOrig_help mod_name occ mb_parent
{ let { (us', us1) = splitUniqSupply (nsUniqs name_supply)
; uniq = uniqFromSupply us1
; name = mkExternalName uniq tmp_mod occ mb_parent noSrcLoc
; name = mkExternalName uniq tmp_mod occ Nothing noSrcLoc
; new_cache = extend_name_cache (nsNames name_supply) tmp_mod occ name
; new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
; tmp_mod = mkPackageModule mod_name
......
......@@ -18,13 +18,13 @@ import HsSyn ( IE(..), ieName, ImportDecl(..),
)
import RdrHsSyn ( RdrNameIE, RdrNameImportDecl, main_RDR_Unqual )
import RnEnv
import IfaceEnv ( lookupOrig, lookupImplicitOrig )
import IfaceEnv ( lookupOrig, newGlobalBinder )
import LoadIface ( loadSrcInterface )
import TcRnMonad
import FiniteMap
import PrelNames ( pRELUDE_Name, isBuiltInSyntaxName, isUnboundName )
import Module ( Module, ModuleName, moduleName,
import Module ( Module, ModuleName, moduleName, mkPackageModule,
moduleNameUserString, isHomeModule,
unitModuleEnvByName, unitModuleEnv,
lookupModuleEnvByName, moduleEnvElts )
......@@ -46,6 +46,7 @@ import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace,
isLocalGRE, pprNameProvenance )
import Outputable
import Maybes ( isJust, isNothing, catMaybes, mapCatMaybes )
import SrcLoc ( noSrcLoc )
import ListSetOps ( removeDups )
import Util ( sortLt, notNull )
import List ( partition, insert )
......@@ -245,15 +246,24 @@ exportsToAvails exports
; return (concat avails_by_module) }
where
do_one (mod_name, exports) = mapM (do_avail mod_name) exports
do_avail mod (Avail n) = do { n' <- lookupOrig mod n;
; return (Avail n') }
do_avail mod (AvailTC n ns) = do { n' <- lookupOrig mod n
; ns' <- mappM (lookupImplicitOrig n') ns
; return (AvailTC n' ns') }
-- Note the lookupImplicitOrig. It ensures that the subordinate names
-- record their parent; and that in turn ensures that the GlobalRdrEnv
-- has the correct parent for all the names in its range.
-- For imported things, we only suck in the binding site later, if ever.
do_avail mod_nm (Avail n) = do { n' <- lookupOrig mod_nm n;
; return (Avail n') }
do_avail mod_nm (AvailTC n ns) = do { n' <- lookupOrig mod_nm n
; ns' <- mappM (lookup_sub n') ns
; return (AvailTC n' ns') }
where
mod = mkPackageModule mod_nm -- Not necessarily right yet
lookup_sub parent occ = newGlobalBinder mod occ (Just parent) noSrcLoc
-- Hack alert! Notice the newGlobalBinder. It ensures that the subordinate
-- names record their parent; and that in turn ensures that the GlobalRdrEnv
-- has the correct parent for all the names in its range.
-- For imported things, we only suck in the binding site later, if ever.
-- Reason for all this:
-- Suppose module M exports type A.T, and constructor A.MkT
-- Then, we know that A.MkT is a subordinate name of A.T,
-- even though we aren't at the binding site of A.T
-- And it's important, because we may simply re-export A.T
-- without ever sucking in the declaration itself.
warnRedundantSourceImport mod_name
= ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
......
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