{-| 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.
-}

{-# LANGUAGE ScopedTypeVariables #-}

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

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

  -- * F77 with inlined includes
  -- $f77includes
  , f77lIncludes
  , f77lIncIncludes
  ) 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 (Show ParseErrorSimple
Typeable ParseErrorSimple
Typeable ParseErrorSimple
-> Show ParseErrorSimple
-> (ParseErrorSimple -> SomeException)
-> (SomeException -> Maybe ParseErrorSimple)
-> (ParseErrorSimple -> String)
-> Exception 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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show (ParseErrorSimple -> Position
errorPos ParseErrorSimple
err) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseErrorSimple -> String
errorMsg ParseErrorSimple
err

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

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                 -> String -> Parser (ProgramFile A0)
forall a. HasCallStack => String -> a
error (String -> Parser (ProgramFile A0))
-> String -> Parser (ProgramFile A0)
forall a b. (a -> b) -> a -> b
$  String
"Language.Fortran.Parser.byVer: "
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"no parser available for requested version: "
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> FortranVersion -> String
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                 -> String -> Parser (ProgramFile A0)
forall a. HasCallStack => String -> a
error (String -> Parser (ProgramFile A0))
-> String -> Parser (ProgramFile A0)
forall a b. (a -> b) -> a -> b
$ String
"Language.Fortran.Parser.byVerWithMods: no parser available for requested version: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> FortranVersion -> String
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   = FortranVersion
-> Parser (ProgramFile A0) -> ModFiles -> Parser (ProgramFile A0)
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   = FortranVersion
-> Parser (ProgramFile A0) -> ModFiles -> Parser (ProgramFile A0)
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  = FortranVersion
-> Parser (ProgramFile A0) -> ModFiles -> Parser (ProgramFile A0)
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  = FortranVersion
-> Parser (ProgramFile A0) -> ModFiles -> Parser (ProgramFile A0)
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   = FortranVersion
-> Parser (ProgramFile A0) -> ModFiles -> Parser (ProgramFile A0)
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   = FortranVersion
-> Parser (ProgramFile A0) -> ModFiles -> Parser (ProgramFile A0)
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 = FortranVersion
-> Parser (ProgramFile A0) -> ModFiles -> Parser (ProgramFile A0)
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   = ParserMaker AlexInput Token (ProgramFile A0)
forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction (ProgramFile A0)
F66.programParser   FortranVersion
Fortran66
f77NoTransform :: Parser (ProgramFile A0)
f77NoTransform   = ParserMaker AlexInput Token (ProgramFile A0)
forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction (ProgramFile A0)
F77.programParser   FortranVersion
Fortran77
f77eNoTransform :: Parser (ProgramFile A0)
f77eNoTransform  = ParserMaker AlexInput Token (ProgramFile A0)
forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction (ProgramFile A0)
F77.programParser   FortranVersion
Fortran77Extended
f77lNoTransform :: Parser (ProgramFile A0)
f77lNoTransform  = ParserMaker AlexInput Token (ProgramFile A0)
forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction (ProgramFile A0)
F77.programParser   FortranVersion
Fortran77Legacy
f90NoTransform :: Parser (ProgramFile A0)
f90NoTransform   = ParserMaker AlexInput Token (ProgramFile A0)
forall a. ParserMaker AlexInput Token a
makeParserFree  LexAction (ProgramFile A0)
F90.programParser   FortranVersion
Fortran90
f95NoTransform :: Parser (ProgramFile A0)
f95NoTransform   = ParserMaker AlexInput Token (ProgramFile A0)
forall a. ParserMaker AlexInput Token a
makeParserFree  LexAction (ProgramFile A0)
F95.programParser   FortranVersion
Fortran95
f2003NoTransform :: Parser (ProgramFile A0)
f2003NoTransform = ParserMaker AlexInput Token (ProgramFile A0)
forall a. ParserMaker AlexInput Token a
makeParserFree  LexAction (ProgramFile A0)
F2003.programParser FortranVersion
Fortran2003

f90Expr :: Parser (Expression A0)
f90Expr :: Parser (Expression A0)
f90Expr = StateInit AlexInput -> ParserMaker AlexInput Token (Expression A0)
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

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

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' = String -> ProgramFile a -> ProgramFile a
forall a. String -> ProgramFile a -> ProgramFile a
pfSetFilename String
fn ProgramFile a
pf
    ProgramFile a -> Either ParseErrorSimple (ProgramFile a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgramFile a -> Either ParseErrorSimple (ProgramFile a))
-> ProgramFile a -> Either ParseErrorSimple (ProgramFile a)
forall a b. (a -> b) -> a -> b
$ ProgramFile a -> ProgramFile a
transform ProgramFile a
pf'
  where transform :: ProgramFile a -> ProgramFile a
transform = TypeEnv
-> ModuleMap -> Transform a A0 -> ProgramFile a -> ProgramFile a
forall a.
Data a =>
TypeEnv
-> ModuleMap -> Transform a A0 -> ProgramFile a -> ProgramFile a
runTransform (ModFiles -> TypeEnv
combinedTypeEnv ModFiles
mods)
                                 (ModFiles -> ModuleMap
combinedModuleMap ModFiles
mods)
                                 (FortranVersion -> Transform a A0
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         -> [Transform a A0] -> Transform a A0
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m A0
sequence_ [ Transform a A0
forall a. Data a => Transform a A0
Trans.groupLabeledDo
                                 , Transform a A0
forall a. Data a => Transform a A0
Trans.disambiguateIntrinsic
                                 , Transform a A0
forall a. Data a => Transform a A0
Trans.disambiguateFunction ]
  FortranVersion
Fortran77         -> FortranVersion -> Transform a A0
forall a. Data a => FortranVersion -> Transform a A0
defaultTransformation FortranVersion
Fortran66
  FortranVersion
Fortran77Legacy   -> [Transform a A0] -> Transform a A0
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m A0
sequence_ [ Transform a A0
forall a. Data a => Transform a A0
Trans.groupLabeledDo
                                 , Transform a A0
forall a. Data a => Transform a A0
Trans.groupDo
                                 , Transform a A0
forall a. Data a => Transform a A0
Trans.disambiguateIntrinsic
                                 , Transform a A0
forall a. Data a => Transform a A0
Trans.disambiguateFunction ]
  FortranVersion
_ -> FortranVersion -> Transform a A0
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 = ParseResult ai tok a -> Either ParseErrorSimple a
forall c b a.
Show c =>
ParseResult b c a -> Either ParseErrorSimple a
fromParseResult (ParseResult ai tok a -> Either ParseErrorSimple a)
-> (ByteString -> ParseResult ai tok a)
-> ByteString
-> Either ParseErrorSimple a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parse ai tok a -> ParseState ai -> ParseResult ai tok a
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 (ParseState ai -> ParseResult ai tok a)
-> (ByteString -> ParseState ai)
-> ByteString
-> ParseResult ai tok a
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 = StateInit AlexInput -> ParserMaker AlexInput Token a
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 = StateInit AlexInput -> ParserMaker AlexInput Token a
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 = String -> FortranVersion -> AlexInput -> ParseState AlexInput
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 = String -> FortranVersion -> AlexInput -> ParseState AlexInput
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 -> String -> a
forall a. String -> a
throwIOError (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$  String
"Language.Fortran.Parser.parseUnsafe: "
                               String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"parse error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParseErrorSimple -> String
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.
-}

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

-- | Entry point for include files
-- 
-- We can't perform full analysis (though it might be possible to do in future)
-- but the AST is enough for certain types of analysis/refactoring
f77lIncIncludes
  :: [FilePath] -> String -> B.ByteString -> IO [Block A0]
f77lIncIncludes :: [String] -> String -> ByteString -> IO [Block A0]
f77lIncIncludes [String]
incs String
fn ByteString
bs =
  case ParserMaker AlexInput Token [Block A0]
forall a. ParserMaker AlexInput Token a
makeParserFixed LexAction [Block A0]
F77.includesParser FortranVersion
Fortran77Legacy String
fn ByteString
bs of
    Left ParseErrorSimple
e -> IO [Block A0] -> IO [Block A0]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Block A0] -> IO [Block A0]) -> IO [Block A0] -> IO [Block A0]
forall a b. (a -> b) -> a -> b
$ ParseErrorSimple -> IO [Block A0]
forall e a. Exception e => e -> IO a
throwIO ParseErrorSimple
e
    Right [Block A0]
