{-| Common interface to various Fortran parsers.

Each parser exports various Happy-generated functions. All export a top-level
'ProgramFile' parser. Most also export intermediate parsers e.g. for
'Statement's and 'Expression's. Fixed form and free form parsers use different
lexing schemes. And, due to headaches with Fortran's syntax, we usually want to
enforce some post-parse transformations.

This module provides a common wrapper over all that functionality. Internal
combinators are exposed to assist in manually configuring parsers.
-}

module Language.Fortran.Parser
  (
  -- * Main parsers (ProgramFile, with transformation)
    byVer, byVerWithMods
  , f66, f77, f77e, f77l, f90, f95, f2003

  -- * Main parsers without post-parse transformation
  , f66NoTransform, f77NoTransform, f77eNoTransform, f77lNoTransform
    , f90NoTransform, f95NoTransform, f2003NoTransform

  -- * Other parsers
  , f90Expr
  , f77lIncludesNoTransform
  , byVerFromFilename

  -- ** Statement
  , byVerStmt
  , f66StmtNoTransform, f77StmtNoTransform, f77eStmtNoTransform
    , f77lStmtNoTransform, f90StmtNoTransform, f95StmtNoTransform
    , f2003StmtNoTransform

  -- * Various combinators
  , transformAs, defaultTransformation
  , Parser, ParseErrorSimple(..)
  , StateInit, ParserMaker, makeParser, makeParserFixed, makeParserFree
  , initParseStateFixed, initParseStateFree
  , initParseStateFixedExpr, initParseStateFreeExpr
  , parseUnsafe
  , collectTokensSafe, collectTokens
  , throwIOLeft

  -- * F77 with inlined includes
  -- $f77includes
  , f77lInlineIncludes
  ) where

import Language.Fortran.AST
import Language.Fortran.Parser.Monad

import qualified Language.Fortran.Parser.Fixed.Fortran66  as F66
import qualified Language.Fortran.Parser.Fixed.Fortran77  as F77
import qualified Language.Fortran.Parser.Free.Fortran90   as F90
import qualified Language.Fortran.Parser.Free.Fortran95   as F95
import qualified Language.Fortran.Parser.Free.Fortran2003 as F2003
import qualified Language.Fortran.Parser.Fixed.Lexer as Fixed
import qualified Language.Fortran.Parser.Free.Lexer  as Free
import Language.Fortran.Version
import Language.Fortran.Util.Position
import Language.Fortran.Util.ModFile
import Language.Fortran.Transformation.Monad
import qualified Language.Fortran.Transformation.Grouping                 as Trans
import qualified Language.Fortran.Transformation.Disambiguation.Function  as Trans
import qualified Language.Fortran.Transformation.Disambiguation.Intrinsic as Trans

import qualified Data.ByteString.Char8 as B
import Data.Data

import Control.Monad.State
import qualified Data.Map as Map
import           Data.Map ( Map )
import Data.Generics.Uniplate.Operations ( descendBiM )
import Control.Exception ( throwIO, Exception )
import System.FilePath ( (</>) )
import System.Directory ( doesFileExist )

-- | Our common Fortran parser type takes a filename and input, and returns
--   either a normalized error (tokens are printed) or an untransformed
--   'ProgramFile'.
type Parser a = String -> B.ByteString -> Either ParseErrorSimple a

-- Provides a way to aggregate errors that come
-- from parses with different token types
data ParseErrorSimple = ParseErrorSimple
  { ParseErrorSimple -> Position
errorPos      :: Position
  , ParseErrorSimple -> String
errorFilename :: String
  , ParseErrorSimple -> String
errorMsg      :: String
  } deriving anyclass (Show ParseErrorSimple
Typeable ParseErrorSimple
SomeException -> Maybe ParseErrorSimple
ParseErrorSimple -> String
ParseErrorSimple -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ParseErrorSimple -> String
$cdisplayException :: ParseErrorSimple -> String
fromException :: SomeException -> Maybe ParseErrorSimple
$cfromException :: SomeException -> Maybe ParseErrorSimple
toException :: ParseErrorSimple -> SomeException
$ctoException :: ParseErrorSimple -> SomeException
Exception)

instance Show ParseErrorSimple where
  show :: ParseErrorSimple -> String
