-----------------------------------------------------------------------------
--- $Id: GetImports.hs,v 1.1 2000/11/16 15:57:05 simonmar 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
-
-import Module
+module GetImports ( getImportsFromFile, getImports ) where
+
+#include "HsVersions.h"
+
+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 )
+import FastString ( mkFastString )
+import CmdLineOpts ( DynFlags )
+import ErrUtils
+import Pretty
+import Panic
+import Bag ( unitBag )
+
+import EXCEPTION ( throwDyn )
+import IO
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)
- 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)
- 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
-
- -- in a double-quoted string
- dquote [] = []
- dquote ('\\':'\"':cs) = dquote cs -- "
- dquote ('\\':'\\':cs) = dquote 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 (c:cs) = squote cs
-
- -- in a line comment
- linecomment [] = []
- linecomment ('\n':cs) = '\n':keep cs
- linecomment (c:cs) = linecomment cs
- -- in a running comment
- runcomment [] = []
- runcomment ('-':'}':cs) = keep cs
- runcomment (c:cs) = runcomment 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 ([Module], [Module], Module)
+getImportsFromFile dflags filename = do
+ buf <- hGetStringBuffer filename
+ getImports dflags buf filename
+
+getImports :: DynFlags -> StringBuffer -> FilePath -> IO ([Module], [Module], 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 (L _ m) <- mod = m
+ | otherwise = mkModule "Main"
+ (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps)
+ source_imps = map getImpMod src_idecls
+ ordinary_imps = filter (/= gHC_PRIM) (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 (ProgramError err_doc)
+ where err_doc = render (pprBagOfErrors (unitBag (mkPlainErrMsg span err)))
+
+isSourceIdecl (ImportDecl _ s _ _ _) = s
+
+getImpMod (ImportDecl (L _ mod) _ _ _ _) = mod