-----------------------------------------------------------------------------
--- $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
--
--
-----------------------------------------------------------------------------
-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.
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
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
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