show ParseErrorSimple
err = ParseErrorSimple -> String
errorFilename ParseErrorSimple
err forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ParseErrorSimple -> Position
errorPos ParseErrorSimple
err) forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ ParseErrorSimple -> String
errorMsg ParseErrorSimple
err

-- | May be used to lift parse results into IO and force unwrap.
throwIOLeft :: (Exception e, MonadIO m) => Either e a -> m a
throwIOLeft :: forall e (m :: * -> *) a.
(Exception e, MonadIO m) =>
Either e a -> m a
throwIOLeft = \case Right a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
                    Left  e
e -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO e
e

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

byVer :: FortranVersion -> Parser (ProgramFile A0)
byVer :: FortranVersion -> Parser (ProgramFile A0)
byVer = \case
  FortranVersion
Fortran66         -> Parser (ProgramFile A0)
f66
  FortranVersion
Fortran77         -> Parser (ProgramFile A0)
f77
  FortranVersion
Fortran77Extended -> Parser (ProgramFile A0)
f77e
  FortranVersion
Fortran77Legacy   -> Parser (ProgramFile A0)
f77l
  FortranVersion
Fortran90         -> Parser (ProgramFile A0)
f90
  FortranVersion
Fortran95         -> Parser (ProgramFile A0)
f95
  FortranVersion
Fortran2003       -> Parser (ProgramFile A0)
f2003
  FortranVersion
v                 -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$  String
"Language.Fortran.Parser.byVer: "
                             forall a. Semigroup a => a -> a -> a
<> String
"no parser available for requested version: "
                             forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show FortranVersion
v

byVerWithMods :: ModFiles -> FortranVersion -> Parser (ProgramFile A0)
byVerWithMods :: ModFiles -> FortranVersion -> Parser (ProgramFile A0)
byVerWithMods ModFiles
mods = \case
  FortranVersion
Fortran66         -> ModFiles -> Parser (ProgramFile A0)
f66Mods ModFiles
mods
  FortranVersion
Fortran77         -> ModFiles -> Parser (ProgramFile A0)
f77Mods ModFiles
mods
  FortranVersion
Fortran77Extended -> ModFiles -> Parser (ProgramFile A0)
f77eMods ModFiles
mods
  FortranVersion
Fortran77Legacy   -> ModFiles -> Parser (ProgramFile A0)
f77lMods ModFiles
mods
  FortranVersion
Fortran90         -> ModFiles -> Parser (ProgramFile A0)
f90Mods ModFiles
mods
  FortranVersion
Fortran95         -> ModFiles -> Parser (ProgramFile A0)
f95Mods ModFiles
mods
  FortranVersion
Fortran2003       -> ModFiles -> Parser (ProgramFile A0)
f2003Mods ModFiles
mods
  FortranVersion
v                 -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Language.Fortran.Parser.byVerWithMods: no parser available for requested version: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show FortranVersion
v

f66, f77, f77e, f77l, f90, f95, f2003 :: Parser (ProgramFile A0)
f66 :: Parser (ProgramFile A0)
f66   = ModFiles -> Parser (ProgramFile A0)
f66Mods   []
f77 :: Parser (ProgramFile A0)
f77   = ModFiles -> Parser (ProgramFile A0)
f77Mods   []
f77e :: Parser (ProgramFile A0)
f77e  = ModFiles -> Parser (ProgramFile A0)
f77eMods  []
f77l :: Parser (ProgramFile A0)
f77l  = ModFiles -> Parser (ProgramFile A0)
f77lMods  []
f90 :: Parser (ProgramFile A0)
f90   = ModFiles -> Parser (ProgramFile A0)
f90Mods   []
f95 :: Parser (ProgramFile A0)
f95   = ModFiles -> Parser (ProgramFile A0)
f95Mods   []
f2003 :: Parser (ProgramFile A0)
f2003 = ModFiles -> Parser (ProgramFile A0)
f2003Mods []

f66Mods, f77Mods, f77eMods, f77lMods, f90Mods, f95Mods, f2003Mods
    :: ModFiles -> Parser (ProgramFile A0)
