[project @ 2000-10-30 13:46:24 by sewardj]

Only pass a ModuleLocation into hscMain, not a ModSummary, so as to
facilitate Main.main not necessarily being in Main.hs.

ghc/compiler/ghci/CmSummarise.lhs

@@ -81,7 +81,7 @@ summarise :: Module -> ModuleLocation -> IO ModSummary
 summarise mod location
    = if isModuleInThisPackage mod
 	then do 
-	    let source_fn = hs_file location
+	    let source_fn = hs_preprocd_file location
 	    -- ToDo:
 	    -- ppsource_fn <- preprocess source_fn
 	    modsrc <- readFile source_fn

ghc/compiler/hsSyn/HsImpExp.lhs

@@ -48,6 +48,8 @@ instance (Outputable name) => Outputable (ImportDecl name) where
 			= parens (interpp'SP spec)
 	pp_spec (Just (True, spec))
 			= ptext SLIT("hiding") <+> parens (interpp'SP spec)
+
+ideclName (ImportDecl mod_nm _ _ _ _ _) = mod_nm
 \end{code}
 
 %************************************************************************

ghc/compiler/hsSyn/HsSyn.lhs

@@ -24,7 +24,8 @@ module HsSyn (
 	module HsTypes,
 	Fixity, NewOrData, 
 
-	collectTopBinders, collectMonoBinders, collectLocatedMonoBinders
+	collectTopBinders, collectMonoBinders, collectLocatedMonoBinders,
+	hsModuleName, hsModuleImports
      ) where
 
 #include "HsVersions.h"
@@ -91,6 +92,9 @@ instance (Outputable name, Outputable pat)
 
 	pp_nonnull [] = empty
 	pp_nonnull xs = vcat (map ppr xs)
+
+hsModuleName    (HsModule mod_name _ _ _ _ _ _) = mod_name
+hsModuleImports (HsModule mod_name vers exports imports decls deprec src_loc) = imports
 \end{code}
 
 

ghc/compiler/main/DriverPipeline.hs

 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.11 2000/10/30 11:18:14 sewardj Exp $
+-- $Id: DriverPipeline.hs,v 1.12 2000/10/30 13:46:24 sewardj Exp $
 --
 -- GHC Driver
 --
@@ -37,7 +37,6 @@ import Module
 import CmdLineOpts
 import Config
 import Util
-import MkIface		( pprIface )
 
 import Directory
 import System
@@ -433,14 +432,12 @@ run_phase Hsc basename suff input_fn output_fn
 				  then return "-fsource-unchanged"
 				  else return ""
 
-   -- build a bogus ModSummary to pass to hscMain.
-	let summary = ModSummary {
-			ms_mod = (mkModuleInThisPackage . mkModuleName)
-                                    {-ToDo: modname!!-}basename,
-			ms_location = error "no loc",
-			ms_ppsource = Just (input_fn, error "no fingerprint"),
-			ms_imports = error "no imports"
-		     }
+   -- build a bogus ModuleLocation to pass to hscMain.
+        let location = ModuleLocation {
+                          hs_preprocd_file = input_fn,
+                          hi_file = hifile,
+                          obj_file = o_file
+                       }
 
   -- get the DynFlags
         dyn_flags <- readIORef v_DynFlags
@@ -449,7 +446,7 @@ run_phase Hsc basename suff input_fn output_fn
         pcs <- initPersistentCompilerState
 	result <- hscMain dyn_flags{ hscOutName = output_fn }
 			  (source_unchanged == "-fsource-unchanged")
-			  summary 
+			  location
 			  Nothing	 -- no iface
 			  emptyModuleEnv -- HomeSymbolTable
 			  emptyModuleEnv -- HomeIfaceTable
@@ -733,7 +730,7 @@ compile summary old_iface hst hit pcs = do
    
    let input_fn = case ms_ppsource summary of
 			Just (ppsource, fingerprint) -> ppsource
-			Nothing -> hs_file (ms_location summary)
+			Nothing -> hs_preprocd_file (ms_location summary)
 
    when verb (hPutStrLn stderr ("compile: input file " ++ input_fn))
 
@@ -751,7 +748,7 @@ compile summary old_iface hst hit pcs = do
    -- run the compiler
    hsc_result <- hscMain dyn_flags{ hscOutName = output_fn } 
 			 (panic "compile:source_unchanged")
-                         summary old_iface hst hit pcs
+                         (ms_location summary) old_iface hst hit pcs
 
    case hsc_result of {
       HscFail pcs -> return (CompErrs pcs);
@@ -764,7 +761,7 @@ compile summary old_iface hst hit pcs = do
 		Nothing -> return (CompOK details Nothing pcs);
 		Just iface -> do
 
-	   let (basename, _) = splitFilename (hs_file (ms_location summary))
+	   let (basename, _) = splitFilename (hs_preprocd_file (ms_location summary))
 	   maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
 	   let stub_unlinked = case maybe_stub_o of
 				  Nothing -> []

ghc/compiler/main/Finder.lhs

@@ -123,9 +123,9 @@ mkHomeModuleLocn mod_name basename source_fn = do
 
    return (Just (mkHomeModule mod_name,
                  ModuleLocation{
-		    hs_file  = source_fn,
-		    hi_file  = hifile,
-		    obj_file = o_file
+		    hs_preprocd_file = source_fn,
+		    hi_file          = hifile,
+		    obj_file         = o_file
 	         }
 	))
 
@@ -165,9 +165,9 @@ maybePackageModule mod_name = do
 	Just (pkg_name,path) -> 
 	    return (Just (mkModule mod_name pkg_name,
 			  ModuleLocation{ 
-				hs_file  = "error:_package_module;_no_source",
-				hi_file  = path ++ '/':hi,
-				obj_file = "error:_package_module;_no_object"
+				hs_preprocd_file = "error:_package_module;_no_source",
+				hi_file          = path ++ '/':hi,
+				obj_file         = "error:_package_module;_no_object"
 			   }
 		   ))
 

ghc/compiler/main/HscMain.lhs

@@ -19,7 +19,6 @@ import Lex		( PState(..), ParseResult(..) )
 import SrcLoc		( mkSrcLoc )
 
 import Rename		( renameModule, checkOldIface, closeIfaceDecls )
-
 import Rules		( emptyRuleBase )
 import PrelInfo		( wiredInThings )
 import PrelNames	( knownKeyNames )
@@ -39,7 +38,7 @@ import SimplStg		( stg2stg )
 import CodeGen		( codeGen )
 import CodeOutput	( codeOutput )
 
-import Module		( ModuleName, moduleName, emptyModuleEnv )
+import Module		( ModuleName, moduleName, emptyModuleEnv, mkModuleInThisPackage )
 import CmdLineOpts
 import ErrUtils		( dumpIfSet_dyn )
 import UniqSupply	( mkSplitUniqSupply )
@@ -49,12 +48,11 @@ import Outputable
 import StgInterp	( stgToInterpSyn )
 import HscStats		( ppSourceStats )
 import HscTypes		( ModDetails, ModIface(..), PersistentCompilerState(..),
-			  PersistentRenamerState(..), 
+			  PersistentRenamerState(..), ModuleLocation(..),
 			  HomeSymbolTable, PackageSymbolTable, 
 			  OrigNameEnv(..), PackageRuleBase, HomeIfaceTable, 
 			  extendTypeEnv, groupTyThings,
 			  typeEnvClasses, typeEnvTyCons, emptyIfaceTable )
-import CmSummarise	( ModSummary(..), ms_get_imports, mimp_name )
 import InterpSyn	( UnlinkedIBind )
 import StgInterp	( ItblEnv )
 import FiniteMap	( FiniteMap, plusFM, emptyFM, addToFM )
@@ -86,22 +84,19 @@ data HscResult
 
 hscMain
   :: DynFlags
-  -> Bool	      -- source unchanged?
-  -> ModSummary       -- summary, including source filename
-  -> Maybe ModIface   -- old interface, if available
+  -> Bool			-- source unchanged?
+  -> ModuleLocation		-- location info
+  -> Maybe ModIface		-- old interface, if available
   -> HomeSymbolTable		-- for home module ModDetails
   -> HomeIfaceTable
   -> PersistentCompilerState    -- IN: persistent compiler state
   -> IO HscResult
 
-hscMain dflags source_unchanged summary maybe_old_iface hst hit pcs
+hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
  = do {
-      -- ????? source_unchanged :: Bool -- extracted from summary?
-      --let source_unchanged = trace "WARNING: source_unchanged?!" False
-      --;
       putStrLn "checking old iface ...";
       (pcs_ch, check_errs, (recomp_reqd, maybe_checked_iface))
-         <- checkOldIface dflags hit hst pcs (ms_mod summary)
+         <- checkOldIface dflags hit hst pcs (hi_file location)
 			  source_unchanged maybe_old_iface;
       if check_errs then
          return (HscFail pcs_ch)
@@ -112,17 +107,18 @@ hscMain dflags source_unchanged summary maybe_old_iface hst hit pcs
                     | otherwise                   = hscNoRecomp
       ;
       putStrLn "doing what_next ...";
-      what_next dflags summary maybe_checked_iface
+      what_next dflags location maybe_checked_iface
                 hst hit pcs_ch
       }}
 
 
-hscNoRecomp dflags summary maybe_checked_iface hst hit pcs_ch
+hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch
  = do {
       -- we definitely expect to have the old interface available
       let old_iface = case maybe_checked_iface of 
                          Just old_if -> old_if
                          Nothing -> panic "hscNoRecomp:old_iface"
+          this_mod = mi_module old_iface
       ;
       -- CLOSURE
       (pcs_cl, closure_errs, cl_hs_decls) 
@@ -133,15 +129,15 @@ hscNoRecomp dflags summary maybe_checked_iface hst hit pcs_ch
 
       -- TYPECHECK
       maybe_tc_result
-         <- typecheckModule dflags (ms_mod summary) pcs_cl hst hit cl_hs_decls;
+         <- typecheckModule dflags this_mod pcs_cl hst hit cl_hs_decls;
       case maybe_tc_result of {
          Nothing -> return (HscFail pcs_cl);
          Just tc_result -> do {
 
-      let pcs_tc        = tc_pcs tc_result
-          env_tc        = tc_env tc_result
-          local_insts   = tc_insts tc_result
-          local_rules   = tc_rules tc_result
+      let pcs_tc      = tc_pcs tc_result
+          env_tc      = tc_env tc_result
+          local_insts = tc_insts tc_result
+          local_rules = tc_rules tc_result
       ;
       -- create a new details from the closed, typechecked, old iface
       let new_details = mkModDetailsFromIface env_tc local_insts local_rules
@@ -154,19 +150,21 @@ hscNoRecomp dflags summary maybe_checked_iface hst hit pcs_ch
       }}}}
 
 
-hscRecomp dflags summary maybe_checked_iface hst hit pcs_ch
+hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
  = do {
       -- what target are we shooting for?
       let toInterp = dopt_HscLang dflags == HscInterpreted
-          this_mod = ms_mod summary
       ;
+--      putStrLn ("toInterp = " ++ show toInterp);
       -- PARSE
-      maybe_parsed <- myParseModule dflags summary;
+      maybe_parsed <- myParseModule dflags (hs_preprocd_file location);
       case maybe_parsed of {
          Nothing -> return (HscFail pcs_ch);
          Just rdr_module -> do {
 
       -- RENAME
+      let this_mod = mkModuleInThisPackage (hsModuleName rdr_module)
+      ;
       show_pass dflags "Renamer";
       (pcs_rn, maybe_rn_result) 
          <- renameModule dflags hit hst pcs_ch this_mod rdr_module;
@@ -212,7 +210,8 @@ hscRecomp dflags summary maybe_checked_iface hst hit pcs_ch
       ;
       -- do the rest of code generation/emission
       (maybe_stub_h_filename, maybe_stub_c_filename, maybe_ibinds)
-         <- restOfCodeGeneration dflags toInterp summary
+         <- restOfCodeGeneration dflags toInterp this_mod
+	       (map ideclName (hsModuleImports rdr_module))
                cost_centre_info foreign_stuff env_tc stg_binds oa_tidy_binds
                hit (pcs_PIT pcs_tc)       
       ;
@@ -223,18 +222,11 @@ hscRecomp dflags summary maybe_checked_iface hst hit pcs_ch
       }}}}}}}
 
 
