X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FGetImports.hs;h=1488aa3cc0044b77cb17cd7e9318a0c3bf9afa82;hb=cc3d91e372a0bdc6e74a0e2a1fb1b27df3c636f0;hp=b3a3416eaf529c1992b504c752ebc65caefd2620;hpb=a5f9c20a13e80f10a36246f1b4dbdae0f1a93187;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/GetImports.hs b/ghc/compiler/main/GetImports.hs
index b3a3416..1488aa3 100644
--- a/ghc/compiler/main/GetImports.hs
+++ b/ghc/compiler/main/GetImports.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: GetImports.hs,v 1.2 2000/11/17 13:33:17 sewardj Exp $
+-- $Id: GetImports.hs,v 1.8 2001/06/27 11:11:03 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -7,71 +7,110 @@
 --
 -----------------------------------------------------------------------------
 
-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
-   = f [{-accum source imports-}] [{-accum normal imports-}] 
-       (mkModuleName "Main") (words (clean s))
+   = case f [{-accum source imports-}] [{-accum normal imports-}] 
+          Nothing (clean s) of
+        (si, ni, Nothing) -> (si, ni, mkModuleName "Main")
+        (si, ni, Just me) -> (si, ni, me)
      where
-        f si ni _  ("module" : me : ws) = f si ni (mkModuleName me) ws
+        -- Only pick up the name following 'module' the first time.
+        -- Otherwise, we would be fooled by 'module Me ( module Wrong )'
+        -- and conclude that the module name is Wrong instead of Me.
+        f si ni old_me  ("eludom" : me : ws) 
+           = case old_me of
+                Nothing -> f si ni (Just (mkMN me)) ws
+                Just _  -> f si ni old_me ws
 
-	f si ni me ("foreign" : "import" : ws) = f si ni me ws
-        f si ni me ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws) 
+	f si ni me ("ngierof" : "tropmi" : ws) = f si ni me ws
+        f si ni me ("tropmi" : "#-{" : "ECRUOS" : "}-#" : "deifilauq" : m : ws) 
            = f ((mkMN m):si) ni me ws
-        f si ni me ("import" : "{-#" : "SOURCE" : "#-}" : m : ws) 
+        f si ni me ("tropmi" : "#-{" : "ECRUOS" : "}-#" : m : ws) 
            = f ((mkMN m):si) ni me ws
-        f si ni me ("import" : "qualified" : m : 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 ("import" : m : ws) 
+        f si ni me ("tropmi" : m : ws) 
            = f si ((mkMN m):ni) me ws
         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 str)
-        isModId c = isAlphaNum c || c `elem` "'_"
+        mkMN str = mkModuleName (takeWhile isModId (reverse str))
+        isModId c = isAlphaNum c || c `elem` "'._"
+
 
--- remove literals and comments from a string
-clean :: String -> String
+-- remove literals and comments from a string, producing a 
+-- list of reversed words.
+clean :: String -> [String]
 clean s
-   = keep s
+   = keep "" s
      where
         -- running through text we want to keep
-        keep []                   = []
-        keep ('"':cs)             = dquote cs		-- "
-		-- try to eliminate single quotes when they're part of
-		-- an identifier...
-	keep (c:'\'':cs) | isAlphaNum c || c == '_' = keep (dropWhile (=='\'') cs)
-        keep ('\'':cs)            = squote cs
-        keep ('-':'-':cs)         = linecomment cs
-        keep ('{':'-':'#':' ':cs) = "{-# " ++ keep cs
-        keep ('{':'-':cs)         = runcomment cs	-- -}
-        keep (c:cs)               = c : keep cs
+        keep acc []                   = cons acc []
+        keep acc (c:cs) | isSpace c   = cons acc (keep "" cs)
+
+        keep acc ('"':cs)             = cons acc (dquote cs)		-- "
+
+	-- don't be fooled by single quotes which are part of an identifier
+	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 (0::Int) cs)	-- -}
+        keep acc (c:cs)               = keep (c:acc) cs
+
+        cons [] xs = xs
+        cons x  xs = x : xs
 
         -- in a double-quoted string
         dquote []             = []
         dquote ('\\':'\"':cs) = dquote cs		-- "
         dquote ('\\':'\\':cs) = dquote cs
-        dquote ('\"':cs)      = keep cs			-- "
+        dquote ('\"':cs)      = keep "" cs		-- "
         dquote (c:cs)         = dquote cs
 
         -- in a single-quoted string
         squote []             = []
         squote ('\\':'\'':cs) = squote cs
         squote ('\\':'\\':cs) = squote cs
-        squote ('\'':cs)      = keep cs
+        squote ('\'':cs)      = keep "" cs
         squote (c:cs)         = squote cs
 
         -- in a line comment
         linecomment []        = []
-        linecomment ('\n':cs) = '\n':keep cs
+        linecomment ('\n':cs) = keep "" cs
         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