<commit_before>-----------------------------------------------------------------------------
--
-- | Parsing the top of a Haskell source file to get its module name,
-- imports and options.
--
-- (c) <NAME> 2005
-- (c) Lemmih 2006
--
-----------------------------------------------------------------------------

module HeaderInfo ( getImports
                  , getOptionsFromFile, getOptions
                  , optionsErrorMsgs,
                    checkProcessArgsResult ) where

#include "HsVersions.h"

import RdrName
import HscTypes
import Parser		( parseHeader )
import Lexer
import FastString
import HsSyn		( ImportDecl(..), HsModule(..) )
import Module		( ModuleName, moduleName )
import PrelNames        ( gHC_PRIM, mAIN_NAME )
import StringBuffer
import SrcLoc
import DynFlags
import ErrUtils
import Util
import Outputable
import Pretty           ()
import Maybes
import Bag		( emptyBag, listToBag, unitBag )

import MonadUtils       ( MonadIO )
import Exception
import Control.Monad
import System.IO
import System.IO.Unsafe
import Data.List

------------------------------------------------------------------------------

-- | Parse the imports of a source file.
--
-- Throws a 'SourceError' if parsing fails.
getImports :: GhcMonad m =>
              DynFlags
           -> StringBuffer -- ^ Parse this.
           -> FilePath     -- ^ Filename the buffer came from.  Used for
                           --   reporting parse error locations.
           -> FilePath     -- ^ The original source filename (used for locations
                           --   in the function result)
           -> m ([Located (ImportDecl RdrName)], [Located (ImportDecl RdrName)], Located ModuleName)
              -- ^ The source imports, normal imports, and the module name.
getImports dflags buf filename source_filename = do
  let loc  = mkSrcLoc (mkFastString filename) 1 0
  case unP parseHeader (mkPState buf loc dflags) of
    PFailed span err -> parseError span err
    POk pst rdr_module -> do
      let ms@(warns, errs) = getMessages pst
      logWarnings warns
      if errorsFound dflags ms
        then liftIO $ throwIO $ mkSrcErr errs
        else
	  case rdr_module of
	    L _ (HsModule mb_mod _ imps _ _ _ _) ->
	      let
                main_loc = mkSrcLoc (mkFastString source_filename) 1 0
		mod = mb_mod `orElse` L (srcLocSpan main_loc) mAIN_NAME
	        (src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps
		ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc . ideclName . unLoc) 
					ord_idecls
		     -- GHC.Prim doesn't exist physically, so don't go looking for it.
	      in
	      return (src_idecls, ordinary_imps, mod)
  
parseError :: GhcMonad m => SrcSpan -> Message -> m a
parseError span err = throwOneError $ mkPlainErrMsg span err

--------------------------------------------------------------
-- Get options
--------------------------------------------------------------

-- | Parse OPTIONS and LANGUAGE pragmas of the source file.
--
-- Throws a 'SourceError' if flag parsing fails (including unsupported flags.)
getOptionsFromFile :: DynFlags
                   -> FilePath            -- ^ Input file
                   -> IO [Located String] -- ^ Parsed options, if any.
getOptionsFromFile dflags filename
    = Exception.bracket
	      (openBinaryFile filename ReadMode)
              (hClose)
              (\handle -> do
                  opts <- fmap getOptions' $ lazyGetToks dflags filename handle
                  seqList opts $ return opts)

blockSize :: Int
-- blockSize = 17 -- for testing :-)
blockSize = 1024