-myParseModule dflags summary
+myParseModule dflags src_filename
  = do --------------------------  Parser  ----------------
       show_pass dflags "Parser"
       -- _scc_     "Parser"
 
-      let src_filename -- name of the preprocessed source file
-            = case ms_ppsource summary of
-                 Just (filename, fingerprint) -> filename
-                 Nothing -> pprPanic 
-                               "myParseModule:summary is not of a source module"
-                               (ppr summary)
-
       buf <- hGetStringBuffer True{-expand tabs-} src_filename
 
       let glaexts | dopt Opt_GlasgowExts dflags = 1#
@@ -257,7 +249,7 @@ myParseModule dflags summary
       }}
 
 
-restOfCodeGeneration dflags toInterp summary cost_centre_info 
+restOfCodeGeneration dflags toInterp this_mod imported_module_names cost_centre_info 
                      foreign_stuff env_tc stg_binds oa_tidy_binds
                      hit pit -- these last two for mapping ModNames to Modules
  | toInterp
@@ -285,9 +277,7 @@ restOfCodeGeneration dflags toInterp summary cost_centre_info
  where
     local_tycons     = typeEnvTyCons env_tc
     local_classes    = typeEnvClasses env_tc
-    this_mod         = ms_mod summary
-    imported_modules = map (mod_name_to_Module.mimp_name) 
-	                   (ms_get_imports summary)
+    imported_modules = map mod_name_to_Module imported_module_names
     (fe_binders,h_code,c_code) = foreign_stuff
 
     mod_name_to_Module :: ModuleName -> Module

