X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnMonad.lhs;h=26a57538b9aafb464b6b53fbbda2a1f679d202b4;hb=be33dbc967b4915cfdb0307ae1b7ae3cee651b8c;hp=62f789de8117607bb611470c9bef4a84001725b4;hpb=8de16184643ea3c2f9f30b5eaed18db6ef247760;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 62f789d..26a5753 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -1,41 +1,51 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1997
 %
 \section[RnMonad]{The monad used by the renamer}
 
 \begin{code}
-#include "HsVersions.h"
-
 module RnMonad(
-	RnMonad..,
-	SST_R
+	module RnMonad,
+	Module,
+	FiniteMap,
+	Bag,
+	Name,
+	RdrNameHsDecl,
+	RdrNameInstDecl,
+	Version,
+	NameSet,
+	OccName,
+	Fixity
     ) where
 
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
 
 import SST
-import PreludeGlaST	( SYN_IE(ST), thenST, returnST )
+import GlaExts		( RealWorld, stToIO )
 
 import HsSyn		
 import RdrHsSyn
-import ErrUtils		( addErrLoc, addShortErrLocLine, addShortWarnLocLine,
-			  pprBagOfErrors, SYN_IE(Error), SYN_IE(Warning)
+import BasicTypes	( Version, NewOrData, pprModule )
+import SrcLoc		( noSrcLoc )
+import ErrUtils		( addShortErrLocLine, addShortWarnLocLine,
+			  pprBagOfErrors, ErrMsg, WarnMsg
 			)
-import Name		( SYN_IE(Module), Name, OccName, Provenance, SYN_IE(NameSet),
+import Name		( Module, Name, OccName, PrintUnqualified, NameSet, emptyNameSet,
+			  isLocallyDefinedName,
 			  modAndOcc, NamedThing(..)
 			)
-import CmdLineOpts	( opt_D_show_rn_trace )
+import CmdLineOpts	( opt_D_show_rn_trace, opt_IgnoreIfacePragmas )
 import PrelInfo		( builtinNames )
-import TyCon		( TyCon {- instance NamedThing -} )
 import TysWiredIn	( boolTyCon )
-import Pretty
-import PprStyle		( PprStyle(..) )
 import SrcLoc		( SrcLoc, mkGeneratedSrcLoc )
 import Unique		( Unique )
-import FiniteMap	( FiniteMap, emptyFM, bagToFM )
+import UniqFM		( UniqFM )
+import FiniteMap	( FiniteMap, emptyFM, bagToFM, lookupFM )
 import Bag		( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
 import UniqSet
+import UniqSupply
 import Util
+import Outputable
 
 infixr 9 `thenRn`, `thenRn_`
 \end{code}
@@ -48,27 +58,19 @@ infixr 9 `thenRn`, `thenRn_`
 %************************************************************************
 
 \begin{code}
-#if __GLASGOW_HASKELL__ >= 200
-# define REAL_WORLD RealWorld
-#else
-# define REAL_WORLD _RealWorld
-#endif
-\end{code}
-
-\begin{code}
-sstToIO :: SST REAL_WORLD r -> IO r
-sstToIO sst 
-  = sstToST sst 	`thenST` \ r -> 
-    returnST (Right r)
-
-ioToRnMG :: IO r -> RnMG (Either IOError13 r)
-ioToRnMG io rn_down g_down = stToSST io
-
-traceRn :: Pretty -> RnMG ()
-traceRn msg | opt_D_show_rn_trace = ioToRnMG (hPutStr stderr (ppShow 80 msg) >> 
-					      hPutStr stderr "\n")	`thenRn_`
-				    returnRn ()
+sstToIO :: SST RealWorld r -> IO r
+sstToIO sst = stToIO (sstToST sst)
+
+ioToRnMG :: IO r -> RnMG (Either IOError r)
+ioToRnMG io rn_down g_down = ioToSST io
+	    
+traceRn :: SDoc -> RnMG ()
+traceRn msg | opt_D_show_rn_trace = putDocRn msg
 	    | otherwise		  = returnRn ()
+
+putDocRn :: SDoc -> RnMG ()
+putDocRn msg = ioToRnMG (printErrs msg)	`thenRn_`
+	       returnRn ()
 \end{code}
 
 
@@ -84,16 +86,18 @@ traceRn msg | opt_D_show_rn_trace = ioToRnMG (hPutStr stderr (ppShow 80 msg) >>
 
 \begin{code}
 type RnM s d r = RnDown s -> d -> SST s r
-type RnMS s r   = RnM s          (SDown s) r		-- Renaming source
-type RnMG r     = RnM REAL_WORLD GDown     r		-- Getting global names etc
-type MutVar a  = MutableVar REAL_WORLD a		-- ToDo: there ought to be a standard defn of this
+type RnMS s r   = RnM s         (SDown s) r		-- Renaming source
+type RnMG r     = RnM RealWorld GDown     r		-- Getting global names etc
+type SSTRWRef a = SSTRef RealWorld a		-- ToDo: there ought to be a standard defn of this
 
 	-- Common part
 data RnDown s = RnDown
 		  SrcLoc
-		  (MutableVar s RnNameSupply)
-		  (MutableVar s (Bag Warning, Bag Error))
-		  (MutableVar s [(Name,Necessity)])		-- Occurrences
+		  (SSTRef s RnNameSupply)
+		  (SSTRef s (Bag WarnMsg, Bag ErrMsg))
+		  (SSTRef s ([Occurrence],[Occurrence]))	-- Occurrences: compulsory and optional resp
+
+type Occurrence = (Name, SrcLoc)		-- The srcloc is the occurrence site
 
 data Necessity = Compulsory | Optional		-- We *must* find definitions for
 						-- compulsory occurrences; we *may* find them
@@ -102,19 +106,30 @@ data Necessity = Compulsory | Optional		-- We *must* find definitions for
 	-- For getting global names
 data GDown = GDown
 		SearchPath
-		(MutVar Ifaces)
+		(SSTRWRef Ifaces)
 
 	-- For renaming source code
 data SDown s = SDown
-		  RnEnv	
+		  RnEnv			-- Global envt
+		  NameEnv		-- Local name envt (includes global name envt, 
+					-- but may shadow it)
 		  Module
 		  RnSMode
 
 
-data RnSMode	= SourceMode
-		| InterfaceMode
+data RnSMode	= SourceMode			-- Renaming source code
+		| InterfaceMode			-- Renaming interface declarations.  
+			Necessity		-- The "necessity"
+						-- flag says free variables *must* be found and slurped
+						-- or whether they need not be.  For value signatures of
+						-- things that are themselves compulsorily imported
+						-- we arrange that the type signature is read 
+						-- in compulsory mode,
+						-- but the pragmas in optional mode.
+			(Name -> PrintUnqualified)	-- Tells whether the thing can be printed unqualified
 
-type SearchPath = [String]		-- List of directories to seach for interface files
+type SearchPath = [(String,String)]	-- List of (directory,suffix) pairs to search 
+                                        -- for interface files.
 type FreeVars	= NameSet
 \end{code}
 
@@ -128,13 +143,20 @@ type RnNameSupply = (UniqSupply, Int, FiniteMap (Module,OccName) Name)
 	-- The Int is used to give a number to each instance declaration;
 	-- it's really a separate name supply.
 
-data RnEnv     	= RnEnv NameEnv FixityEnv
-emptyRnEnv	= RnEnv emptyNameEnv emptyFixityEnv
+data RnEnv     	= RnEnv GlobalNameEnv FixityEnv
+emptyRnEnv	= RnEnv emptyNameEnv  emptyFixityEnv
+
+type GlobalNameEnv = FiniteMap RdrName (Name, HowInScope)
+emptyGlobalNameEnv = emptyFM
+
+data HowInScope		-- Used for error messages only
+   = FromLocalDefn SrcLoc
+   | FromImportDecl Module SrcLoc
 
 type NameEnv	= FiniteMap RdrName Name
 emptyNameEnv	= emptyFM
 
-type FixityEnv		= FiniteMap RdrName (Fixity, Provenance)
+type FixityEnv		= FiniteMap RdrName (Fixity, HowInScope)
 emptyFixityEnv	        = emptyFM
 	-- It's possible to have a different fixity for B.op than for op:
 	--
@@ -145,14 +167,26 @@ emptyFixityEnv	        = emptyFM
 
 data ExportEnv		= ExportEnv Avails Fixities
 type Avails		= [AvailInfo]
-type Fixities		= [(OccName, (Fixity, Provenance))]
-	-- Can contain duplicates, if one module defines the same fixity,
-	-- or the same type/class/id, more than once.   Hence a boring old list.
-	-- This allows us to report duplicates in just one place, namely plusRnEnv.
-	
-type ModuleAvails	= FiniteMap Module Avails
-
-data AvailInfo		= NotAvailable | Avail Name [Name]
+type Fixities		= [(OccName, Fixity)]
+
+type ExportAvails	= (FiniteMap Module Avails,	-- Used to figure out "module M" export specifiers
+							-- Includes avails only from *unqualified* imports
+							-- (see 1.4 Report Section 5.1.1)
+
+			   UniqFM AvailInfo)		-- Used to figure out all other export specifiers.
+							-- Maps a Name to the AvailInfo that contains it
+							-- NB: Contain bindings for class ops but 
+							-- not constructors (see defn of availEntityNames)
+
+
+data GenAvailInfo name	= NotAvailable 
+			| Avail name		-- An ordinary identifier
+			| AvailTC name 		-- The name of the type or class
+				  [name]	-- The available pieces of type/class. NB: If the type or
+						-- class is itself to be in scope, it must be in this list.
+						-- Thus, typically: AvailTC Eq [Eq, ==, /=]
+type AvailInfo    = GenAvailInfo Name
+type RdrAvailInfo = GenAvailInfo OccName
 \end{code}
 
 ===================================================
@@ -160,9 +194,18 @@ data AvailInfo		= NotAvailable | Avail Name [Name]
 ===================================================
 
 \begin{code}
-type ExportItem		 = (Module, [(OccName, [OccName])])
+type ExportItem		 = (Module, IfaceFlavour, [RdrAvailInfo])
 type VersionInfo name    = [ImportVersion name]
-type ImportVersion name  = (Module, Version, [LocalVersion name])
+
+type ImportVersion name  = (Module, IfaceFlavour, Version, WhatsImported name)
+data WhatsImported name  = Everything 
+			 | Specifically [LocalVersion name]	-- List guaranteed non-empty
+
+    -- ("M", hif, ver, Everything) means there was a "module M" in 
+    -- this module's export list, so we just have to go by M's version, "ver",
+    -- not the list of LocalVersions.
+
+
 type LocalVersion name   = (name, Version)
 
 data ParsedIface
@@ -176,7 +219,7 @@ data ParsedIface
       [(Version, RdrNameHsDecl)]	-- Local definitions
       [RdrNameInstDecl]			-- Local instance declarations
 
-type InterfaceDetails = (VersionInfo Name,	-- Version information
+type InterfaceDetails = (VersionInfo Name,	-- Version information for what this module imports
 			 ExportEnv, 		-- What this module exports
 			 [Module])		-- Instance modules
 
@@ -184,19 +227,42 @@ type RdrNamePragma = ()				-- Fudge for now
 -------------------
 
 data Ifaces = Ifaces
-		Module							-- Name of this module
-		(FiniteMap Module Version)
-		(FiniteMap Module (Avails, [(OccName,Fixity)]))		-- Exports
-		VersionMap
+		Module						-- Name of this module
+		(FiniteMap Module (IfaceFlavour, 		-- Exports
+				   Version, 
+				   Avails, 
+				   [(OccName,Fixity)]))
 		DeclsMap
-		(Bag IfaceInst)
+
+		NameSet			-- All the names (whether "big" or "small", whether wired-in or not,
+					-- whether locally defined or not) that have been slurped in so far.
+
+		[(Name,Version)]	-- All the (a) non-wired-in (b) "big" (c) non-locally-defined names that 
+					-- have been slurped in so far, with their versions. 
+					-- This is used to generate the "usage" information for this module.
+					-- Subset of the previous field.
+
+		(Bag IfaceInst, NameSet) -- The as-yet un-slurped instance decls; this bag is depleted when we
+					 -- slurp an instance decl so that we don't slurp the same one twice.
+					 -- Together with them is the set of tycons/classes that may allow 
+					 -- the instance decls in.
+
+		(FiniteMap Name RdrNameTyDecl)
+					-- Deferred data type declarations; each has the following properties
+					--	* it's a data type decl
+					--	* its TyCon is needed
+					--	* the decl may or may not have been slurped, depending on whether any
+					--	  of the constrs are needed.
+
 		[Module]		-- Set of modules with "special" instance declarations
 					-- Excludes this module
 
-type DeclsMap    = FiniteMap Name (AvailInfo, RdrNameHsDecl)
-type VersionMap  = FiniteMap Name Version
-type IfaceInst   = ([Name], Module, RdrNameInstDecl)	-- The Names are those tycons and
-							-- classes mentioned by the instance type
+
+type DeclsMap    = FiniteMap Name (Version, AvailInfo, RdrNameHsDecl)
+type IfaceInst   = ((Module, RdrNameInstDecl),	-- Instance decl
+		    [Name])			-- "Gate" names.  Slurp this instance decl when this
+						-- list becomes empty.  It's depleted whenever we
+						-- slurp another type or class decl.
 \end{code}
 
 
@@ -209,7 +275,7 @@ type IfaceInst   = ([Name], Module, RdrNameInstDecl)	-- The Names are those tyco
 \begin{code}
 initRn :: Module -> UniqSupply -> SearchPath -> SrcLoc
        -> RnMG r
-       -> IO (r, Bag Error, Bag Warning)
+       -> IO (r, Bag ErrMsg, Bag WarnMsg)
 
 initRn mod us dirs loc do_rn
   = sstToIO $
@@ -229,23 +295,23 @@ initRn mod us dirs loc do_rn
     returnSST (res, errs, warns)
 
 
-initRnMS :: RnEnv -> Module -> RnSMode -> RnMS REAL_WORLD r -> RnMG r
-initRnMS env mod_name mode m rn_down g_down
+initRnMS :: RnEnv -> Module -> RnSMode -> RnMS RealWorld r -> RnMG r
+initRnMS rn_env@(RnEnv name_env _) mod_name mode m rn_down g_down
   = let
-	s_down = SDown env mod_name mode
+	s_down = SDown rn_env emptyNameEnv mod_name mode
     in
     m rn_down s_down
 
 
 emptyIfaces :: Module -> Ifaces
-emptyIfaces mod = Ifaces mod emptyFM emptyFM emptyFM emptyFM emptyBag []
+emptyIfaces mod = Ifaces mod emptyFM emptyFM emptyNameSet [] (emptyBag, emptyNameSet) emptyFM []
 
 builtins :: FiniteMap (Module,OccName) Name
 builtins = bagToFM (mapBag (\ name -> (modAndOcc name, name)) builtinNames)
 
 	-- Initial value for the occurrence pool.
-initOccs :: [(Name,Necessity)]
-initOccs = [(getName boolTyCon, Compulsory)]
+initOccs :: ([Occurrence],[Occurrence])	-- Compulsory and optional respectively
+initOccs = ([(getName boolTyCon, noSrcLoc)], [])
 	-- Booleans occur implicitly a lot, so it's tiresome to keep recording the fact, and
 	-- rather implausible that not one will be used in the module.
 	-- We could add some other common types, notably lists, but the general idea is
@@ -266,7 +332,7 @@ once you must either split it, or install a fresh unique supply.
 \begin{code}
 renameSourceCode :: Module 
 		 -> RnNameSupply 
-	         -> RnMS REAL_WORLD r
+	         -> RnMS RealWorld r
 	         -> r
 
 -- Alas, we can't use the real runST, with the desired signature:
@@ -277,26 +343,28 @@ renameSourceCode mod_name name_supply m
   = runSST (
 	newMutVarSST name_supply		`thenSST` \ names_var ->
 	newMutVarSST (emptyBag,emptyBag)	`thenSST` \ errs_var ->
-	newMutVarSST []				`thenSST` \ occs_var ->
+	newMutVarSST ([],[])			`thenSST` \ occs_var ->
     	let
 	    rn_down = RnDown mkGeneratedSrcLoc names_var errs_var occs_var
-	    s_down = SDown emptyRnEnv mod_name InterfaceMode
+	    s_down = SDown emptyRnEnv emptyNameEnv mod_name (InterfaceMode Compulsory (\_ -> False))
 	in
 	m rn_down s_down			`thenSST` \ result ->
 	
 	readMutVarSST errs_var			`thenSST` \ (warns,errs) ->
 
 	(if not (isEmptyBag errs) then
-		trace ("Urk! renameSourceCode found errors" ++ display errs) 
+		pprTrace "Urk! renameSourceCode found errors" (display errs) 
+#ifdef DEBUG
 	 else if not (isEmptyBag warns) then
-		trace ("Urk! renameSourceCode found warnings" ++ display warns)
+		pprTrace "Urk! renameSourceCode found warnings" (display warns)
+#endif
 	 else
 		id) $
 
 	returnSST result
     )
   where
-    display errs = ppShow 80 (pprBagOfErrors PprDebug errs)
+    display errs = pprBagOfErrors errs
 
 {-# INLINE thenRn #-}
 {-# INLINE thenRn_ #-}
@@ -308,6 +376,7 @@ thenRn   :: RnM s d a -> (a -> RnM s d b) -> RnM s d b
 thenRn_  :: RnM s d a -> RnM s d b -> RnM s d b
 andRn    :: (a -> a -> a) -> RnM s d a -> RnM s d a -> RnM s d a
 mapRn    :: (a -> RnM s d b) -> [a] -> RnM s d [b]
+mapMaybeRn :: (a -> RnM s d b) -> b -> Maybe a -> RnM s d b
 sequenceRn :: [RnM s d a] -> RnM s d [a]
 foldlRn :: (b  -> a -> RnM s d b) -> b -> [a] -> RnM s d b
 mapAndUnzipRn :: (a -> RnM s d (b,c)) -> [a] -> RnM s d ([b],[c])
@@ -348,6 +417,9 @@ mapAndUnzip3Rn f (x:xs)
   = f x		    	`thenRn` \ (r1,  r2,  r3)  ->
     mapAndUnzip3Rn f xs	`thenRn` \ (rs1, rs2, rs3) ->
     returnRn (r1:rs1, r2:rs2, r3:rs3)
+
+mapMaybeRn f def Nothing  = returnRn def
+mapMaybeRn f def (Just v) = f v
 \end{code}
 
 
@@ -362,7 +434,7 @@ mapAndUnzip3Rn f (x:xs)
 ================  Errors and warnings =====================
 
 \begin{code}
-failWithRn :: a -> Error -> RnM s d a
+failWithRn :: a -> ErrMsg -> RnM s d a
 failWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
   = readMutVarSST  errs_var  					`thenSST`  \ (warns,errs) ->
     writeMutVarSST errs_var (warns, errs `snocBag` err)		`thenSST_` 
@@ -370,7 +442,7 @@ failWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
   where
     err = addShortErrLocLine loc msg
 
-warnWithRn :: a -> Warning -> RnM s d a
+warnWithRn :: a -> WarnMsg -> RnM s d a
 warnWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
   = readMutVarSST  errs_var  				 	`thenSST`  \ (warns,errs) ->
     writeMutVarSST errs_var (warns `snocBag` warn, errs)	`thenSST_` 
@@ -378,14 +450,14 @@ warnWithRn res msg (RnDown loc names_var errs_var occs_var) l_down
   where
     warn = addShortWarnLocLine loc msg
 
-addErrRn :: Error -> RnM s d ()
+addErrRn :: ErrMsg -> RnM s d ()
 addErrRn err = failWithRn () err
 
-checkRn :: Bool -> Error -> RnM s d ()	-- Check that a condition is true
+checkRn :: Bool -> ErrMsg -> RnM s d ()	-- Check that a condition is true
 checkRn False err  = addErrRn err
 checkRn True err = returnRn ()
 
-addWarnRn :: Warning -> RnM s d ()
+addWarnRn :: WarnMsg -> RnM s d ()
 addWarnRn warn = warnWithRn () warn
 
 checkErrsRn :: RnM s d Bool		-- True <=> no errors so far
@@ -417,28 +489,103 @@ getNameSupplyRn (RnDown loc names_var errs_var occs_var) l_down
 setNameSupplyRn :: RnNameSupply -> RnM s d ()
 setNameSupplyRn names' (RnDown loc names_var errs_var occs_var) l_down
   = writeMutVarSST names_var names'
+
+-- The "instance-decl unique supply", inst, is just an integer that's used to
+-- give a unique number for each instance declaration.
+newInstUniq :: RnM s d Int
+newInstUniq (RnDown loc names_var errs_var occs_var) l_down
+  = readMutVarSST names_var				`thenSST` \ (us, inst, cache) ->
+    writeMutVarSST names_var (us, inst+1, cache)	`thenSST_` 
+    returnSST inst
 \end{code}
 
 ================  Occurrences =====================
 
+Every time we get an occurrence of a name we put it in one of two lists:
+	one for "compulsory" occurrences
+	one for "optional" occurrences
+
+The significance of "compulsory" is
+	(a) we *must* find the declaration
+	(b) in the case of type or class names, the name is part of the
+	    source level program, and we must slurp in any instance decls
+	    involving it.  
+
+We don't need instance decls "optional" names, because the type inference
+process will never come across them.  Optional names are buried inside
+type checked (but not renamed) cross-module unfoldings and such.
+
+The pair of lists is held in a mutable variable in RnDown.  
+
+The lists are kept separate so that we can process all the compulsory occurrences 
+before any of the optional ones.  Why?  Because suppose we processed an optional 
+"g", and slurped an interface decl of g::T->T.  Then we'd rename the type T->T in
+optional mode.  But if we later need g compulsorily we'll find that it's already
+been slurped and will do nothing.  We could, I suppose, rename it a second time,
+but it seems simpler just to do all the compulsory ones first.
+
 \begin{code}
-addOccurrenceName :: Necessity -> Name -> RnM s d ()
-addOccurrenceName necessity name (RnDown loc names_var errs_var occs_var) l_down
-  = readMutVarSST occs_var			`thenSST` \ occs ->
-    writeMutVarSST occs_var ((name,necessity) : occs)
+addOccurrenceName :: Name -> RnMS s Name	-- Same name returned as passed
+addOccurrenceName name (RnDown loc names_var errs_var occs_var)
+		       (SDown rn_env local_env mod_name mode)
+  | isLocallyDefinedName name ||
+    not_necessary necessity
+  = returnSST name
+
+  | otherwise
+  = readMutVarSST occs_var			`thenSST` \ (comp_occs, opt_occs) ->
+    let
+	new_occ_pair = case necessity of
+			 Optional   -> (comp_occs, (name,loc):opt_occs)
+			 Compulsory -> ((name,loc):comp_occs, opt_occs)
+    in
+    writeMutVarSST occs_var new_occ_pair	`thenSST_`
+    returnSST name
+  where
+    necessity = modeToNecessity mode
 
-addOccurrenceNames :: Necessity -> [Name] -> RnM s d ()
-addOccurrenceNames necessity names (RnDown loc names_var errs_var occs_var) l_down
-  = readMutVarSST occs_var			`thenSST` \ occs ->
-    writeMutVarSST occs_var ([(name,necessity) | name <- names] ++ occs)
 
-popOccurrenceName :: RnM s d (Maybe (Name,Necessity))
-popOccurrenceName (RnDown loc names_var errs_var occs_var) l_down
+addOccurrenceNames :: [Name] -> RnMS s ()
+addOccurrenceNames names (RnDown loc names_var errs_var occs_var)
+		         (SDown rn_env local_env mod_name mode)
+  | not_necessary necessity 
+  = returnSST ()
+
+  | otherwise
+  = readMutVarSST occs_var			`thenSST` \ (comp_occs, opt_occs) ->
+    let
+	new_occ_pair = case necessity of
+			 Optional   -> (comp_occs, non_local_occs ++ opt_occs)
+			 Compulsory -> (non_local_occs ++ comp_occs, opt_occs)
+    in
+    writeMutVarSST occs_var new_occ_pair
+  where
+    non_local_occs = [(name, loc) | name <- names, not (isLocallyDefinedName name)]
+    necessity = modeToNecessity mode
+
+	-- Never look for optional things if we're
+	-- ignoring optional input interface information
+not_necessary Compulsory = False
+not_necessary Optional   = opt_IgnoreIfacePragmas
+
+popOccurrenceName :: RnSMode -> RnM s d (Maybe Occurrence)
+popOccurrenceName mode (RnDown loc names_var errs_var occs_var) l_down
   = readMutVarSST occs_var			`thenSST` \ occs ->
-    case occs of
-	[] 	   -> returnSST Nothing
-	(occ:occs) -> writeMutVarSST occs_var occs	`thenSST_`
-		      returnSST (Just occ)
+    case (mode, occs) of
+		-- Find a compulsory occurrence
+	(InterfaceMode Compulsory _, (comp:comps, opts))
+		-> writeMutVarSST occs_var (comps, opts)	`thenSST_`
+		   returnSST (Just comp)
+
+		-- Find an optional occurrence
+		-- We shouldn't be looking unless we've done all the compulsories
+	(InterfaceMode Optional _, (comps, opt:opts))
+		-> ASSERT( null comps )
+		   writeMutVarSST occs_var (comps, opts)	`thenSST_`
+		   returnSST (Just opt)
+
+		-- No suitable occurrence
+	other -> returnSST Nothing
 
 -- findOccurrencesRn does the enclosed thing with a *fresh* occurrences
 -- variable, and returns the list of occurrences thus found.  It's useful
@@ -448,9 +595,9 @@ popOccurrenceName (RnDown loc names_var errs_var occs_var) l_down
 
 findOccurrencesRn :: RnM s d a -> RnM s d [Name]
 findOccurrencesRn enclosed_thing (RnDown loc names_var errs_var occs_var) l_down
-  = newMutVarSST []							`thenSST` \ new_occs_var ->
+  = newMutVarSST ([],[])						`thenSST` \ new_occs_var ->
     enclosed_thing (RnDown loc names_var errs_var new_occs_var) l_down	`thenSST_`
-    readMutVarSST new_occs_var						`thenSST` \ occs ->
+    readMutVarSST new_occs_var						`thenSST` \ (occs,_) ->
     returnSST (map fst occs)
 \end{code}
 
@@ -464,35 +611,55 @@ findOccurrencesRn enclosed_thing (RnDown loc names_var errs_var occs_var) l_down
 ================  RnEnv  =====================
 
 \begin{code}
-getNameEnv :: RnMS s NameEnv
-getNameEnv rn_down (SDown (RnEnv name_env fixity_env) mod_name mode)
-  = returnSST name_env
-
-setNameEnv :: NameEnv -> RnMS s a -> RnMS s a
-setNameEnv name_env' m rn_down (SDown (RnEnv name_env fixity_env) mod_name mode)
-  = m rn_down (SDown (RnEnv name_env' fixity_env) mod_name mode)
+-- Look in global env only
+lookupGlobalNameRn :: RdrName -> RnMS s (Maybe Name)
+lookupGlobalNameRn rdr_name rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
+  = case lookupFM global_env rdr_name of
+	  Just (name, _) -> returnSST (Just name)
+	  Nothing 	 -> returnSST Nothing
+  
+-- Look in both local and global env
+lookupNameRn :: RdrName -> RnMS s (Maybe Name)
+lookupNameRn rdr_name rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
+  = case lookupFM local_env rdr_name of
+	  Just name -> returnSST (Just name)
+	  Nothing   -> case lookupFM global_env rdr_name of
+			  Just (name, _) -> returnSST (Just name)
+			  Nothing        -> returnSST Nothing
+
+getNameEnvs :: RnMS s (GlobalNameEnv, NameEnv)
+getNameEnvs rn_down (SDown (RnEnv global_env fixity_env) local_env mod_name mode)
+  = returnSST (global_env, local_env)
+
+getLocalNameEnv :: RnMS s NameEnv
+getLocalNameEnv rn_down (SDown rn_env local_env mod_name mode)
+  = returnSST local_env
+
+setLocalNameEnv :: NameEnv -> RnMS s a -> RnMS s a
+setLocalNameEnv local_env' m rn_down (SDown rn_env local_env mod_name mode)
+  = m rn_down (SDown rn_env local_env' mod_name mode)
 
 getFixityEnv :: RnMS s FixityEnv
-getFixityEnv rn_down (SDown (RnEnv name_env fixity_env) mod_name mode)
+getFixityEnv rn_down (SDown (RnEnv name_env fixity_env) local_env mod_name mode)
   = returnSST fixity_env
-
-setRnEnv :: RnEnv -> RnMS s a -> RnMS s a 
-setRnEnv rn_env' m rn_down (SDown rn_env mod_name mode)
-  = m rn_down (SDown rn_env' mod_name mode)
 \end{code}
 
 ================  Module and Mode =====================
 
 \begin{code}
 getModuleRn :: RnMS s Module
-getModuleRn rn_down (SDown rn_env mod_name mode)
+getModuleRn rn_down (SDown rn_env local_env mod_name mode)
   = returnSST mod_name
 \end{code}
 
 \begin{code}
 getModeRn :: RnMS s RnSMode
-getModeRn rn_down (SDown rn_env mod_name mode)
+getModeRn rn_down (SDown rn_env local_env mod_name mode)
   = returnSST mode
+
+setModeRn :: RnSMode -> RnMS s a -> RnMS s a
+setModeRn new_mode thing_inside rn_down (SDown rn_env local_env mod_name mode)
+  = thing_inside rn_down (SDown rn_env local_env mod_name new_mode)
 \end{code}
 
 
@@ -515,3 +682,22 @@ getSearchPathRn :: RnMG SearchPath
 getSearchPathRn rn_down (GDown dirs iface_var)
   = returnSST dirs
 \end{code}
+
+%************************************************************************
+%*									*
+\subsection{HowInScope}
+%*									*
+%************************************************************************
+
+\begin{code}
+instance Outputable HowInScope where
+  ppr (FromLocalDefn loc)      = ptext SLIT("Defined at") <+> ppr loc
+  ppr (FromImportDecl mod loc) = ptext SLIT("Imported from") <+> quotes (pprModule mod) <+>
+		  	         ptext SLIT("at") <+> ppr loc
+\end{code}
+
+
+\begin{code}
+modeToNecessity SourceMode		    = Compulsory
+modeToNecessity (InterfaceMode necessity _) = necessity
+\end{code}