lazyGetToks :: DynFlags -> FilePath -> Handle -> IO [Located Token]
lazyGetToks dflags filename handle = do
  buf <- hGetStringBufferBlock handle blockSize
  unsafeInterleaveIO $ lazyLexBuf handle (pragState dflags buf loc) False
 where
  loc  = mkSrcLoc (mkFastString filename) 1 0

  lazyLexBuf :: Handle -> PState -> Bool -> IO [Located Token]
  lazyLexBuf handle state eof = do
    case unP (lexer return) state of
      POk state' t -> do
        -- pprTrace "lazyLexBuf" (text (show (buffer state'))) (return ())
        if atEnd (buffer state') && not eof
           -- if this token reached the end of the buffer, and we haven't
           -- necessarily read up to the end of the file, then the token might
           -- be truncated, so read some more of the file and lex it again.
           then getMore handle state
           else case t of
                  L _ ITeof -> return [t]
                  _other    -> do rest <- lazyLexBuf handle state' eof
                                  return (t : rest)
      _ | not eof   -> getMore handle state
        | otherwise -> return []
  
  getMore :: Handle -> PState -> IO [Located Token]
  getMore handle state = do
     -- pprTrace "getMore" (text (show (buffer state))) (return ())
     nextbuf <- hGetStringBufferBlock handle blockSize
     if (len nextbuf == 0) then lazyLexBuf handle state True else do
     newbuf <- appendStringBuffers (buffer state) nextbuf
     unsafeInterleaveIO $ lazyLexBuf handle state{buffer=newbuf} False


getToks :: DynFlags -> FilePath -> StringBuffer -> [Located Token]
getToks dflags filename buf = lexAll (pragState dflags buf loc)
 where
  loc  = mkSrcLoc (mkFastString filename) 1 0

  lexAll state = case unP (lexer return) state of
                   POk _      t@(L _ ITeof) -> [t]<commit_msg>FIX #3153: we lost an EOF sentinel in the event of a lexical error<commit_after>-----------------------------------------------------------------------------
--
-- | Parsing the top of a Haskell source file to get its module name,
-- imports and options.
--
-- (c) <NAME> 2005
-- (c) Lemmih 2006
--
-----------------------------------------------------------------------------

module HeaderInfo ( getImports
                  , getOptionsFromFile, getOptions
                  , optionsErrorMsgs,
                    checkProcessArgsResult ) where

#include "HsVersions.h"

import RdrName
import HscTypes
import Parser		( parseHeader )
import Lexer
import FastString
import HsSyn		( ImportDecl(..), HsModule(..) )
import Module		( ModuleName, moduleName )
import PrelNames        ( gHC_PRIM, mAIN_NAME )
import StringBuffer
import SrcLoc
import DynFlags
import ErrUtils
import Util
import Outputable
import Pretty           ()
import Maybes
import Bag		( emptyBag, listToBag, unitBag )

import MonadUtils       ( MonadIO )
import Exception
import Control.Monad
import System.IO
import System.IO.Unsafe
import Data.List

------------------------------------------------------------------------------

-- | Parse the imports of a source file.
--
-- Throws a 'SourceError' if parsing fails.
getImports :: GhcMonad m =>
              DynFlags
           -> StringBuffer -- ^ Parse this.
           -> FilePath     -- ^ Filename the buffer came from.  Used for
                           --   reporting parse error locations.
           -> FilePath     -- ^ The original source filename (used for locations
                           --   in the function result)
           -> m ([Located (ImportDecl RdrName)], [Located (ImportDecl RdrName)], Located ModuleName)
              -- ^ The source imports, normal imports, and the module name.
getImports dflags buf filename source_filename = do
  let loc  = mkSrcLoc (mkFastString filename) 1 0
  case unP parseHeader (mkPState buf loc dflags) of
    PFailed span err -> parseError span err
    POk pst rdr_module -> do
      let ms@(warns, errs) = getMessages pst
      logWarnings warns
      if errorsFound dflags ms
        then liftIO $ throwIO $ mkSrcErr errs
        else
	  case rdr_module of
	    L _ (HsModule mb_mod _ imps _ _ _ _) ->
	      let
                main_loc = mkSrcLoc (mkFastString source_filename) 1 0
		mod = mb_mod `orElse` L (srcLocSpan main_loc) mAIN_NAME
	        (src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps
		ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc . ideclName . unLoc) 
					ord_idecls
		     -- GHC.Prim doesn't exist physically, so don't go looking for it.
	      in
	      return (src_idecls, ordinary_imps, mod)
  
parseError :: GhcMonad m => SrcSpan -> Message -> m a
parseError span err = throwOneError $ mkPlainErrMsg span err

--------------------------------------------------------------
-- Get options
--------------------------------------------------------------

-- | Parse OPTIONS and LANGUAGE pragmas of the source file.
--
-- Throws a 'SourceError' if flag parsing fails (including unsupported flags.)
getOptionsFromFile :: DynFlags
                   -> FilePath            -- ^ Input file
                   -> IO [Located String] -- ^ Parsed options, if any.
getOptionsFromFile dflags filename
    = Exception.bracket
	      (openBinaryFile filename ReadMode)
              (hClose)
              (\handle -> do
                  opts <- fmap getOptions' $ lazyGetToks dflags filename handle
                  seqList opts $ return opts)

blockSize :: Int
-- blockSize = 17 -- for testing :-)
blockSize = 1024

lazyGetToks :: DynFlags -> FilePath -> Handle -> IO [Located Token]
lazyGetToks dflags filename handle = do
  buf <- hGetStringBufferBlock handle blockSize
  unsafeInterleaveIO $ lazyLexBuf handle (pragState dflags buf loc) False
 where
  loc  = mkSrcLoc (mkFastString filename) 1 0

  lazyLexBuf :: Handle -> PState -> Bool -> IO [Located Token]
  lazyLexBuf handle state eof = do
    case unP (lexer return) state of
      POk state' t -> do
        -- pprTrace "lazyLexBuf" (text (show (buffer state'))) (return ())
        if atEnd (buffer state') && not eof
           -- if this token reached the end of the buffer, and we haven't
           -- necessarily read up to the end of the file, then the token might
           -- be truncated, so read some more of the file and lex it again.
           then getMore handle state
           else case t of
                  L _ ITeof -> return [t]
                  _other    -> do rest <- lazyLexBuf handle state' eof
                                  return (t : rest)
      _ | not eof   -> getMore handle state
        | otherwise -> return [L (last_loc state) ITeof]
                         -- parser assumes an ITeof sentinel at the end

  getMore :: Handle -> PState -> IO [Located Token]
  getMore handle state = do
     -- pprTrace "getMore" (text (show (buffer state))) (return ())
     nextbuf <- hGetStringBufferBlock handle blockSize
     if (len nextbuf == 0) then lazyLexBuf handle state True else do
     newbuf <- appendStringBuffers (buffer state) nextbuf
     unsafeInterleaveIO $ lazyLexBuf handle state{buffer=newbuf} False


getToks :: DynFlags -> FilePath -> StringBuffer -> [Located Token]
getToks dflags filename buf = lexAll (pragState dflags buf loc)
 where
  loc  = mkSrcLoc (mkFastString filename) 1 0

  lexAll state = case unP (lexer return) state of
                   POk _      t@(L _ ITeof) -> [t]
{'fraction_non_alphanumeric': 0.13943674892211724, 'fraction_numerical': 0.004586735161911751, 'mean_word_length': 1.844247325854422, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 67, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4092109', 'n_tokens_mistral': 3089, 'n_tokens_neox': 2897, 'n_words': 1092}