bls ->
      StateT (Map String [Block A0]) IO [Block A0]
-> Map String [Block A0] -> IO [Block A0]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ((Statement A0 -> StateT (Map String [Block A0]) IO (Statement A0))
-> [Block A0] -> StateT (Map String [Block A0]) IO [Block A0]
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)
f77lIncludesInline [String]
incs []) [Block A0]
bls) Map String [Block A0]
forall k a. Map k a
Map.empty

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

f77lIncludesInline
    :: [FilePath] -> [FilePath] -> Statement A0
    -> StateT (Map String [Block A0]) IO (Statement A0)
f77lIncludesInline :: [String]
-> [String]
-> Statement A0
-> StateT (Map String [Block A0]) IO (Statement A0)
f77lIncludesInline [String]
dirs [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 String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem String
path [String]
seen then do
      Map String [Block A0]
incMap <- StateT (Map String [Block A0]) IO (Map String [Block A0])
forall s (m :: * -> *). MonadState s m => m s
get
      case String -> Map String [Block A0] -> Maybe [Block A0]
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' -> Statement A0 -> StateT (Map String [Block A0]) IO (Statement A0)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Statement A0 -> StateT (Map String [Block A0]) IO (Statement A0))
-> Statement A0 -> StateT (Map String [Block A0]) IO (Statement A0)
forall a b. (a -> b) -> a -> b
$ A0 -> SrcSpan -> Expression A0 -> Maybe [Block A0] -> Statement A0
forall a.
a -> SrcSpan -> Expression a -> Maybe [Block a] -> Statement a
StInclude A0
a SrcSpan
s Expression A0
e ([Block A0] -> Maybe [Block A0]
forall a. a -> Maybe a
Just [Block A0]
blocks')
        Maybe [Block A0]
Nothing -> do
          (String
fullPath, ByteString
inc) <- IO (String, ByteString)
-> StateT (Map String [Block A0]) IO (String, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (String, ByteString)
 -> StateT (Map String [Block A0]) IO (String, ByteString))
-> IO (String, ByteString)
-> StateT (Map String [Block A0]) IO (String, ByteString)
forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO (String, ByteString)
readInDirs [String]
dirs String
path
          case Parser [Block A0]
f77lIncludesInner String
fullPath ByteString
inc of
            Right [Block A0]
blocks -> do
              [Block A0]
blocks' <- (Statement A0 -> StateT (Map String [Block A0]) IO (Statement A0))
-> [Block A0] -> StateT (Map String [Block A0]) IO [Block A0]
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)
f77lIncludesInline [String]
dirs (String
pathString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
seen)) [Block A0]
blocks
              (Map String [Block A0] -> Map String [Block A0])
