fortran-src-0.16.3: src/Language/Fortran/Parser.hs
{-| 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
, byVerNoTransform
, f66NoTransform, f77NoTransform, f77eNoTransform, f77lNoTransform
, f90NoTransform, f95NoTransform, f2003NoTransform
-- * Other parsers
, f90Expr
, byVerFromFilename
-- ** Statement
, byVerStmt
, f66StmtNoTransform, f77StmtNoTransform, f77eStmtNoTransform
, f77lStmtNoTransform, f90StmtNoTransform, f95StmtNoTransform
, f2003StmtNoTransform
, byVerInclude
, f66IncludesNoTransform, f77IncludesNoTransform, f77eIncludesNoTransform
, f77lIncludesNoTransform, f90IncludesNoTransform, f95IncludesNoTransform
, f2003IncludesNoTransform
-- * Various combinators
, transformAs, defaultTransformation
, Parser, ParseErrorSimple(..)
, StateInit, ParserMaker, makeParser, makeParserFixed, makeParserFree
, initParseStateFixed, initParseStateFree
, initParseStateFixedExpr, initParseStateFreeExpr
, parseUnsafe
, collectTokensSafe, collectTokens
, throwIOLeft
-- * F77 with inlined includes
-- $f77includes
, byVerInlineIncludes
, f66InlineIncludes, f77InlineIncludes, f77eInlineIncludes
, f77lInlineIncludes, f90InlineIncludes , f95InlineIncludes
, f2003InlineIncludes
) 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
{ errorPos :: Position
, errorFilename :: String
, errorMsg :: String
} deriving anyclass (Exception)
instance Show ParseErrorSimple where
show err = errorFilename err ++ ", " ++ show (errorPos err) ++ ": " ++ errorMsg err
-- | May be used to lift parse results into IO and force unwrap.
throwIOLeft :: (Exception e, MonadIO m) => Either e a -> m a
throwIOLeft = \case Right a -> pure a
Left e -> liftIO $ throwIO e
--------------------------------------------------------------------------------
byVer :: FortranVersion -> Parser (ProgramFile A0)
byVer = \case
Fortran66 -> f66
Fortran77 -> f77
Fortran77Extended -> f77e
Fortran77Legacy -> f77l
Fortran90 -> f90
Fortran95 -> f95
Fortran2003 -> f2003
v -> error $ "Language.Fortran.Parser.byVer: "
<> "no parser available for requested version: "
<> show v
byVerWithMods :: ModFiles -> FortranVersion -> Parser (ProgramFile A0)
byVerWithMods mods = \case
Fortran66 -> f66Mods mods
Fortran77 -> f77Mods mods
Fortran77Extended -> f77eMods mods
Fortran77Legacy -> f77lMods mods
Fortran90 -> f90Mods mods
Fortran95 -> f95Mods mods
Fortran2003 -> f2003Mods mods
v -> error $ "Language.Fortran.Parser.byVerWithMods: no parser available for requested version: " <> show v
f66, f77, f77e, f77l, f90, f95, f2003 :: Parser (ProgramFile A0)
f66 = f66Mods []
f77 = f77Mods []
f77e = f77eMods []
f77l = f77lMods []
f90 = f90Mods []
f95 = f95Mods []
f2003 = f2003Mods []
f66Mods, f77Mods, f77eMods, f77lMods, f90Mods, f95Mods, f2003Mods
:: ModFiles -> Parser (ProgramFile A0)
f66Mods = transformAs Fortran66 f66NoTransform
f77Mods = transformAs Fortran77 f77NoTransform
f77eMods = transformAs Fortran77Extended f77eNoTransform
f77lMods = transformAs Fortran77Legacy f77lNoTransform
f90Mods = transformAs Fortran90 f90NoTransform
f95Mods = transformAs Fortran95 f95NoTransform
f2003Mods = transformAs Fortran2003 f2003NoTransform
f66NoTransform, f77NoTransform, f77eNoTransform, f77lNoTransform,
f90NoTransform, f95NoTransform, f2003NoTransform
:: Parser (ProgramFile A0)
f66NoTransform = makeParserFixed F66.programParser Fortran66
f77NoTransform = makeParserFixed F77.programParser Fortran77
f77eNoTransform = makeParserFixed F77.programParser Fortran77Extended
f77lNoTransform = makeParserFixed F77.programParser Fortran77Legacy
f90NoTransform = makeParserFree F90.programParser Fortran90
f95NoTransform = makeParserFree F95.programParser Fortran95
f2003NoTransform = makeParserFree F2003.programParser Fortran2003
f66StmtNoTransform, f77StmtNoTransform, f77eStmtNoTransform, f77lStmtNoTransform,
f90StmtNoTransform, f95StmtNoTransform, f2003StmtNoTransform
:: Parser (Statement A0)
f66StmtNoTransform = makeParserFixed F66.statementParser Fortran66
f77StmtNoTransform = makeParserFixed F77.statementParser Fortran77
f77eStmtNoTransform = makeParserFixed F77.statementParser Fortran77Extended
f77lStmtNoTransform = makeParserFixed F77.statementParser Fortran77Legacy
f90StmtNoTransform = makeParserFree F90.statementParser Fortran90
f95StmtNoTransform = makeParserFree F95.statementParser Fortran95
f2003StmtNoTransform = makeParserFree F2003.statementParser Fortran2003
byVerStmt :: FortranVersion -> Parser (Statement A0)
byVerStmt = \case
Fortran66 -> f66StmtNoTransform
Fortran77 -> f77StmtNoTransform
Fortran77Extended -> f77eStmtNoTransform
Fortran77Legacy -> f77lStmtNoTransform
Fortran90 -> f90StmtNoTransform
Fortran95 -> f95StmtNoTransform
Fortran2003 -> f2003StmtNoTransform
v -> error $ "Language.Fortran.Parser.byVerStmt: "
<> "no parser available for requested version: "
<> show v
byVerNoTransform :: FortranVersion -> Parser (ProgramFile A0)
byVerNoTransform = \case
Fortran66 -> f66NoTransform
Fortran77 -> f77NoTransform
Fortran77Legacy -> f77lNoTransform
Fortran77Extended -> f77eNoTransform
Fortran90 -> f90NoTransform
Fortran95 -> f90NoTransform
Fortran2003 -> f2003NoTransform
v -> error $ "Language.Fortran.Parser.byVerNoTransform: "
<> "no parser available for requested version: "
<> show v
f90Expr :: Parser (Expression A0)
f90Expr = makeParser initParseStateFreeExpr F90.expressionParser Fortran90
-- | Obtain a Fortran parser by assuming the version from the filename provided.
byVerFromFilename :: Parser (ProgramFile A0)
byVerFromFilename fn = byVer v fn
where v = deduceFortranVersion fn
--------------------------------------------------------------------------------
transformAs
:: Data a
=> FortranVersion -> Parser (ProgramFile a) -> ModFiles
-> Parser (ProgramFile a)
transformAs fv p mods fn bs = do
pf <- p fn bs
let pf' = pfSetFilename fn pf
return $ transform pf'
where transform = runTransform (combinedTypeEnv mods)
(combinedModuleMap mods)
(defaultTransformation 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 = \case
Fortran66 -> sequence_ [ Trans.groupLabeledDo
, Trans.disambiguateIntrinsic
, Trans.disambiguateFunction ]
Fortran77 -> defaultTransformation Fortran66
Fortran77Legacy -> sequence_ [ Trans.groupLabeledDo
, Trans.groupDo
, Trans.disambiguateIntrinsic
, Trans.disambiguateFunction ]
_ -> defaultTransformation 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 fInitState p fv fn = fromParseResult . runParse p . fInitState fn fv
makeParserFixed :: ParserMaker Fixed.AlexInput Fixed.Token a
makeParserFixed = makeParser initParseStateFixed
makeParserFree :: ParserMaker Free.AlexInput Free.Token a
makeParserFree = makeParser initParseStateFree
initParseStateFixed :: StateInit Fixed.AlexInput
initParseStateFixed fn fv bs = initParseState fn fv ai
where ai = Fixed.vanillaAlexInput fn fv bs
initParseStateFree :: StateInit Free.AlexInput
initParseStateFree fn fv bs = initParseState fn fv ai
where ai = Free.vanillaAlexInput fn 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 fn fv bs = st
{ psAlexInput = ai { Free.aiStartCode = Free.StartCode Free.scN Free.Return } }
where
ai = Free.vanillaAlexInput fn bs
st = initParseStateFree fn fv 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 fn fv bs = st
{ psAlexInput = ai { Fixed.aiStartCode = 6
, Fixed.aiWhiteSensitiveCharCount = 0 } }
where
ai = Fixed.vanillaAlexInput fn fv bs
st = initParseStateFixed fn fv 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 p bs =
case p "<unknown>" bs of
Left err -> throwIOError $ "Language.Fortran.Parser.parseUnsafe: "
<> "parse error: " <> show err
Right a -> a
-- | Helper for preparing initial parser state for the different lexers.
initParseState :: FilePath -> FortranVersion -> ai -> ParseState ai
initParseState fn fv ai = ParseState
{ psAlexInput = ai
, psVersion = fv
, psFilename = fn
, psParanthesesCount = ParanthesesCount 0 False
, psContext = [ 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.
-}
f66InlineIncludes, f77InlineIncludes, f77eInlineIncludes, f77lInlineIncludes,
f90InlineIncludes, f95InlineIncludes, f2003InlineIncludes
:: [FilePath] -> ModFiles -> String -> B.ByteString -> IO (ProgramFile A0)
f66InlineIncludes = byVerInlineIncludes Fortran66
f77lInlineIncludes = byVerInlineIncludes Fortran77Legacy
f77eInlineIncludes = byVerInlineIncludes Fortran77Extended
f77InlineIncludes = byVerInlineIncludes Fortran77
f90InlineIncludes = byVerInlineIncludes Fortran90
f95InlineIncludes = byVerInlineIncludes Fortran95
f2003InlineIncludes = byVerInlineIncludes Fortran2003
byVerInlineIncludes
:: FortranVersion -> [FilePath] -> ModFiles -> String -> B.ByteString
-> IO (ProgramFile A0)
byVerInlineIncludes version incs mods fn bs = do
case byVerNoTransform version fn bs of
Left e -> liftIO $ throwIO e
Right pf -> do
let pf' = pfSetFilename fn pf
pf'' <- evalStateT (descendBiM (parserInlineIncludes version incs []) pf') Map.empty
let pf''' = runTransform (combinedTypeEnv mods)
(combinedModuleMap mods)
(defaultTransformation version)
pf''
return pf'''
-- Internal function to go through the includes and inline them
parserInlineIncludes
:: FortranVersion -> [FilePath] -> [FilePath] -> Statement A0
-> StateT (Map String [Block A0]) IO (Statement A0)
parserInlineIncludes version dirs = go
where
go seen st = case st of
StInclude a s e@(ExpValue _ _ (ValString path)) Nothing -> do
if path `notElem` seen then do
incMap <- get
case Map.lookup path incMap of
Just blocks' -> pure $ StInclude a s e (Just blocks')
Nothing -> do
(fullPath, incBs) <- liftIO $ readInDirs dirs path
case byVerInclude version fullPath incBs of
Right blocks -> do
blocks' <- descendBiM (go (path:seen)) blocks
modify (Map.insert path blocks')
pure $ StInclude a s e (Just blocks')
Left err -> liftIO $ throwIO err
else pure st
_ -> pure st
f66IncludesNoTransform, f77IncludesNoTransform, f77eIncludesNoTransform,
f77lIncludesNoTransform, f90IncludesNoTransform, f95IncludesNoTransform,
f2003IncludesNoTransform
:: Parser [Block A0]
f66IncludesNoTransform = makeParserFixed F66.includesParser Fortran66
f77IncludesNoTransform = makeParserFixed F77.includesParser Fortran77
f77eIncludesNoTransform = makeParserFixed F77.includesParser Fortran77Extended
f77lIncludesNoTransform = makeParserFixed F77.includesParser Fortran77Legacy
f90IncludesNoTransform = makeParserFree F90.includesParser Fortran90
f95IncludesNoTransform = makeParserFree F95.includesParser Fortran95
f2003IncludesNoTransform = makeParserFree F2003.includesParser Fortran2003
byVerInclude :: FortranVersion -> Parser [Block A0]
byVerInclude = \case
Fortran66 -> f66IncludesNoTransform
Fortran77 -> f77IncludesNoTransform
Fortran77Extended -> f77eIncludesNoTransform
Fortran77Legacy -> f77lIncludesNoTransform
Fortran90 -> f90IncludesNoTransform
Fortran95 -> f95IncludesNoTransform
Fortran2003 -> f2003IncludesNoTransform
v -> error $ "Language.Fortran.Parser.byVerInclude: "
<> "no parser available for requested version: "
<> show v
readInDirs :: [String] -> String -> IO (String, B.ByteString)
readInDirs [] f = fail $ "cannot find file: " ++ f
readInDirs (d:ds) f = do
let path = d</>f
b <- doesFileExist path
if b then
(path,) <$> B.readFile path
else
readInDirs ds 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 lexer initState =
evalParse (_collectTokens initState) undefined
where
_collectTokens :: ParseState b -> Parse b a [a]
_collectTokens st = do
let (_token, _st) = runParseUnsafe lexer st
if eofToken _token
then return [_token]
else do
_tokens <- _collectTokens _st
return $ _token:_tokens
collectTokensSafe
:: forall a b
. (Loc b, Tok a, LastToken b a, Show a)
=> Parse b a a -> ParseState b -> Maybe [a]
collectTokensSafe lexer initState =
evalParse (_collectTokens initState) undefined
where
_collectTokens :: ParseState b -> Parse b a (Maybe [a])
_collectTokens st =
case unParse lexer st of
ParseOk _token _st ->
if eofToken _token
then return $ Just [_token]
else do
_mTokens <- _collectTokens _st
case _mTokens of
Just _tokens -> return $ Just $ _token:_tokens
_ -> return Nothing
_ -> return Nothing
fromParseResult :: (Show c) => ParseResult b c a -> Either ParseErrorSimple a
fromParseResult (ParseOk a _) = Right a
fromParseResult (ParseFailed err) =
Left ParseErrorSimple
{ errorPos = errPos err
, errorFilename = errFilename err
, errorMsg = errMsg err ++ "\n" ++ tokenMsg (errLastToken err) }