-----------------------------------------------------------------------------
--- $Id: GetImports.hs,v 1.2 2000/11/17 13:33:17 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 (mkModuleName 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