-> StateT (Map String [Block A0]) IO A0
forall s (m :: * -> *). MonadState s m => (s -> s) -> m A0
modify (String
-> [Block A0] -> Map String [Block A0] -> Map String [Block A0]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
path [Block A0]
blocks')
              Statement A0 -> StateT (Map String [Block A0]) IO (Statement A0)
forall (m :: * -> *) a. Monad m => a -> m a
return (Statement A0 -> StateT (Map String [Block A0]) IO (Statement A0))
-> Statement A0 -> StateT (Map String [Block A0]) IO (Statement A0)
forall a b. (a -> b) -> a -> b
$ A0 -> SrcSpan -> Expression A0 -> Maybe [Block A0] -> Statement A0
forall a.
a -> SrcSpan -> Expression a -> Maybe [Block a] -> Statement a
StInclude A0
a SrcSpan
s Expression A0
e ([Block A0] -> Maybe [Block A0]
forall a. a -> Maybe a
Just [Block A0]
blocks')
            Left ParseErrorSimple
err -> IO (Statement A0)
-> StateT (Map String [Block A0]) IO (Statement A0)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Statement A0)
 -> StateT (Map String [Block A0]) IO (Statement A0))
-> IO (Statement A0)
-> StateT (Map String [Block A0]) IO (Statement A0)
forall a b. (a -> b) -> a -> b
$ ParseErrorSimple -> IO (Statement A0)
forall e a. Exception e => e -> IO a
throwIO ParseErrorSimple
err
    else Statement A0 -> StateT (Map String [Block A0]) IO (Statement A0)
