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 PrelNames        ( gHC_PRIM )
  19 import StringBuffer     ( StringBuffer, hGetStringBuffer )
  20 import SrcLoc           ( Located(..), mkSrcLoc, unLoc, noSrcSpan )
  21 import FastString       ( mkFastString )
  22 import DynFlags ( DynFlags )
  23 import ErrUtils
  24 import Pretty
  25 import Panic
  26 import Bag              ( unitBag )
  27
  28 import EXCEPTION        ( throwDyn )
  29 import IO
  30 import List
  31
  32 -- getImportsFromFile is careful to close the file afterwards, otherwise
  33 -- we can end up with a large number of open handles before the garbage
  34 -- collector gets around to closing them.
  35 getImportsFromFile :: DynFlags -> FilePath
  36    -> IO ([Located Module], [Located Module], Located Module)
  37 getImportsFromFile dflags filename = do
  38   buf <- hGetStringBuffer filename
  39   getImports dflags buf filename
  40
  41 getImports :: DynFlags -> StringBuffer -> FilePath
  42     -> IO ([Located Module], [Located Module], Located Module)
  43 getImports dflags buf filename = do
  44   let loc  = mkSrcLoc (mkFastString filename) 1 0
  45   case unP parseHeader (mkPState buf loc dflags) of
  46         PFailed span err -> parseError span err
  47         POk _ rdr_module ->
  48           case rdr_module of
  49             L _ (HsModule mod _ imps _ _) ->
  50               let
  51                 mod_name | Just located_mod <- mod = located_mod
  52                          | otherwise               = L noSrcSpan (mkModule "Main")
  53                 (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps)
  54                 source_imps   = map getImpMod src_idecls
  55                 ordinary_imps = filter ((/= gHC_PRIM) . unLoc)
  56                                         (map getImpMod ord_idecls)
  57                      -- GHC.Prim doesn't exist physically, so don't go looking for it.
  58               in
  59               return (source_imps, ordinary_imps, mod_name)
  60
  61 parseError span err = throwDyn $ mkPlainErrMsg span err
  62
  63 isSourceIdecl (ImportDecl _ s _ _ _) = s
  64
  65 getImpMod (ImportDecl located_mod _ _ _ _) = located_mod