f66Mods :: ModFiles -> Parser (ProgramFile A0)
f66Mods   = forall a.
Data a =>
FortranVersion
-> Parser (ProgramFile a) -> ModFiles -> Parser (ProgramFile a)
transformAs FortranVersion
Fortran66         Parser (ProgramFile A0)
f66NoTransform
f77Mods :: ModFiles -> Parser (ProgramFile A0)
f77Mods   = forall a.
Data a =>
FortranVersion
-> Parser (ProgramFile a) -> ModFiles -> Parser (ProgramFile a)
transformAs FortranVersion
Fortran77         Parser (ProgramFile A0)
f77NoTransform
f77eMods :: ModFiles -> Parser (ProgramFile A0)
f77eMods  = forall a.
Data a =>
FortranVersion
-> Parser (ProgramFile a) -> ModFiles -> Parser (ProgramFile a)
transformAs FortranVersion
Fortran77Extended Parser (ProgramFile A0)
f77eNoTransform
f77lMods :: ModFiles -> Parser (ProgramFile A0)
f77lMods  = forall a.
Data a =>
FortranVersion
-> Parser (ProgramFile a) -> ModFiles -> Parser (ProgramFile a)
transformAs FortranVersion
Fortran77Legacy   Parser (ProgramFile A0)
f77lNoTransform
f90Mods :: ModFiles -> Parser (ProgramFile A0)
f90Mods   = forall a.
Data a =>
FortranVersion
-> Parser (ProgramFile a) -> ModFiles -> Parser (ProgramFile a)
transformAs FortranVersion
Fortran90         Parser (ProgramFile A0)
f90NoTransform
f95Mods :: ModFiles -> Parser (ProgramFile A0)
f95Mods   = forall a.
Data a =>
FortranVersion
-> Parser (ProgramFile a) -> ModFiles -> Parser (ProgramFile a)
transformAs FortranVersion
Fortran95         Parser (ProgramFile A0)
f95NoTransform
f2003Mods :: ModFiles -> Parser (ProgramFile A0)
f2003Mods = forall a.
Data a =>
FortranVersion
-> Parser (ProgramFile a) -> ModFiles -> Parser (ProgramFile a)
transformAs FortranVersion
Fortran2003       Parser (ProgramFile A0)
f2003NoTransform

f66NoTransform, f77NoTransform, f77eNoTransform, f77lNoTransform,
  f90NoTransform, f95NoTransform, f2003NoTransform
    :: Parser (ProgramFile A0)
f66NoTransform :: Parser (ProgramFile A0)
f66NoTransform   = forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction (ProgramFile A0)
F66.programParser   FortranVersion
Fortran66
f77NoTransform :: Parser (ProgramFile A0)
f77NoTransform   = forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction (ProgramFile A0)
F77.programParser   FortranVersion
Fortran77
f77eNoTransform :: Parser (ProgramFile A0)
f77eNoTransform  = forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction (ProgramFile A0)
F77.programParser   FortranVersion
Fortran77Extended
f77lNoTransform :: Parser (ProgramFile A0)
f77lNoTransform  = forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction (ProgramFile A0)
F77.programParser   FortranVersion
Fortran77Legacy
f90NoTransform :: Parser (ProgramFile A0)
f90NoTransform   = forall a. ParserMaker AlexInput Token a
makeParserFree  LexAction (ProgramFile A0)
F90.programParser   FortranVersion
Fortran90
f95NoTransform :: Parser (ProgramFile A0)
f95NoTransform   = forall a. ParserMaker AlexInput Token a
makeParserFree  LexAction (ProgramFile A0)
F95.programParser   FortranVersion
Fortran95
f2003NoTransform :: Parser (ProgramFile A0)
f2003NoTransform = forall a. ParserMaker AlexInput Token a
makeParserFree  LexAction (ProgramFile A0)
F2003.programParser FortranVersion
Fortran2003

f66StmtNoTransform, f77StmtNoTransform, f77eStmtNoTransform, f77lStmtNoTransform,
  f90StmtNoTransform, f95StmtNoTransform, f2003StmtNoTransform
    :: Parser (Statement A0)
