e60cb25ddb6b5995aff2f6d88f5fa8228fc6ea43
[ghc-hetmet.git] / ghc / compiler / main / GetImports.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Parsing the top of a Haskell source file to get its module name
4 -- and imports.
5 --
6 -- (c) Simon Marlow 2005
7 --
8 -----------------------------------------------------------------------------
9
10 module GetImports ( getImportsFromFile, getImports ) where
11
12 #include "HsVersions.h"
13
14 import Parser           ( parseHeader )
15 import Lexer            ( P(..), ParseResult(..), mkPState )
16 import HsSyn            ( ImportDecl(..), HsModule(..) )
17 import Module           ( Module, mkModule )
18 import StringBuffer     ( StringBuffer, hGetStringBuffer )
19 import SrcLoc           ( Located(..), mkSrcLoc, unLoc )
20 import FastString       ( mkFastString )
21 import CmdLineOpts      ( DynFlags )
22 import ErrUtils
23 import Pretty
24 import Panic
25 import Bag              ( unitBag )
26
27 import EXCEPTION        ( throwDyn )
28 import IO
29 import List
30
31 -- getImportsFromFile is careful to close the file afterwards, otherwise
32 -- we can end up with a large number of open handles before the garbage
33 -- collector gets around to closing them.
34 getImportsFromFile :: DynFlags -> FilePath -> IO ([Module], [Module], Module)
35 getImportsFromFile dflags filename = do
36   buf <- hGetStringBuffer filename
37   getImports dflags buf filename
38
39 getImports :: DynFlags -> StringBuffer -> FilePath -> IO ([Module], [Module], Module)
40 getImports dflags buf filename = do
41   let loc  = mkSrcLoc (mkFastString filename) 1 0
42   case unP parseHeader (mkPState buf loc dflags) of
43         PFailed span err -> parseError span err
44         POk _ rdr_module -> 
45           case rdr_module of
46             L _ (HsModule mod _ imps _ _) ->
47               let
48                 mod_name | Just (L _ m) <- mod = m
49                          | otherwise           = mkModule "Main"
50                 (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps)
51                 source_imps   = map getImpMod src_idecls        
52                 ordinary_imps = map getImpMod ord_idecls        
53               in
54               return (source_imps, ordinary_imps, mod_name)
55   
56 parseError span err = throwDyn (ProgramError err_doc)
57   where err_doc = render (pprBagOfErrors (unitBag (mkPlainErrMsg span err)))
58
59 isSourceIdecl (ImportDecl _ s _ _ _) = s
60
61 getImpMod (ImportDecl (L _ mod) _ _ _ _) = mod