X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnEnv.lhs;h=b835791154ad56460a951d7aa2f73ead69b4f990;hb=0ef29fb878dd6517d2716afb056bcf2536c2562e;hp=40dc61ac6ad81a7199952f2bcdddbebf60479202;hpb=83eef621e4a4fbb6c1343304ec638cafd6c9dc09;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 40dc61a..b835791 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -16,9 +16,9 @@ import RdrName		( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
 import HsTypes		( hsTyVarName, replaceTyVarName )
 import HscTypes		( Provenance(..), pprNameProvenance, hasBetterProv,
 			  ImportReason(..), GlobalRdrEnv, AvailEnv,
-			  AvailInfo, Avails, GenAvailInfo(..) )
+			  AvailInfo, Avails, GenAvailInfo(..), NameSupply(..) )
 import RnMonad
-import Name		( Name, NamedThing(..),
+import Name		( Name,
 			  getSrcLoc, 
 			  mkLocalName, mkGlobalName,
 			  mkIPName, nameOccName, nameModule_maybe,
@@ -67,10 +67,11 @@ newTopBinder mod rdr_name loc
 	returnRn ()
     )				`thenRn_`
 
-    getNameSupplyRn		`thenRn` \ (us, cache, ipcache) ->
+    getNameSupplyRn		`thenRn` \ name_supply -> 
     let 
 	occ = rdrNameOcc rdr_name
 	key = (moduleName mod, occ)
+	cache = nsNames name_supply
     in
     case lookupFM cache key of
 
@@ -85,7 +86,7 @@ newTopBinder mod rdr_name loc
 			new_name  = setNameModuleAndLoc name mod loc
 			new_cache = addToFM cache key new_name
 		     in
-		     setNameSupplyRn (us, new_cache, ipcache)	`thenRn_`
+		     setNameSupplyRn (name_supply {nsNames = new_cache})	`thenRn_`
 		     traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
 		     returnRn new_name
 		     
@@ -94,12 +95,12 @@ newTopBinder mod rdr_name loc
 	-- Even for locally-defined names we use implicitImportProvenance; 
 	-- updateProvenances will set it to rights
 	Nothing -> let
-			(us', us1) = splitUniqSupply us
+			(us', us1) = splitUniqSupply (nsUniqs name_supply)
 			uniq   	   = uniqFromSupply us1
 			new_name   = mkGlobalName uniq mod occ loc
 			new_cache  = addToFM cache key new_name
 		   in
-		   setNameSupplyRn (us', new_cache, ipcache)	`thenRn_`
+		   setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache})	`thenRn_`
 		   traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
 		   returnRn new_name
 
@@ -123,32 +124,36 @@ newGlobalName :: ModuleName -> OccName -> RnM d Name
   -- (but since it affects DLL-ery it does matter that we get it right
   --  in the end).
 newGlobalName mod_name occ
-  = getNameSupplyRn		`thenRn` \ (us, cache, ipcache) ->
+  = getNameSupplyRn		`thenRn` \ name_supply ->
     let
 	key = (mod_name, occ)
+	cache = nsNames name_supply
     in
     case lookupFM cache key of
 	Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
 		     returnRn name
 
-	Nothing   -> setNameSupplyRn (us', new_cache, ipcache)			`thenRn_`
-		     -- traceRn (text "newGlobalName: new" <+> ppr name)	`thenRn_`
+	Nothing   -> setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache})  `thenRn_`
+		     -- traceRn (text "newGlobalName: new" <+> ppr name)		  `thenRn_`
 		     returnRn name
 		  where
-		     (us', us1) = splitUniqSupply us
+		     (us', us1) = splitUniqSupply (nsUniqs name_supply)
 		     uniq   	= uniqFromSupply us1
 		     mod        = mkVanillaModule mod_name
 		     name       = mkGlobalName uniq mod occ noSrcLoc
 		     new_cache  = addToFM cache key name
 
 newIPName rdr_name
-  = getNameSupplyRn		`thenRn` \ (us, cache, ipcache) ->
+  = getNameSupplyRn		`thenRn` \ name_supply ->
+    let
+	ipcache = nsIPs name_supply
+    in
     case lookupFM ipcache key of
 	Just name -> returnRn name
-	Nothing   -> setNameSupplyRn (us', cache, new_ipcache)	`thenRn_`
+	Nothing   -> setNameSupplyRn (name_supply {nsUniqs = us', nsIPs = new_ipcache})	`thenRn_`
 		     returnRn name
 		  where
-		     (us', us1)  = splitUniqSupply us
+		     (us', us1)  = splitUniqSupply (nsUniqs name_supply)
 		     uniq   	 = uniqFromSupply us1
 		     name        = mkIPName uniq key
 		     new_ipcache = addToFM ipcache key name
@@ -172,13 +177,12 @@ lookupBndrRn rdr_name
 
 lookupTopBndrRn rdr_name
   = getModeRn	`thenRn` \ mode ->
-    case mode of 
-	InterfaceMode -> lookupIfaceName rdr_name	
-
-	SourceMode    -> -- Source mode, so look up a *qualified* version
-			 -- of the name, so that we get the right one even
-			 -- if there are many with the same occ name
-			 -- There must *be* a binding
+    if isInterfaceMode mode
+	then lookupIfaceName rdr_name	
+	else     -- Source mode, so look up a *qualified* version
+	         -- of the name, so that we get the right one even
+		 -- if there are many with the same occ name
+		 -- There must *be* a binding
 		getModuleRn		`thenRn` \ mod ->
 		getGlobalNameEnv	`thenRn` \ global_env ->
     		lookupSrcName global_env (qualifyRdrName (moduleName mod) rdr_name)
@@ -211,11 +215,32 @@ lookupOccRn rdr_name
 
 lookupGlobalOccRn rdr_name
   = getModeRn 		`thenRn` \ mode ->
+    if (isInterfaceMode mode)
+	then lookupIfaceName rdr_name
+	else 
+
+    getGlobalNameEnv	`thenRn` \ global_env ->
     case mode of 
-	SourceMode    -> getGlobalNameEnv			`thenRn` \ global_env ->
-    			 lookupSrcName global_env rdr_name
+	SourceMode -> lookupSrcName global_env rdr_name
+
+	CmdLineMode
+	 | not (isQual rdr_name) -> 
+		lookupSrcName global_env rdr_name
+
+		-- We allow qualified names on the command line to refer to 
+		-- *any* name exported by any module in scope, just as if 
+		-- there was an "import qualified M" declaration for every 
+		-- module.
+		--
+		-- First look up the name in the normal environment.  If
+		-- it isn't there, we manufacture a new occurrence of an
+		-- original name.
+	 | otherwise -> 
+		case lookupRdrEnv global_env rdr_name of
+		       Just _  -> lookupSrcName global_env rdr_name
+		       Nothing -> newGlobalName (rdrNameModule rdr_name)
+						(rdrNameOcc rdr_name)
 
-	InterfaceMode -> lookupIfaceName rdr_name
 
 lookupSrcName :: GlobalRdrEnv -> RdrName -> RnM d Name
 -- NB: passed GlobalEnv explicitly, not necessarily in RnMS monad
@@ -265,7 +290,6 @@ calls it at all I think).
 
   \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
 
-
 \begin{code}
 lookupOrigNames :: [RdrName] -> RnM d NameSet
 lookupOrigNames rdr_names
@@ -273,10 +297,10 @@ lookupOrigNames rdr_names
     returnRn (mkNameSet names)
 \end{code}
 
-lookupSysBinder is used for the "system binders" of a type, class, or instance decl.
-It ensures that the module is set correctly in the name cache, and sets the provenance
-on the returned name too.  The returned name will end up actually in the type, class,
-or instance.
+lookupSysBinder is used for the "system binders" of a type, class, or
+instance decl.  It ensures that the module is set correctly in the
+name cache, and sets the provenance on the returned name too.  The
+returned name will end up actually in the type, class, or instance.
 
 \begin{code}
 lookupSysBinder rdr_name
@@ -287,7 +311,6 @@ lookupSysBinder rdr_name
 \end{code}
 
 
-
 %*********************************************************
 %*							*
 \subsection{Binding}
@@ -298,16 +321,16 @@ lookupSysBinder rdr_name
 newLocalsRn :: [(RdrName,SrcLoc)]
 	    -> RnMS [Name]
 newLocalsRn rdr_names_w_loc
- =  getNameSupplyRn		`thenRn` \ (us, cache, ipcache) ->
+ =  getNameSupplyRn		`thenRn` \ name_supply ->
     let
 	n	   = length rdr_names_w_loc
-	(us', us1) = splitUniqSupply us
+	(us', us1) = splitUniqSupply (nsUniqs name_supply)
 	uniqs	   = uniqsFromSupply n us1
 	names	   = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
 		     | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
 		     ]
     in
-    setNameSupplyRn (us', cache, ipcache)	`thenRn_`
+    setNameSupplyRn (name_supply {nsUniqs = us'})	`thenRn_`
     returnRn names
 
 
@@ -353,13 +376,13 @@ bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
 bindCoreLocalRn rdr_name enclosed_scope
   = getSrcLocRn 		`thenRn` \ loc ->
     getLocalNameEnv		`thenRn` \ name_env ->
-    getNameSupplyRn		`thenRn` \ (us, cache, ipcache) ->
+    getNameSupplyRn		`thenRn` \ name_supply ->
     let
-	(us', us1) = splitUniqSupply us
+	(us', us1) = splitUniqSupply (nsUniqs name_supply)
 	uniq	   = uniqFromSupply us1
 	name	   = mkLocalName uniq (rdrNameOcc rdr_name) loc
     in
-    setNameSupplyRn (us', cache, ipcache)	`thenRn_`
+    setNameSupplyRn (name_supply {nsUniqs = us'})	`thenRn_`
     let
 	new_name_env = extendRdrEnv name_env rdr_name name
     in
@@ -405,7 +428,7 @@ bindLocalsFVRn doc rdr_names enclosed_scope
 
 -------------------------------------
 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
-	-- This tiresome function is used only in rnDecl on InstDecl
+	-- This tiresome function is used only in rnSourceDecl on InstDecl
 extendTyVarEnvFVRn tyvars enclosed_scope
   = bindLocalNames tyvars enclosed_scope 	`thenRn` \ (thing, fvs) -> 
     returnRn (thing, delListFromNameSet fvs tyvars)
@@ -488,13 +511,14 @@ checkDupNames doc_str rdr_names_w_loc
 \begin{code}
 mkGlobalRdrEnv :: ModuleName		-- Imported module (after doing the "as M" name change)
 	       -> Bool			-- True <=> want unqualified import
+	       -> Bool			-- True <=> want qualified import
 	       -> [AvailInfo]		-- What's to be hidden (but only the unqualified 
 	 				-- 	version is hidden)
 	       -> (Name -> Provenance)
 	       -> Avails		-- Whats imported and how
 	       -> GlobalRdrEnv
 
-mkGlobalRdrEnv this_mod unqual_imp hides mk_provenance avails
+mkGlobalRdrEnv this_mod unqual_imp qual_imp hides mk_provenance avails
   = gbl_env2
   where
  	-- Make the name environment.  We're talking about a 
@@ -512,11 +536,14 @@ mkGlobalRdrEnv this_mod unqual_imp hides mk_provenance avails
     add_avail env avail = foldl add_name env (availNames avail)
 
     add_name env name
-	| unqual_imp = env2
-	| otherwise  = env1
+	| qual_imp && unqual_imp = env3
+	| unqual_imp             = env2
+	| qual_imp               = env1
+	| otherwise	         = env
 	where
 	  env1 = addOneToGlobalRdrEnv env  (mkRdrQual this_mod occ) (name,prov)
-	  env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) 	    (name,prov)
+	  env2 = addOneToGlobalRdrEnv env  (mkRdrUnqual occ) 	    (name,prov)
+	  env3 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) 	    (name,prov)
 	  occ  = nameOccName name
 	  prov = mk_provenance name
 
@@ -532,7 +559,7 @@ mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv
 mkIfaceGlobalRdrEnv m_avails
   = foldl add emptyRdrEnv m_avails
   where
-    add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True [] (\n -> LocalDef) avails)
+    add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True False [] (\n -> LocalDef) avails)
 \end{code}
 
 \begin{code}