X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FGetImports.hs;h=74dd9519bada1a54b33482e798289e685ecef155;hb=dcf6daa80768154d11c8853af7b52fc51fba4742;hp=deeef72b77ee0bfe0603d9d28520ba5bb6697f82;hpb=f212eb91f4286baf6d67f95b37e61ddd0c5e06e1;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/GetImports.hs b/ghc/compiler/main/GetImports.hs
index deeef72..74dd951 100644
--- a/ghc/compiler/main/GetImports.hs
+++ b/ghc/compiler/main/GetImports.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: GetImports.hs,v 1.1 2000/11/16 15:57:05 simonmar Exp $
+-- $Id: GetImports.hs,v 1.4 2000/11/20 15:54:27 sewardj Exp $
 --
 -- GHC Driver program
 --
@@ -13,73 +13,85 @@ import Module
 import List
 import Char
 
-getImports :: String -> ([ModuleName], [ModuleName])
-getImports str
-   = let all_imps = (nub . gmiBase . clean) str
-         srcs     = concatMap (either unit nil) all_imps
-         normals  = concatMap (either nil unit) all_imps
-         unit x   = [x]
-         nil x    = []
-     in  (srcs, normals)
-
--- really get the imports from a de-litted, cpp'd, de-literal'd string
--- Lefts are source imports.  Rights are normal ones.
-gmiBase :: String -> [Either ModuleName ModuleName]
-gmiBase s
-   = f (words s)
+
+getImports :: String -> ([ModuleName], [ModuleName], ModuleName)
+getImports 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 ("foreign" : "import" : ws) = f ws
-        f ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws) 
-           = Left (mkMN m) : f ws
-        f ("import" : "{-#" : "SOURCE" : "#-}" : m : ws) 
-           = Left (mkMN m) : f ws
-        f ("import" : "qualified" : m : ws) 
-           = Right (mkMN m) : f ws
-        f ("import" : m : ws) 
-           = Right (mkMN m) : f ws
-        f (w:ws) = f ws
-        f [] = []
-
-        mkMN str = mkModuleName (takeWhile isModId str)
+        -- 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 ("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 ("tropmi" : "#-{" : "ECRUOS" : "}-#" : m : ws) 
+           = f ((mkMN m):si) ni me ws
+        f si ni me ("tropmi" : "deifilauq" : m : ws) 
+           = f si ((mkMN m):ni) me 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 (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)		-- "
+
+	-- try to eliminate single quotes when they're part of
+	-- an identifier...
+	keep acc (c:'\'':cs) 
+           | isAlphaNum c || c == '_' = keep 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 (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 ('-':'}':cs) = keep "" cs
         runcomment (c:cs)       = runcomment cs