From: simonmar <unknown>
Date: Tue, 1 May 2001 16:01:06 +0000 (+0000)
Subject: [project @ 2001-05-01 16:01:06 by simonmar]
X-Git-Tag: Approximately_9120_patches~2036
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=2e49eae1455516ad4a9fe9a88c6589fa3e22a529;hp=8077fb66f62fe6a5dfcb992f1b646c89c54cb91f;p=ghc-hetmet.git

[project @ 2001-05-01 16:01:06 by simonmar]
Close files eagerly after analysing their imports.
---

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index 15fabc0..a571fa7 100644
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -1015,14 +1015,13 @@ downsweep rootNm old_summaries
 summariseFile :: FilePath -> IO ModSummary
 summariseFile file
    = do hspp_fn <- preprocess file
-        modsrc <- readFile hspp_fn
+        (srcimps,imps,mod_name) <- getImportsFromFile hspp_fn
 
-        let (srcimps,imps,mod_name) = getImports modsrc
-	    (path, basename, ext) = splitFilename3 file
+        let (path, basename, ext) = splitFilename3 file
 
 	Just (mod, location)
 	   <- mkHomeModuleLocn mod_name (path ++ '/':basename) file
-	   
+
         src_timestamp
            <- case ml_hs_file location of 
                  Nothing     -> noHsFileErr mod_name
@@ -1050,12 +1049,11 @@ summarise mod location old_summary
 	   _ -> do
 
         hspp_fn <- preprocess hs_fn
-        modsrc <- readFile hspp_fn
-        let (srcimps,imps,mod_name) = getImports modsrc
+        (srcimps,imps,mod_name) <- getImportsFromFile hspp_fn
 
 	when (mod_name /= moduleName mod) $
 		throwDyn (ProgramError 
-		   (showSDoc (text modsrc
+		   (showSDoc (text hs_fn
 			      <>  text ": file name does not match module name"
 			      <+> quotes (ppr (moduleName mod)))))
 
diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index e4f9faf..4e70ec4 100644
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.64 2001/04/05 09:17:15 simonmar Exp $
+-- $Id: DriverPipeline.hs,v 1.65 2001/05/01 16:01:06 simonmar Exp $
 --
 -- GHC Driver
 --
@@ -482,8 +482,7 @@ run_phase Hsc basename suff input_fn output_fn
 				  else return False
 
 	 -- build a ModuleLocation to pass to hscMain.
-        modsrc <- readFile input_fn
-        let (srcimps,imps,mod_name) = getImports modsrc
+        (srcimps,imps,mod_name) <- getImportsFromFile input_fn
 
 	Just (mod, location)
 	   <- mkHomeModuleLocn mod_name basename (basename ++ '.':suff)
diff --git a/ghc/compiler/main/GetImports.hs b/ghc/compiler/main/GetImports.hs
index 28ccda8..ecb7766 100644
--- a/ghc/compiler/main/GetImports.hs
+++ b/ghc/compiler/main/GetImports.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: GetImports.hs,v 1.5 2001/04/20 10:42:46 sewardj Exp $
+-- $Id: GetImports.hs,v 1.6 2001/05/01 16:01:06 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -7,12 +7,25 @@
 --
 -----------------------------------------------------------------------------
 
-module GetImports ( getImports ) where
+module GetImports ( getImportsFromFile, getImports ) where
 
 import Module
+
+import IO
 import List
 import Char
 
+-- getImportsFromFile is careful to close the file afterwards, otherwise
+-- we can end up with a large number of open handles before the garbage
+-- collector gets around to closing them.
+getImportsFromFile :: String -> IO ([ModuleName], [ModuleName], ModuleName)
+getImportsFromFile filename
+  = do  hdl <- openFile filename ReadMode
+        modsrc <- hGetContents hdl
+        let (srcimps,imps,mod_name) = getImports modsrc
+	length srcimps `seq` length imps `seq` return ()
+	hClose hdl
+	return (srcimps,imps,mod_name)
 
 getImports :: String -> ([ModuleName], [ModuleName], ModuleName)
 getImports s