From 4adc89ca6a497c9b2a9028ee2a62be2491d52f09 Mon Sep 17 00:00:00 2001
From: sewardj <unknown>
Date: Mon, 20 Nov 2000 15:54:27 +0000
Subject: [PATCH] [project @ 2000-11-20 15:54:27 by sewardj] Summarise and
 mkDependHS faster, by doing fewer passes over the module's
 text.

---
 ghc/compiler/main/GetImports.hs |   74 +++++++++++++++++++++++++--------------
 1 file changed, 47 insertions(+), 27 deletions(-)

diff --git a/ghc/compiler/main/GetImports.hs b/ghc/compiler/main/GetImports.hs
index 8d4be5e..74dd951 100644
--- a/ghc/compiler/main/GetImports.hs
+++ b/ghc/compiler/main/GetImports.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: GetImports.hs,v 1.3 2000/11/20 11:39:57 sewardj Exp $
+-- $Id: GetImports.hs,v 1.4 2000/11/20 15:54:27 sewardj Exp $
 --
 -- GHC Driver program
 --
@@ -13,65 +13,85 @@ import Module
 import List
 import Char
 
+
 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 (mkMN 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) 
+        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)
+        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
-- 
1.7.10.4