X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnNames.lhs;h=8773732c6ddb16e406b9ec2872ce42503d1414cc;hb=3e12bb2d764b45563000ab3074dac61d22853321;hp=8ae1e5375e38b4b5b70ae39d9b84c85ba83a6e1b;hpb=ac80e0dececb68ed6385e3b34765fd8f9c019767;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 8ae1e53..8773732 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -14,8 +14,8 @@ module RnNames (
 
 import CmdLineOpts	( DynFlag(..) )
 import HsSyn		( IE(..), ieName, ImportDecl(..), LImportDecl,
-			  ForeignDecl(..), HsGroup(..),
-			  collectGroupBinders, tyClDeclNames 
+			  ForeignDecl(..), HsGroup(..), HsBindGroup(..), 
+			  Sig(..), collectGroupBinders, tyClDeclNames 
 			)
 import RnEnv
 import IfaceEnv		( lookupOrig, newGlobalBinder )
@@ -273,7 +273,7 @@ exportsToAvails exports
 	-- 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.
+	-- For imported things, we may only suck in the interface 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,
@@ -380,12 +380,21 @@ getLocalDeclBinders mod (HsGroup {hs_valds = val_decls,
 	-- an export indicator because they are all implicitly exported.
 
     mappM new_tc     tycl_decls				`thenM` \ tc_avails ->
-    mappM new_simple (for_hs_bndrs ++ val_hs_bndrs)	`thenM` \ simple_avails ->
-    returnM (tc_avails ++ simple_avails)
+	
+	-- In a hs-boot file, the value binders come from the
+	-- *signatures*, and there should be no foreign binders 
+    tcIsHsBoot						`thenM` \ is_hs_boot ->
+    let val_bndrs | is_hs_boot = sig_hs_bndrs
+		  | otherwise  = for_hs_bndrs ++ val_hs_bndrs
+    in
+    mappM new_simple val_bndrs				`thenM` \ names ->
+
+    returnM (tc_avails ++ map Avail names)
   where
-    new_simple rdr_name = newTopSrcBinder mod Nothing rdr_name `thenM` \ name ->
-			  returnM (Avail name)
+    new_simple rdr_name = newTopSrcBinder mod Nothing rdr_name
 
+    sig_hs_bndrs = [nm | HsBindGroup _ lsigs _  <- val_decls, 
+			 L _ (Sig nm _) <- lsigs]
     val_hs_bndrs = collectGroupBinders val_decls
     for_hs_bndrs = [nm | L _ (ForeignImport nm _ _ _) <- foreign_decls]
 
@@ -753,8 +762,9 @@ gre_is_used used_names gre = gre_name gre `elemNameSet` used_names
 %*********************************************************
 
 \begin{code}
-reportUnusedNames :: TcGblEnv -> RnM ()
-reportUnusedNames gbl_env 
+reportUnusedNames :: Maybe [Located (IE RdrName)] 	-- Export list
+		  -> TcGblEnv -> RnM ()
+reportUnusedNames export_decls gbl_env 
   = do	{ warnUnusedTopBinds   unused_locals
 	; warnUnusedModules    unused_imp_mods
 	; warnUnusedImports    unused_imports	
@@ -804,8 +814,10 @@ reportUnusedNames gbl_env
     -- To figure out the minimal set of imports, start with the things
     -- that are in scope (i.e. in gbl_env).  Then just combine them
     -- into a bunch of avails, so they are properly grouped
+    --
+    -- BUG WARNING: this does not deal properly with qualified imports!
     minimal_imports :: FiniteMap Module AvailEnv
-    minimal_imports0 = emptyFM
+    minimal_imports0 = foldr add_expall   emptyFM 	   expall_mods
     minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
     minimal_imports  = foldr add_inst_mod minimal_imports1 direct_import_mods
  	-- The last line makes sure that we retain all direct imports
@@ -832,6 +844,27 @@ reportUnusedNames gbl_env
     add_name other acc 
 	= acc
 
+	-- Modules mentioned as 'module M' in the export list
+    expall_mods = case export_decls of
+		    Nothing -> []
+		    Just es -> [m | L _ (IEModuleContents m) <- es]
+
+	-- This is really bogus.  The idea is that if we see 'module M' in 
+	-- the export list we must retain the import decls that drive it
+	-- If we aren't careful we might see
+	--	module A( module M ) where
+	--	  import M
+	--	  import N
+	-- and suppose that N exports everything that M does.  Then we 
+	-- must not drop the import of M even though N brings it all into
+	-- scope.
+	--
+	-- BUG WARNING: 'module M' exports aside, what if M.x is mentioned?!
+	--
+	-- The reason that add_expall is bogus is that it doesn't take
+	-- qualified imports into account.  But it's an improvement.
+    add_expall mod acc = addToFM_C plusAvailEnv acc mod emptyAvailEnv
+
 	-- n is the name of the thing, p is the name of its parent
     mk_avail n (Just p)			 	 = AvailTC p [p,n]
     mk_avail n Nothing | isTcOcc (nameOccName n) = AvailTC n [n]
@@ -854,6 +887,9 @@ reportUnusedNames gbl_env
     -- that are not mentioned in minimal_imports1
     -- [Note: not 'minimal_imports', because that includes directly-imported
     --	      modules even if we use nothing from them; see notes above]
+    --
+    -- BUG WARNING: does not deal correctly with multiple imports of the same module
+    --	 	    becuase direct_import_mods has only one entry per module
     unused_imp_mods = [(mod,loc) | (mod,imp,loc) <- direct_import_mods,
     		       not (mod `elemFM` minimal_imports1),
     		       mod /= pRELUDE,