X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FGetImports.hs;h=6ccb8bed7a8bc9fb9666893b3cb2895714655af9;hb=be8b6cd519e181e2553ee48ef4a82b8d56a4e9b6;hp=8d4be5e61e2720fd82563c0f86a6dc747ce87b4e;hpb=c7955cf7e34273b5ec624dae0015cec677624c6c;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/GetImports.hs b/ghc/compiler/main/GetImports.hs
index 8d4be5e..6ccb8be 100644
--- a/ghc/compiler/main/GetImports.hs
+++ b/ghc/compiler/main/GetImports.hs
@@ -1,77 +1,65 @@
 -----------------------------------------------------------------------------
--- $Id: GetImports.hs,v 1.3 2000/11/20 11:39:57 sewardj Exp $
 --
--- GHC Driver program
+-- Parsing the top of a Haskell source file to get its module name
+-- and imports.
 --
--- (c) Simon Marlow 2000
+-- (c) Simon Marlow 2005
 --
 -----------------------------------------------------------------------------
 
-module GetImports ( getImports ) where
+module GetImports ( getImportsFromFile, getImports ) where
 
-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))
-     where
-        f si ni _  ("module" : me : ws) = f si ni (mkMN me) ws
+#include "HsVersions.h"
 
-	f si ni me ("foreign" : "import" : ws) = f si ni me ws
-        f si ni me ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws) 
-           = f ((mkMN m):si) ni me ws
-        f si ni me ("import" : "{-#" : "SOURCE" : "#-}" : m : ws) 
-           = f ((mkMN m):si) ni me ws
-        f si ni me ("import" : "qualified" : m : ws) 
-           = f si ((mkMN m):ni) me ws
-        f si ni me ("import" : 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)
+import Parser		( parseHeader )
+import Lexer		( P(..), ParseResult(..), mkPState )
+import HsSyn		( ImportDecl(..), HsModule(..) )
+import Module		( Module, mkModule )
+import PrelNames        ( gHC_PRIM )
+import StringBuffer	( StringBuffer, hGetStringBuffer )
+import SrcLoc		( Located(..), mkSrcLoc, unLoc, noSrcSpan )
+import FastString	( mkFastString )
+import DynFlags	( DynFlags )
+import ErrUtils
+import Pretty
+import Panic
+import Bag		( unitBag )
 
-        mkMN str = mkModuleName (takeWhile isModId str)
-        isModId c = isAlphaNum c || c `elem` "'_"
-
--- remove literals and comments from a string
-clean :: String -> String
-clean 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
+import EXCEPTION	( throwDyn )
+import IO
+import List
 
-        -- in a double-quoted string
-        dquote []             = []
-        dquote ('\\':'\"':cs) = dquote cs		-- "
-        dquote ('\\':'\\':cs) = dquote cs
-        dquote ('\"':cs)      = keep cs			-- "
-        dquote (c:cs)         = dquote cs
+-- 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 :: DynFlags -> FilePath
+   -> IO ([Located Module], [Located Module], Located Module)
+getImportsFromFile dflags filename = do
+  buf <- hGetStringBuffer filename
+  getImports dflags buf filename
 
-        -- in a single-quoted string
-        squote []             = []
-        squote ('\\':'\'':cs) = squote cs
-        squote ('\\':'\\':cs) = squote cs
-        squote ('\'':cs)      = keep cs
-        squote (c:cs)         = squote cs
+getImports :: DynFlags -> StringBuffer -> FilePath
+    -> IO ([Located Module], [Located Module], Located Module)
+getImports dflags buf filename = do
+  let loc  = mkSrcLoc (mkFastString filename) 1 0
+  case unP parseHeader (mkPState buf loc dflags) of
+	PFailed span err -> parseError span err
+	POk _ rdr_module -> 
+	  case rdr_module of
+	    L _ (HsModule mod _ imps _ _) ->
+	      let
+		mod_name | Just located_mod <- mod = located_mod
+			 | otherwise               = L noSrcSpan (mkModule "Main")
+	        (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps)
+		source_imps   = map getImpMod src_idecls	
+		ordinary_imps = filter ((/= gHC_PRIM) . unLoc) 
+					(map getImpMod ord_idecls)
+		     -- GHC.Prim doesn't exist physically, so don't go looking for it.
+	      in
+	      return (source_imps, ordinary_imps, mod_name)
+  
+parseError span err = throwDyn $ mkPlainErrMsg span err
 
-        -- in a line comment
-        linecomment []        = []
-        linecomment ('\n':cs) = '\n':keep cs
-        linecomment (c:cs)    = linecomment cs
+isSourceIdecl (ImportDecl _ s _ _ _) = s
 
-        -- in a running comment
-        runcomment []           = []
-        runcomment ('-':'}':cs) = keep cs
-        runcomment (c:cs)       = runcomment cs
+getImpMod (ImportDecl located_mod _ _ _ _) = located_mod