[project @ 2003-07-23 13:08:55 by simonpj]

[ghc-hetmet.git] / ghc / compiler / main / GetImports.hs

diff --git a/ghc/compiler/main/GetImports.hs b/ghc/compiler/main/GetImports.hs
index 74dd951..57ded51 100644 (file)
--- a/ghc/compiler/main/GetImports.hs
+++ b/ghc/compiler/main/GetImports.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: GetImports.hs,v 1.4 2000/11/20 15:54:27 sewardj Exp $
+-- $Id: GetImports.hs,v 1.10 2002/09/13 15:02:34 simonpj 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
@@ -34,6 +47,11 @@ getImports s
            = f ((mkMN m):si) ni me ws
         f si ni me ("tropmi" : "#-{" : "ECRUOS" : "}-#" : m : ws) 
            = f ((mkMN m):si) ni me ws
+
+        -- skip other contents of pragma comments
+        f si ni me ("#-{" : ws)
+           = f si ni me (drop 1 (dropWhile (/= "}-#") ws))
+
         f si ni me ("tropmi" : "deifilauq" : m : ws) 
            = f si ((mkMN m):ni) me ws
         f si ni me ("tropmi" : m : ws) 
@@ -42,7 +60,7 @@ getImports s
         f si ni me [] = (nub si, nub ni, me)
 
         mkMN str = mkModuleName (takeWhile isModId (reverse str))
-        isModId c = isAlphaNum c || c `elem` "'_"
+        isModId c = isAlphaNum c || c `elem` "'._"
 
 
 -- remove literals and comments from a string, producing a 
@@ -53,20 +71,22 @@ clean s
      where
         -- running through text we want to keep
         keep acc []                   = cons acc []
-        keep acc (c:cs) | isSpace c
-                        = cons acc (keep "" cs)
+        keep acc (c:cs) | isSpace c   = cons acc (keep "" cs)
 
         keep acc ('"':cs)             = cons acc (dquote cs)           -- "
 
-       -- try to eliminate single quotes when they're part of
-       -- an identifier...
+       -- don't be fooled by single quotes which are part of an identifier
        keep acc (c:'\'':cs) 
-           | isAlphaNum c || c == '_' = keep acc (c:cs)
+           | isAlphaNum c || c == '_' = keep ('\'':c:acc) (c:cs)
 
         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
@@ -92,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