Enumerate imports and remove dead code.

[ghc-hetmet.git] / ghc / compiler / main / GetImports.hs

diff --git a/ghc/compiler/main/GetImports.hs b/ghc/compiler/main/GetImports.hs
index deeef72..6ccb8be 100644 (file)
--- a/ghc/compiler/main/GetImports.hs
+++ b/ghc/compiler/main/GetImports.hs
@@ -1,85 +1,65 @@
 -----------------------------------------------------------------------------
--- $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
+module GetImports ( getImportsFromFile, getImports ) where
 
-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)
+#include "HsVersions.h"
 
--- 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 [] = []
+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