[project @ 2002-03-14 15:47:52 by simonmar]

[ghc-hetmet.git] / ghc / compiler / rename / RnEnv.lhs

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 331b0d0..4ff1427 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -10,6 +10,7 @@ module RnEnv where            -- Export everything
 
 import {-# SOURCE #-} RnHiFiles
 
+import FlattenInfo      ( namesNeededForFlattening )
 import HsSyn
 import RdrHsSyn                ( RdrNameIE, RdrNameHsType, extractHsTyRdrTyVars )
 import RdrName         ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
@@ -28,7 +29,7 @@ import HscTypes               ( Provenance(..), pprNameProvenance, hasBetterProv,
 import RnMonad
 import Name            ( Name, 
                          getSrcLoc, nameIsLocalOrFrom,
-                         mkLocalName, mkGlobalName,
+                         mkInternalName, mkExternalName,
                          mkIPName, nameOccName, nameModule_maybe,
                          setNameModuleAndLoc
                        )
@@ -117,7 +118,7 @@ newTopBinder mod rdr_name loc
        Nothing -> let
                        (us', us1) = splitUniqSupply (nsUniqs name_supply)
                        uniq       = uniqFromSupply us1
-                       new_name   = mkGlobalName uniq mod occ loc
+                       new_name   = mkExternalName uniq mod occ loc
                        new_cache  = addToFM cache key new_name
                   in
                   setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache})   `thenRn_`
@@ -160,7 +161,7 @@ newGlobalName mod_name occ
                     (us', us1) = splitUniqSupply (nsUniqs name_supply)
                     uniq       = uniqFromSupply us1
                     mod        = mkVanillaModule mod_name
-                    name       = mkGlobalName uniq mod occ noSrcLoc
+                    name       = mkExternalName uniq mod occ noSrcLoc
                     new_cache  = addToFM cache key name
 
 newIPName rdr_name_ip
@@ -346,7 +347,9 @@ lookupSrcName global_env rdr_name
 
 lookupOrigName :: RdrName -> RnM d Name 
 lookupOrigName rdr_name
-  = ASSERT( isOrig rdr_name )
+  = -- NO: ASSERT( isOrig rdr_name )
+    -- Now that .hi-boot files are read by the main parser, they contain
+    -- ordinary qualified names (which we treat as Orig names here).
     newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
 
 lookupIfaceUnqual :: RdrName -> RnM d Name
@@ -439,6 +442,9 @@ ubiquitousNames
        -- Add occurrences for very frequently used types.
        --       (e.g. we don't want to be bothered with making funTyCon a
        --        free var at every function application!)
+  `plusFV`
+    namesNeededForFlattening
+        -- this will be empty unless flattening is activated
 
 checkMain ghci_mode mod_name gbl_env
        -- LOOKUP main IF WE'RE IN MODULE Main
@@ -447,7 +453,8 @@ checkMain ghci_mode mod_name gbl_env
        -- so that the type checker will find them
        --
        -- We have to return the main_name separately, because it's a
-       -- bona fide 'use', and should be recorded as such, but the others aren't
+       -- bona fide 'use', and should be recorded as such, but the others
+       -- aren't 
   | mod_name /= mAIN_Name
   = returnRn (Nothing, emptyFVs, emptyFVs)
 
@@ -523,7 +530,7 @@ newLocalsRn rdr_names_w_loc
     let
        (us', us1) = splitUniqSupply (nsUniqs name_supply)
        uniqs      = uniqsFromSupply us1
-       names      = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
+       names      = [ mkInternalName uniq (rdrNameOcc rdr_name) loc
                     | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
                     ]
     in
@@ -579,7 +586,7 @@ bindCoreLocalRn rdr_name enclosed_scope
     let
        (us', us1) = splitUniqSupply (nsUniqs name_supply)
        uniq       = uniqFromSupply us1
-       name       = mkLocalName uniq (rdrNameOcc rdr_name) loc
+       name       = mkInternalName uniq (rdrNameOcc rdr_name) loc
     in
     setNameSupplyRn (name_supply {nsUniqs = us'})      `thenRn_`
     let