ghc/compiler/main/HscTypes.lhs

@@ -87,9 +87,9 @@ import UniqSupply	( UniqSupply )
 \begin{code}
 data ModuleLocation
    = ModuleLocation {
-	hs_file  :: FilePath,
-	hi_file  :: FilePath,
-	obj_file :: FilePath
+	hs_preprocd_file :: FilePath,	-- location after preprocessing
+	hi_file          :: FilePath,
+	obj_file         :: FilePath
      }
      deriving Show
 

ghc/compiler/rename/Rename.lhs

@@ -25,7 +25,8 @@ import RnIfaces		( slurpImpDecls, mkImportInfo,
 			  getInterfaceExports, closeDecls,
 			  RecompileRequired, recompileRequired
 			)
-import RnHiFiles	( findAndReadIface, removeContext, loadExports, loadFixDecls, loadDeprecs )
+import RnHiFiles	( readIface, removeContext, 
+			  loadExports, loadFixDecls, loadDeprecs )
 import RnEnv		( availName, 
 			  emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
 			  warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
@@ -367,41 +368,45 @@ rnDeprecs gbl_env Nothing decls
 checkOldIface :: DynFlags
 	      -> HomeIfaceTable -> HomeSymbolTable
 	      -> PersistentCompilerState
-	      -> Module 
+	      -> FilePath
 	      -> Bool 			-- Source unchanged
 	      -> Maybe ModIface 	-- Old interface from compilation manager, if any
 	      -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
 				-- True <=> errors happened
 
-checkOldIface dflags hit hst pcs mod source_unchanged maybe_iface
-  = initRn dflags hit hst pcs mod $
+checkOldIface dflags hit hst pcs iface_path source_unchanged maybe_iface
+  = initRn dflags hit hst pcs (panic "checkOldIface: bogus mod") $
 	
 	-- Load the old interface file, if we havn't already got it
-    loadOldIface mod maybe_iface			`thenRn` \ maybe_iface ->
+    loadOldIface iface_path maybe_iface				`thenRn` \ maybe_iface2 ->
 
 	-- Check versions
-    recompileRequired mod source_unchanged maybe_iface	`thenRn` \ recompile ->
+    recompileRequired iface_path source_unchanged maybe_iface2	`thenRn` \ recompile ->
 
-    returnRn (recompile, maybe_iface)
+    returnRn (recompile, maybe_iface2)
 \end{code}
 
 
 \begin{code}
-loadOldIface :: Module -> Maybe ModIface -> RnMG (Maybe ModIface)
-loadOldIface mod (Just iface) 
+loadOldIface :: FilePath -> Maybe ModIface -> RnMG (Maybe ModIface)
+loadOldIface iface_path (Just iface) 
   = returnRn (Just iface)
 
-loadOldIface mod Nothing
+loadOldIface iface_path Nothing
   = 	-- LOAD THE OLD INTERFACE FILE
-    findAndReadIface doc_str (moduleName mod) False {- Not hi-boot -}	`thenRn` \ read_result ->
+    -- call readIface ...
+    readIface iface_path `thenRn` \ read_result ->
     case read_result of {
 	Left err -> 	-- Old interface file not found, or garbled, so we'd better bail out
 		    traceRn (vcat [ptext SLIT("No old interface file:"), err])	`thenRn_`
 		    returnRn Nothing ;
 
-	Right (_, iface) ->
+	Right iface ->
 
 	-- RENAME IT
+    let mod = pi_mod iface
+        doc_str = ptext SLIT("need usage info from") <+> ppr mod
+    in
     initIfaceRnMS mod (
 	loadHomeDecls (pi_decls iface)	`thenRn` \ decls ->
 	loadHomeRules (pi_rules iface)	`thenRn` \ rules -> 
@@ -433,10 +438,6 @@ loadOldIface mod Nothing
     in
     returnRn (Just mod_iface)
     }
-
-    
-  where
-    doc_str = ptext SLIT("need usage info from") <+> ppr mod
 \end{code}
 
 \begin{code}

ghc/compiler/rename/RnHiFiles.lhs

@@ -5,7 +5,7 @@
 
 \begin{code}
 module RnHiFiles (
-	findAndReadIface, loadInterface, loadHomeInterface, 
+	readIface, findAndReadIface, loadInterface, loadHomeInterface, 
 	tryLoadInterface, loadOrphanModules,
 	loadExports, loadFixDecls, loadDeprecs,
 
@@ -485,10 +485,17 @@ findAndReadIface doc_str mod_name hi_boot_file
     ioToRnM (findModule mod_name)	`thenRn` \ maybe_found ->
 
     case maybe_found of
-      Right (Just (mod,locn))
-	| hi_boot_file -> readIface mod (hi_file locn ++ "-boot")
-	| otherwise    -> readIface mod (hi_file locn)
-	
+      Right (Just (wanted_mod,locn))
+        -> readIface (hi_file locn ++ if hi_boot_file then "-boot" else "")
+					`thenRn` \ read_result ->
+	   case read_result of
+              Left bad -> returnRn (Left bad)
+              Right iface 
+                 -> let read_mod = pi_mod iface
+		    in warnCheckRn (wanted_mod == read_mod)
+		   	           (hiModuleNameMismatchWarn wanted_mod read_mod) 
+				  	`thenRn_`
+		       returnRn (Right (wanted_mod, iface))
 	-- Can't find it
       other   -> traceRn (ptext SLIT("...not found"))	`thenRn_`
 		 returnRn (Left (noIfaceErr mod_name hi_boot_file))
@@ -504,12 +511,12 @@ findAndReadIface doc_str mod_name hi_boot_file
 @readIface@ tries just the one file.
 
 \begin{code}
-readIface :: Module -> String -> RnM d (Either Message (Module, ParsedIface))
+readIface :: String -> RnM d (Either Message ParsedIface)
 	-- Nothing <=> file not found, or unreadable, or illegible
 	-- Just x  <=> successfully found and parsed 
-readIface wanted_mod file_path
-  = traceRn (ptext SLIT("...reading from") <+> text file_path)	`thenRn_`
-    ioToRnM (hGetStringBuffer False file_path)      		 `thenRn` \ read_result ->
+readIface file_path
+  = traceRn (ptext SLIT("readIFace") <+> text file_path)	`thenRn_`
+    ioToRnM (hGetStringBuffer False file_path)     		`thenRn` \ read_result ->
     case read_result of
 	Right contents	  -> 
              case parseIface contents
@@ -517,13 +524,7 @@ readIface wanted_mod file_path
 				context = [],
 				glasgow_exts = 1#,
 				loc = mkSrcLoc (mkFastString file_path) 1 } of
-		  POk _  (PIface iface) ->
-		      warnCheckRn (wanted_mod == read_mod)
-		    		  (hiModuleNameMismatchWarn wanted_mod read_mod) `thenRn_`
-		      returnRn (Right (wanted_mod, iface))
-		    where
-		      read_mod = pi_mod iface
-
+		  POk _  (PIface iface) -> returnRn (Right iface)
 		  PFailed err   -> bale_out err
 	          parse_result 	-> bale_out empty
 		 	-- This last case can happen if the interface file is (say) empty

ghc/compiler/rename/RnIfaces.lhs

@@ -18,7 +18,7 @@ where
 
 #include "HsVersions.h"
 
-import CmdLineOpts	( DynFlags, opt_NoPruneDecls, opt_NoPruneTyDecls, opt_IgnoreIfacePragmas )
+import CmdLineOpts	( opt_IgnoreIfacePragmas )
 import HscTypes
 import HsSyn		( HsDecl(..), Sig(..), TyClDecl(..), ConDecl(..), ConDetails(..),
 			  InstDecl(..), HsType(..), hsTyVarNames, getBangType
@@ -785,12 +785,12 @@ type RecompileRequired = Bool
 upToDate  = False	-- Recompile not required
 outOfDate = True	-- Recompile required
 
-recompileRequired :: Module 
+recompileRequired :: FilePath		-- Only needed for debug msgs
 		  -> Bool 		-- Source unchanged
 		  -> Maybe ModIface 	-- Old interface, if any
 		  -> RnMG RecompileRequired
-recompileRequired mod source_unchanged maybe_iface
-  = traceRn (text "Considering whether compilation is required for" <+> ppr mod <> colon)	`thenRn_`
+recompileRequired iface_path source_unchanged maybe_iface
+  = traceRn (text "Considering whether compilation is required for" <+> text iface_path <> colon)	`thenRn_`
 
 	-- CHECK WHETHER THE SOURCE HAS CHANGED
     if not source_unchanged then