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

Wibble to subordinate names

diff --git a/ghc/compiler/iface/IfaceEnv.lhs b/ghc/compiler/iface/IfaceEnv.lhs
index 60c2ecb..d0c5d8f 100644 (file)
--- a/ghc/compiler/iface/IfaceEnv.lhs
+++ b/ghc/compiler/iface/IfaceEnv.lhs
@@ -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 

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index f394f43..eb87208 100644 (file)
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -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")