X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FGetImports.hs;h=249e1e14f111cb2c604df47c79f696932c430d8f;hb=ef5b4b146aa172d8ac10f39b5eb3d7a0f948d8f1;hp=28ccda8206cb578e869903eab40497ee929e7c6e;hpb=cc3e39d1870e93924325f93a9e6cfb701f50b3d9;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/GetImports.hs b/ghc/compiler/main/GetImports.hs
index 28ccda8..249e1e1 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.11 2004/11/26 16:20:57 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -7,18 +7,31 @@
 --
 -----------------------------------------------------------------------------
 
-module GetImports ( getImports ) where
+module GetImports ( getImportsFromFile, getImports ) where
 
 import Module
+
+import IO
 import List
 import Char
 
-
-getImports :: String -> ([ModuleName], [ModuleName], ModuleName)
+-- 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 ([Module], [Module], Module)
+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 -> ([Module], [Module], Module)
 getImports s
    = case f [{-accum source imports-}] [{-accum normal imports-}] 
           Nothing (clean s) of
-        (si, ni, Nothing) -> (si, ni, mkModuleName "Main")
+        (si, ni, Nothing) -> (si, ni, mkModule "Main")
         (si, ni, Just me) -> (si, ni, me)
      where
         -- Only pick up the name following 'module' the first time.
@@ -46,8 +59,8 @@ getImports s
         f si ni me (w:ws) = f si ni me ws
         f si ni me [] = (nub si, nub ni, me)
 
-        mkMN str = mkModuleName (takeWhile isModId (reverse str))
-        isModId c = isAlphaNum c || c `elem` "'_"
+        mkMN str = mkModule (takeWhile isModId (reverse str))
+        isModId c = isAlphaNum c || c `elem` "'._"
 
 
 -- remove literals and comments from a string, producing a 
@@ -69,7 +82,11 @@ clean s
         keep acc ('\'':cs)            = cons acc (squote cs)
         keep acc ('-':'-':cs)         = cons acc (linecomment cs)
         keep acc ('{':'-':'#':' ':cs) = cons acc (cons "#-{" (keep "" cs))
-        keep acc ('{':'-':cs)         = cons acc (runcomment cs)	-- -}
+        keep acc ('{':'-':cs)         = cons acc (runcomment (0::Int) cs)	-- -}
+	keep acc ('{':cs)             = cons acc (keep "" cs)
+	keep acc (';':cs)             = cons acc (keep "" cs)
+             -- treat ';' and '{' as word separators so that stuff
+	     -- like "{import A;" and ";;;;import B;" are handled correctly.
         keep acc (c:cs)               = keep (c:acc) cs
 
         cons [] xs = xs
@@ -95,6 +112,9 @@ clean s
         linecomment (c:cs)    = linecomment cs
 
         -- in a running comment
-        runcomment []           = []
-        runcomment ('-':'}':cs) = keep "" cs
-        runcomment (c:cs)       = runcomment cs
+        runcomment _ []           = []
+	runcomment n ('{':'-':cs) = runcomment (n+1) cs -- catches both nested comments and pragmas.
+        runcomment n ('-':'}':cs) 
+	  | n == 0    = keep "" cs
+	  | otherwise = runcomment (n-1) cs
+        runcomment n (c:cs)       = runcomment n cs