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 )
  21 import FastString       ( mkFastString )
  22 import CmdLineOpts      ( 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 -> IO ([Module], [Module], Module)
  36 getImportsFromFile dflags filename = do
  37   buf <- hGetStringBuffer filename
  38   getImports dflags buf filename
  39
  40 getImports :: DynFlags -> StringBuffer -> FilePath -> IO ([Module], [Module], Module)
  41 getImports dflags buf filename = do
  42   let loc  = mkSrcLoc (mkFastString filename) 1 0
  43   case unP parseHeader (mkPState buf loc dflags) of
  44         PFailed span err -> parseError span err
  45         POk _ rdr_module ->
  46           case rdr_module of
  47             L _ (HsModule mod _ imps _ _) ->
  48               let
  49                 mod_name | Just (L _ m) <- mod = m
  50                          | otherwise           = mkModule "Main"
  51                 (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps)
  52                 source_imps   = map getImpMod src_idecls
  53                 ordinary_imps = filter (/= gHC_PRIM) (map getImpMod ord_idecls)
  54                      -- GHC.Prim doesn't exist physically, so don't go looking for it.
  55               in
  56               return (source_imps, ordinary_imps, mod_name)
  57
  58 parseError span err = throwDyn (ProgramError err_doc)
  59   where err_doc = render (pprBagOfErrors (unitBag (mkPlainErrMsg span err)))
  60
  61 isSourceIdecl (ImportDecl _ s _ _ _) = s
  62
  63 getImpMod (ImportDecl (L _ mod) _ _ _ _) = mod