forall (m :: * -> *) a. Monad m => a -> m a
return Statement A0
st
  Statement A0
_ -> Statement A0 -> StateT (Map String [Block A0]) IO (Statement A0)
forall (m :: * -> *) a. Monad m => a -> m a
return Statement A0
st

readInDirs :: [String] -> String -> IO (String, B.ByteString)
readInDirs :: [String] -> String -> IO (String, ByteString)
readInDirs [] String
f = String -> IO (String, ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (String, ByteString))
-> String -> IO (String, ByteString)
forall a b. (a -> b) -> a -> b
$ String
"cannot find file: " String -> ShowS
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,) (ByteString -> (String, ByteString))
-> IO ByteString -> IO (String, ByteString)
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 =
    Parse b a [a] -> ParseState b -> [a]
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) ParseState b
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) = Parse b a a -> ParseState b -> (a, ParseState b)
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 a -> Bool
forall a. Tok a => a -> Bool
eofToken a
_token
      then [a] -> Parse b a [a]
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
        [a] -> Parse b a [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Parse b a [a]) -> [a] -> Parse b a [a]
forall a b. (a -> b) -> a -> b
$ a
_tokena -> [a] -> [a]
forall 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 =
    Parse b a (Maybe [a]) -> ParseState b -> Maybe [a]
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) ParseState b
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 Parse b a a -> ParseState b -> ParseResult b a a
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 a -> Bool
forall a. Tok a => a -> Bool
eofToken a
_token
          then Maybe [a] -> Parse b a (Maybe [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [a] -> Parse b a (Maybe [a]))
-> Maybe [a] -> Parse b a (Maybe [a])
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe [a]
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 -> Maybe [a] -> Parse b a (Maybe [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [a] -> Parse b a (Maybe [a]))
-> Maybe [a] -> Parse b a (Maybe [a])
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ a
_tokena -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
_tokens
              Maybe [a]
_ -> Maybe [a] -> Parse b a (Maybe [a])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [a]
forall a. Maybe a
Nothing
        ParseResult b a a
_ -> Maybe [a] -> Parse b a (Maybe [a])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [a]
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
_)     = a -> Either ParseErrorSimple a
forall a b. b -> Either a b
Right a
a
fromParseResult (ParseFailed ParseError b c
err) =
    ParseErrorSimple -> Either ParseErrorSimple a
forall a b. a -> Either a b
Left ParseErrorSimple
      { errorPos :: Position
errorPos = ParseError b c -> Position
forall {k} (a :: k) b. ParseError a b -> Position
errPos ParseError b c
err
      , errorFilename :: String
errorFilename = ParseError b c -> String
forall {k} (a :: k) b. ParseError a b -> String
errFilename ParseError b c
err
      , errorMsg :: String
errorMsg = ParseError b c -> String
forall {k} (a :: k) b. ParseError a b -> String
errMsg ParseError b c
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe c -> String
forall a. Show a => Maybe a -> String
tokenMsg (ParseError b c -> Maybe c
forall {k} (a :: k) b. ParseError a b -> Maybe b
errLastToken ParseError b c
err)  }