f66StmtNoTransform :: Parser (Statement A0)
f66StmtNoTransform   = forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction (Statement A0)
F66.statementParser   FortranVersion
Fortran66
f77StmtNoTransform :: Parser (Statement A0)
f77StmtNoTransform   = forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction (Statement A0)
F77.statementParser   FortranVersion
Fortran77
f77eStmtNoTransform :: Parser (Statement A0)
f77eStmtNoTransform  = forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction (Statement A0)
F77.statementParser   FortranVersion
Fortran77Extended
f77lStmtNoTransform :: Parser (Statement A0)
f77lStmtNoTransform  = forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction (Statement A0)
F77.statementParser   FortranVersion
Fortran77Legacy
f90StmtNoTransform :: Parser (Statement A0)
f90StmtNoTransform   = forall a. ParserMaker AlexInput Token a
makeParserFree  LexAction (Statement A0)
F90.statementParser   FortranVersion
Fortran90
f95StmtNoTransform :: Parser (Statement A0)
f95StmtNoTransform   = forall a. ParserMaker AlexInput Token a
makeParserFree  LexAction (Statement A0)
F95.statementParser   FortranVersion
Fortran95
f2003StmtNoTransform :: Parser (Statement A0)
f2003StmtNoTransform = forall a. ParserMaker AlexInput Token a
makeParserFree  LexAction (Statement A0)
F2003.statementParser FortranVersion
Fortran2003

byVerStmt :: FortranVersion -> Parser (Statement A0)
byVerStmt :: FortranVersion -> Parser (Statement A0)
byVerStmt = \case
  FortranVersion
Fortran66         -> Parser (Statement A0)
f66StmtNoTransform
  FortranVersion
Fortran77         -> Parser (Statement A0)
f77StmtNoTransform
  FortranVersion
Fortran77Extended -> Parser (Statement A0)
f77eStmtNoTransform
  FortranVersion
Fortran77Legacy   -> Parser (Statement A0)
f77lStmtNoTransform
  FortranVersion
Fortran90         -> Parser (Statement A0)
f90StmtNoTransform
  FortranVersion
Fortran95         -> Parser (Statement A0)
f95StmtNoTransform
  FortranVersion
Fortran2003       -> Parser (Statement A0)
f2003StmtNoTransform
  FortranVersion
v                 -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$  String
"Language.Fortran.Parser.byVerStmt: "
                             forall a. Semigroup a => a -> a -> a
<> String
"no parser available for requested version: "
                             forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show FortranVersion
v

f90Expr :: Parser (Expression A0)
f90Expr :: Parser (Expression A0)
f90Expr = forall ai tok a.
(Loc ai, LastToken ai tok, Show tok) =>
StateInit ai -> ParserMaker ai tok a
makeParser StateInit AlexInput
initParseStateFreeExpr LexAction (Expression A0)
F90.expressionParser FortranVersion
Fortran90

-- | Obtain a Fortran parser by assuming the version from the filename provided.
byVerFromFilename :: Parser (ProgramFile A0)
byVerFromFilename :: Parser (ProgramFile A0)
byVerFromFilename String
fn = FortranVersion -> Parser (ProgramFile A0)
byVer FortranVersion
v String
fn
  where v :: FortranVersion
v = String -> FortranVersion
deduceFortranVersion String
fn

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

transformAs
    :: Data a
    => FortranVersion -> Parser (ProgramFile a) -> ModFiles
    -> Parser (ProgramFile a)
transformAs :: forall a.
Data a =>
FortranVersion
-> Parser (ProgramFile a) -> ModFiles -> Parser (ProgramFile a)
transformAs FortranVersion
fv Parser (ProgramFile a)
p ModFiles
mods String
fn ByteString
bs = do
    ProgramFile a
pf <- Parser (ProgramFile a)
p String
fn ByteString
bs
    let pf' :: ProgramFile a
pf' = forall a. String -> ProgramFile a -> ProgramFile a
pfSetFilename String
fn ProgramFile a
pf
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ProgramFile a -> ProgramFile a
transform ProgramFile a
pf'
  where transform :: ProgramFile a -> ProgramFile a
transform = forall a.
Data a =>
TypeEnv
-> ModuleMap -> Transform a A0 -> ProgramFile a -> ProgramFile a
runTransform (ModFiles -> TypeEnv
combinedTypeEnv ModFiles
mods)
                                 (ModFiles -> ModuleMap
combinedModuleMap ModFiles
mods)
                                 (forall a. Data a => FortranVersion -> Transform a A0
defaultTransformation FortranVersion
fv)

-- | The default post-parse AST transformation for each Fortran version.
--
-- Formed by composing transformations end-to-end.
--
-- Note that some transformations are noncommutative e.g. labeled DO grouping
-- must be done before block DO grouping.
defaultTransformation :: Data a => FortranVersion -> Transform a ()
defaultTransformation :: forall a. Data a => FortranVersion -> Transform a A0
defaultTransformation = \case
  FortranVersion
Fortran66         -> forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m A0
sequence_ [ forall a. Data a => Transform a A0
Trans.groupLabeledDo
                                 , forall a. Data a => Transform a A0
Trans.disambiguateIntrinsic
                                 , forall a. Data a => Transform a A0
Trans.disambiguateFunction ]
  FortranVersion
Fortran77         -> forall a. Data a => FortranVersion -> Transform a A0
defaultTransformation FortranVersion
Fortran66
  FortranVersion
Fortran77Legacy   -> forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m A0
sequence_ [ forall a. Data a => Transform a A0
Trans.groupLabeledDo
                                 , forall a. Data a => Transform a A0
Trans.groupDo
                                 , forall a. Data a => Transform a A0
Trans.disambiguateIntrinsic
                                 , forall a. Data a => Transform a A0
Trans.disambiguateFunction ]
  FortranVersion
_ -> forall a. Data a => FortranVersion -> Transform a A0
defaultTransformation FortranVersion
Fortran77Legacy

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

type StateInit s = String -> FortranVersion -> B.ByteString -> ParseState s
type ParserMaker ai tok a = Parse ai tok a -> FortranVersion -> Parser a

makeParser
    :: (Loc ai, LastToken ai tok, Show tok)
    => StateInit ai -> ParserMaker ai tok a
makeParser :: forall ai tok a.
(Loc ai, LastToken ai tok, Show tok) =>
StateInit ai -> ParserMaker ai tok a
makeParser StateInit ai
fInitState Parse ai tok a
p FortranVersion
fv String
fn = forall c b a.
Show c =>
ParseResult b c a -> Either ParseErrorSimple a
fromParseResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c a.
(Loc b, LastToken b c, Show c) =>
Parse b c a -> ParseState b -> ParseResult b c a
runParse Parse ai tok a
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateInit ai
fInitState String
fn FortranVersion
fv

makeParserFixed :: ParserMaker Fixed.AlexInput Fixed.Token a
makeParserFixed :: forall a. ParserMaker AlexInput Token a
makeParserFixed = forall ai tok a.
(Loc ai, LastToken ai tok, Show tok) =>
StateInit ai -> ParserMaker ai tok a
makeParser StateInit AlexInput
initParseStateFixed

makeParserFree :: ParserMaker Free.AlexInput Free.Token a
makeParserFree :: forall a. ParserMaker AlexInput Token a
makeParserFree = forall ai tok a.
(Loc ai, LastToken ai tok, Show tok) =>
StateInit ai -> ParserMaker ai tok a
makeParser StateInit AlexInput
initParseStateFree

initParseStateFixed :: StateInit Fixed.AlexInput
initParseStateFixed :: StateInit AlexInput
initParseStateFixed String
fn FortranVersion
fv ByteString
bs = forall ai. String -> FortranVersion -> ai -> ParseState ai
initParseState String
fn FortranVersion
fv AlexInput
ai
  where ai :: AlexInput
ai = String -> FortranVersion -> ByteString -> AlexInput
Fixed.vanillaAlexInput String
fn FortranVersion
fv ByteString
bs

initParseStateFree :: StateInit Free.AlexInput
initParseStateFree :: StateInit AlexInput
initParseStateFree String
fn FortranVersion
fv ByteString
bs = forall ai. String -> FortranVersion -> ai -> ParseState ai
initParseState String
fn FortranVersion
fv AlexInput
ai
  where ai :: AlexInput
ai = String -> ByteString -> AlexInput
Free.vanillaAlexInput String
fn ByteString
bs

-- | Initialize free-form parser state with the lexer configured for standalone
--   expression parsing.
--
-- The free-form lexer needs a non-default start code for lexing standaloe
-- expressions.
initParseStateFreeExpr :: StateInit Free.AlexInput
initParseStateFreeExpr :: StateInit AlexInput
initParseStateFreeExpr String
fn FortranVersion
fv ByteString
bs = ParseState AlexInput
st
  { psAlexInput :: AlexInput
psAlexInput = AlexInput
ai { aiStartCode :: StartCode
Free.aiStartCode = Int -> StartCodeStatus -> StartCode
Free.StartCode Int
Free.scN StartCodeStatus
Free.Return } }
  where
    ai :: AlexInput
ai = String -> ByteString -> AlexInput
Free.vanillaAlexInput String
fn ByteString
bs
    st :: ParseState AlexInput
st = StateInit AlexInput
initParseStateFree String
fn FortranVersion
fv ByteString
bs

-- checked in generated file: 1=assn, 4=iif, 6=st
-- 6, 1, 4 seem best in order. Looks like 6 is correct.
-- TODO guesswork, relies on internal behaviour :/
initParseStateFixedExpr :: StateInit Fixed.AlexInput
initParseStateFixedExpr :: StateInit AlexInput
initParseStateFixedExpr String
fn FortranVersion
fv ByteString
bs = ParseState AlexInput
st
  { psAlexInput :: AlexInput
psAlexInput = AlexInput
ai { aiStartCode :: Int
Fixed.aiStartCode = Int
6
                     , aiWhiteSensitiveCharCount :: Int
Fixed.aiWhiteSensitiveCharCount = Int
0 } }
  where
    ai :: AlexInput
ai = String -> FortranVersion -> ByteString -> AlexInput
Fixed.vanillaAlexInput String
fn FortranVersion
fv ByteString
bs
    st :: ParseState AlexInput
st = StateInit AlexInput
initParseStateFixed String
fn FortranVersion
fv ByteString
bs

-- | Convenience wrapper to easily use a parser unsafely.
--
-- This throws a catchable runtime IO exception, which is used in the tests.
parseUnsafe :: Parser a -> B.ByteString -> a
parseUnsafe :: forall a. Parser a -> ByteString -> a
parseUnsafe Parser a
p ByteString
bs =
    case Parser a
p String
"<unknown>" ByteString
bs of
      Left ParseErrorSimple
err -> forall a. String -> a
throwIOError forall a b. (a -> b) -> a -> b
$  String
"Language.Fortran.Parser.parseUnsafe: "
                               forall a. Semigroup a => a -> a -> a
<> String
"parse error: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ParseErrorSimple
err
      Right a
a -> a
a

-- | Helper for preparing initial parser state for the different lexers.
initParseState :: FilePath -> FortranVersion -> ai -> ParseState ai
initParseState :: forall ai. String -> FortranVersion -> ai -> ParseState ai
initParseState String
fn FortranVersion
fv ai
ai = ParseState
  { psAlexInput :: ai
psAlexInput = ai
ai
  , psVersion :: FortranVersion
psVersion = FortranVersion
fv
  , psFilename :: String
psFilename = String
fn
  , psParanthesesCount :: ParanthesesCount
psParanthesesCount = Integer -> Bool -> ParanthesesCount
ParanthesesCount Integer
0 Bool
False
  , psContext :: [Context]
psContext = [ Context
ConStart ] }

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

{- $f77includes
The Fortran 77 parser can parse and inline includes at parse time. Parse errors
are thrown as IO exceptions.

Can be cleaned up and generalized to use for other parsers.
-}

f77lInlineIncludes
    :: [FilePath] -> ModFiles -> String -> B.ByteString
    -> IO (ProgramFile A0)
f77lInlineIncludes :: [String] -> ModFiles -> String -> ByteString -> IO (ProgramFile A0)
f77lInlineIncludes [String]
incs ModFiles
mods String
fn ByteString
bs = do
    case Parser (ProgramFile A0)
f77lNoTransform String
fn ByteString
bs of
      Left ParseErrorSimple
e -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO ParseErrorSimple
e
      Right ProgramFile A0
pf -> do
        let pf' :: ProgramFile A0
pf' = forall a. String -> ProgramFile a -> ProgramFile a
pfSetFilename String
fn ProgramFile A0
pf
        ProgramFile A0
pf'' <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall from to (m :: * -> *).
(Biplate from to, Applicative m) =>
(to -> m to) -> from -> m from
descendBiM ([String]
-> [String]
-> Statement A0
-> StateT (Map String [Block A0]) IO (Statement A0)
f77lInlineIncludes' [String]
incs []) ProgramFile A0
pf') forall k a. Map k a
Map.empty
        let pf''' :: ProgramFile A0
pf''' = forall a.
Data a =>
TypeEnv
-> ModuleMap -> Transform a A0 -> ProgramFile a -> ProgramFile a
runTransform (ModFiles -> TypeEnv
combinedTypeEnv ModFiles
mods)
                                 (ModFiles -> ModuleMap
combinedModuleMap ModFiles
mods)
                                 (forall a. Data a => FortranVersion -> Transform a A0
defaultTransformation FortranVersion
Fortran77Legacy)
                                 ProgramFile A0
pf''
        forall (m :: * -> *) a. Monad m => a -> m a
return ProgramFile A0
pf'''

f77lInlineIncludes'
    :: [FilePath] -> [FilePath] -> Statement A0
    -> StateT (Map String [Block A0]) IO (Statement A0)
f77lInlineIncludes' :: [String]
-> [String]
-> Statement A0
-> StateT (Map String [Block A0]) IO (Statement A0)
f77lInlineIncludes' [String]
dirs = [String]
-> Statement A0 -> StateT (Map String [Block A0]) IO (Statement A0)
go
  where
    go :: [String]
-> Statement A0 -> StateT (Map String [Block A0]) IO (Statement A0)
go [String]
seen Statement A0
st = case Statement A0
st of
      StInclude A0
a SrcSpan
s e :: Expression A0
e@(ExpValue A0
_ SrcSpan
_ (ValString String
path)) Maybe [Block A0]
Nothing -> do
        if forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem String
path [String]
seen then do
          Map String [Block A0]
incMap <- forall s (m :: * -> *). MonadState s m => m s
get
          case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
path Map String [Block A0]
incMap of
            Just [Block A0]
blocks' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
a -> SrcSpan -> Expression a -> Maybe [Block a] -> Statement a
StInclude A0
a SrcSpan
s Expression A0
e (forall a. a -> Maybe a
Just [Block A0]
blocks')
            Maybe [Block A0]
Nothing -> do
              (String
fullPath, ByteString
incBs) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO (String, ByteString)
readInDirs [String]
dirs String
path
              case Parser [Block A0]
f77lIncludesNoTransform String
fullPath ByteString
incBs of
                Right [Block A0]
blocks -> do
                  [Block A0]
blocks' <- forall from to (m :: * -> *).
(Biplate from to, Applicative m) =>
(to -> m to) -> from -> m from
descendBiM ([String]
-> Statement A0 -> StateT (Map String [Block A0]) IO (Statement A0)
go (String
pathforall a. a -> [a] -> [a]
:[String]
seen)) [Block A0]
blocks
                  forall s (m :: * -> *). MonadState s m => (s -> s) -> m A0
modify (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
path [Block A0]
blocks')
                  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
a -> SrcSpan -> Expression a -> Maybe [Block a] -> Statement a
StInclude A0
a SrcSpan
s Expression A0
e (forall a. a -> Maybe a
Just [Block A0]
blocks')
                Left ParseErrorSimple
err -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO ParseErrorSimple
err
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure Statement A0
st
      Statement A0
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Statement A0
st

f77lIncludesNoTransform :: Parser [Block A0]
f77lIncludesNoTransform :: Parser [Block A0]
f77lIncludesNoTransform = forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction [Block A0]
F77.includesParser FortranVersion
Fortran77Legacy

readInDirs :: [String] -> String -> IO (String, B.ByteString)
readInDirs :: [String] -> String -> IO (String, ByteString)
readInDirs [] String
f = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"cannot find file: " forall a. [a] -> [a] -> [a]
++ String
f
readInDirs (String
d:[String]
ds) String
f = do
  let path :: String
path = String
dString -> ShowS
</>String
f
  Bool
b <- String -> IO Bool
doesFileExist String
path
  if Bool
b then
    (String
path,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
B.readFile String
path
  else
    [String] -> String -> IO (String, ByteString)
readInDirs [String]
ds String
f

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

-------------------------------------------------------------------------------
-- Generic token collection and functions (inherited from ParserMonad)
-------------------------------------------------------------------------------

collectTokens
    :: forall a b
    .  (Loc b, Tok a, LastToken b a, Show a)
    => Parse b a a -> ParseState b -> [a]
collectTokens :: forall a b.
(Loc b, Tok a, LastToken b a, Show a) =>
Parse b a a -> ParseState b -> [a]
collectTokens Parse b a a
lexer ParseState b
initState =
    forall b c a.
(Loc b, LastToken b c, Show c) =>
Parse b c a -> ParseState b -> a
evalParse (ParseState b -> Parse b a [a]
_collectTokens ParseState b
initState) forall a. HasCallStack => a
undefined
  where
    _collectTokens :: ParseState b -> Parse b a [a]
    _collectTokens :: ParseState b -> Parse b a [a]
_collectTokens ParseState b
st = do
      let (a
_token, ParseState b
_st) = forall b c a.
(Loc b, LastToken b c, Show c) =>
Parse b c a -> ParseState b -> (a, ParseState b)
runParseUnsafe Parse b a a
lexer ParseState b
st
      if forall a. Tok a => a -> Bool
eofToken a
_token
      then forall (m :: * -> *) a. Monad m => a -> m a
return [a
_token]
      else do
        [a]
_tokens <- ParseState b -> Parse b a [a]
_collectTokens ParseState b
_st
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a
_tokenforall a. a -> [a] -> [a]
:[a]
_tokens

collectTokensSafe
    :: forall a b
    .  (Loc b, Tok a, LastToken b a, Show a)
    => Parse b a a -> ParseState b -> Maybe [a]
collectTokensSafe :: forall a b.
(Loc b, Tok a, LastToken b a, Show a) =>
Parse b a a -> ParseState b -> Maybe [a]
collectTokensSafe Parse b a a
lexer ParseState b
initState =
    forall b c a.
(Loc b, LastToken b c, Show c) =>
Parse b c a -> ParseState b -> a
evalParse (ParseState b -> Parse b a (Maybe [a])
_collectTokens ParseState b
initState) forall a. HasCallStack => a
undefined
  where
    _collectTokens :: ParseState b -> Parse b a (Maybe [a])
    _collectTokens :: ParseState b -> Parse b a (Maybe [a])
_collectTokens ParseState b
st =
      case forall b c a. Parse b c a -> ParseState b -> ParseResult b c a
unParse Parse b a a
lexer ParseState b
st of
        ParseOk a
_token ParseState b
_st ->
          if forall a. Tok a => a -> Bool
eofToken a
_token
          then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [a
_token]
          else do
            Maybe [a]
_mTokens <- ParseState b -> Parse b a (Maybe [a])
_collectTokens ParseState b
_st
            case Maybe [a]
_mTokens of
              Just [a]
_tokens -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
_tokenforall a. a -> [a] -> [a]
:[a]
_tokens
              Maybe [a]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        ParseResult b a a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

fromParseResult :: (Show c) => ParseResult b c a -> Either ParseErrorSimple a
fromParseResult :: forall c b a.
Show c =>
ParseResult b c a -> Either ParseErrorSimple a
fromParseResult (ParseOk a
a ParseState b
_)     = forall a b. b -> Either a b
Right a
a
fromParseResult (ParseFailed ParseError b c
err) =
    forall a b. a -> Either a b
Left ParseErrorSimple
      { errorPos :: Position
errorPos = forall {k} (a :: k) b. ParseError a b -> Position
errPos ParseError b c
err
      , errorFilename :: String
errorFilename = forall {k} (a :: k) b. ParseError a b -> String
errFilename ParseError b c
err
      , errorMsg :: String
errorMsg = forall {k} (a :: k) b. ParseError a b -> String
errMsg ParseError b c
err forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => Maybe a -> String
tokenMsg (forall {k} (a :: k) b. ParseError a b -> Maybe b
errLastToken ParseError b c
err)  }