X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnIfaces.lhs;h=8092a6d5cd7fb9beac4342a392cd87c4512242c0;hb=e0eaaf09894f74939166568573b36cb5bdafcfc7;hp=fc92acabb9a0b753ec4b973b1cd5f7a1358074d0;hpb=be33dbc967b4915cfdb0307ae1b7ae3cee651b8c;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index fc92aca..8092a6d 100644
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -20,7 +20,7 @@ module RnIfaces (
 #include "HsVersions.h"
 
 import CmdLineOpts	( opt_PruneTyDecls,  opt_PruneInstDecls, 
-			  opt_IgnoreIfacePragmas
+			  opt_D_show_rn_imports, opt_IgnoreIfacePragmas
 			)
 import HsSyn		( HsDecl(..), TyDecl(..), ClassDecl(..), InstDecl(..), IfaceSig(..), 
 			  HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
@@ -44,12 +44,12 @@ import FiniteMap	( FiniteMap, sizeFM, emptyFM, delFromFM,
 			)
 import Name		( Name {-instance NamedThing-}, Provenance, OccName(..),
 			  nameModule, moduleString, pprModule, isLocallyDefined,
-			  NameSet(..), emptyNameSet, unionNameSets, nameSetToList,
+			  NameSet, emptyNameSet, unionNameSets, nameSetToList,
 			  minusNameSet, mkNameSet, elemNameSet, nameUnique, addOneToNameSet,
 			  isWiredInName, maybeWiredInTyConName, maybeWiredInIdName,
 			  NamedThing(..)
 			 )
-import Id		( GenId, Id(..), idType, dataConTyCon, isAlgCon )
+import Id		( GenId, Id, idType, dataConTyCon, isAlgCon )
 import TyCon		( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
 import Type		( namesOfType )
 import TyVar		( GenTyVar )
@@ -157,22 +157,22 @@ count_decls decls
 \begin{code}
 loadInterface :: SDoc -> Module -> IfaceFlavour -> RnMG Ifaces
 loadInterface doc_str load_mod as_source
-  = getIfacesRn 		`thenRn` \ ifaces ->
-    let
+ = getIfacesRn 		`thenRn` \ ifaces ->
+   let
 	Ifaces this_mod mod_map decls 
 	       all_names imp_names (insts, tycls_names) 
 	       deferred_data_decls inst_mods = ifaces
-    in
+   in
 	-- CHECK WHETHER WE HAVE IT ALREADY
-    case lookupFM mod_map load_mod of {
+   case lookupFM mod_map load_mod of {
 	Just (hif, _, _, _) | hif `as_good_as` as_source
 			    -> 	-- Already in the cache; don't re-read it
 				returnRn ifaces ;
 	other ->
 
 	-- READ THE MODULE IN
-    findAndReadIface doc_str load_mod as_source	`thenRn` \ read_result ->
-    case read_result of {
+   findAndReadIface doc_str load_mod as_source	`thenRn` \ read_result ->
+   case read_result of {
 	-- Check for not found
 	Nothing -> 	-- Not found, so add an empty export env to the Ifaces map
 			-- so that we don't look again
@@ -948,15 +948,30 @@ findAndReadIface :: SDoc -> Module
 	-- Just x  <=> successfully found and parsed 
 findAndReadIface doc_str mod_name as_source
   = traceRn trace_msg			`thenRn_`
+    getModuleHiMap			`thenRn` \ himap ->
+    case (lookupFM himap real_mod_name) of
+      Nothing    ->
+         traceRn (ptext SLIT("...failed"))	`thenRn_`
+	 returnRn Nothing
+      Just fpath ->
+         readIface fpath
+{-
     getSearchPathRn			`thenRn` \ dirs ->
-    try dirs dirs
+    try dirs
+-}
   where
+    real_mod_name = 
+     case as_source of
+        HiBootFile -> 'b':moduleString mod_name
+	HiFile     -> moduleString mod_name
+
     trace_msg = sep [hsep [ptext SLIT("Reading"), 
 			   case as_source of { HiBootFile -> ptext SLIT("[boot]"); other -> empty},
 			   ptext SLIT("interface for"), 
 			   ptext mod_name <> semi],
 		     nest 4 (ptext SLIT("reason:") <+> doc_str)]
 
+{-
 	-- For import {-# SOURCE #-} Foo, "as_source" will be True
 	-- and we read Foo.hi-boot, not Foo.hi.  This is used to break
 	-- loops among modules.
@@ -964,35 +979,38 @@ findAndReadIface doc_str mod_name as_source
 			HiBootFile -> ".hi-boot" -- Ignore `ways' for boot files.
 			HiFile     -> hi
 
-    try all_dirs [] = traceRn (ptext SLIT("...failed"))	`thenRn_`
-		      returnRn Nothing
+    try [] = traceRn (ptext SLIT("...failed"))	`thenRn_`
+	     returnRn Nothing
 
-    try all_dirs ((dir,hisuf):dirs)
+    try ((dir,hisuf):dirs)
 	= readIface file_path	`thenRn` \ read_result ->
 	  case read_result of
-	      Nothing    -> try all_dirs dirs
+	      Nothing    -> try dirs
 	      Just iface -> traceRn (ptext SLIT("...done"))	`thenRn_`
 			    returnRn (Just iface)
 	where
 	  file_path = dir ++ '/' : moduleString mod_name ++ (mod_suffix hisuf)
+-}
 \end{code}
 
-@readIface@ trys just one file.
+@readIface@ tries just the one file.
 
 \begin{code}
 readIface :: String -> RnMG (Maybe ParsedIface)	
 	-- Nothing <=> file not found, or unreadable, or illegible
 	-- Just x  <=> successfully found and parsed 
 readIface file_path
-  = ioToRnMG (hGetStringBuffer file_path)                       `thenRn` \ read_result ->
-    --traceRn (hcat[ptext SLIT("Opening...."), text file_path])   `thenRn_`
+  = ioToRnMG (hGetStringBuffer file_path)       `thenRn` \ read_result ->
     case read_result of
 	Right contents	  -> 
              case parseIface contents (mkSrcLoc (mkFastString file_path) 1) of
-	          Failed err      ->
-		     failWithRn Nothing err 
+	          Failed err      -> failWithRn Nothing err 
 		  Succeeded (PIface iface) -> 
-		     returnRn (Just iface)
+		        if opt_D_show_rn_imports then
+			   putDocRn (hcat[ptext SLIT("Read "), text file_path]) `thenRn_`
+			   returnRn (Just iface)
+			else
+			   returnRn (Just iface)
 
         Left err ->
 	  if isDoesNotExistError err then
@@ -1001,7 +1019,13 @@ readIface file_path
 	     failWithRn Nothing (cannaeReadFile file_path err)
 \end{code}
 
-mkSearchPath takes a string consisting of a colon-separated list
+%*********************************************************
+%*						 	 *
+\subsection{Utils}
+%*							 *
+%*********************************************************
+
+@mkSearchPath@ takes a string consisting of a colon-separated list
 of directories and corresponding suffixes, and turns it into a list
 of (directory, suffix) pairs.  For example: