From 271fa48daab3be2e2f87afe4798415d0b948947b Mon Sep 17 00:00:00 2001 From: Ben Orchard Date: Wed, 26 Jan 2022 17:51:53 +0000 Subject: [PATCH] re-add F77 inlined includes parser --- app/Main.hs | 2 +- src/Language/Fortran/Parser.hs | 143 +++++++++++++++++++++++--- src/Language/Fortran/Parser/Common.hs | 3 +- 3 files changed, 132 insertions(+), 16 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index bed13813..c0b61139 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, ScopedTypeVariables, OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} {-# OPTIONS_GHC -Wno-orphans #-} module Main where diff --git a/src/Language/Fortran/Parser.hs b/src/Language/Fortran/Parser.hs index 5241adaf..0e964965 100644 --- a/src/Language/Fortran/Parser.hs +++ b/src/Language/Fortran/Parser.hs @@ -13,15 +13,21 @@ combinators are exposed to assist in manually configuring parsers. module Language.Fortran.Parser ( -- * Main parsers (ProgramFile, with transformation) - f66, f77, f90, f95, f2003 + byVer, byVerWithMods + , f66, f77, f77e, f77l, f90, f95, f2003 -- * Main parsers without post-parse transformation - , f66NoTransform, f77NoTransform, f90NoTransform, f95NoTransform, f2003NoTransform + , f66NoTransform, f77NoTransform, f77eNoTransform, f77lNoTransform + , f90NoTransform, f95NoTransform, f2003NoTransform - -- * Parser former combinators + -- * Various combinators , transformAs, defaultTransformation , StateInit, ParserMaker, makeParser, makeParserFixed, makeParserFree , initParseStateFixed, initParseStateFree + + -- * F77 with inlined includes + -- $f77includes + , f77lIncludes ) where import Language.Fortran.AST @@ -36,6 +42,7 @@ 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 @@ -44,6 +51,14 @@ import qualified Language.Fortran.Transformation.Disambiguation.Intrinsic as Tra 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 ) +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'. @@ -51,17 +66,54 @@ type Parser a = String -> B.ByteString -> Either ParseErrorSimple a -------------------------------------------------------------------------------- -f66, f77, f90, f95, f2003 :: Parser (ProgramFile A0) -f66 = transformAs Fortran66 f66NoTransform -f77 = transformAs Fortran77 f77NoTransform -f90 = transformAs Fortran90 f90NoTransform -f95 = transformAs Fortran95 f95NoTransform -f2003 = transformAs Fortran2003 f2003NoTransform - -f66NoTransform, f77NoTransform, f90NoTransform, f95NoTransform, f2003NoTransform +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 f77NoTransform +f77lMods = transformAs Fortran77Legacy f77NoTransform +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 @@ -70,9 +122,15 @@ f2003NoTransform = makeParserFree F2003.programParser Fortran2003 transformAs :: Data a - => FortranVersion -> Parser (ProgramFile a) -> Parser (ProgramFile a) -transformAs fv p fn bs = - runTransform mempty mempty (defaultTransformation fv) <$> p fn bs + => 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. -- @@ -130,3 +188,60 @@ initParseStatePartial = ParseState , psFilename = undefined , 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. +-} + +f77lIncludes + :: [FilePath] -> ModFiles -> String -> B.ByteString + -> IO (ProgramFile A0) +f77lIncludes incs mods fn bs = do + case f77lNoTransform fn bs of + Left e -> liftIO $ throwIO e + Right pf -> do + let pf' = pfSetFilename fn pf + pf'' <- evalStateT (descendBiM (f77lIncludesInline incs []) pf') Map.empty + let pf''' = runTransform (combinedTypeEnv mods) + (combinedModuleMap mods) + (defaultTransformation Fortran77Legacy) + pf'' + return pf''' + +f77lIncludesInner :: Parser [Block A0] +f77lIncludesInner = makeParserFixed F77.includesParser Fortran77Legacy + +f77lIncludesInline + :: [FilePath] -> [FilePath] -> Statement A0 + -> StateT (Map String [Block A0]) IO (Statement A0) +f77lIncludesInline dirs seen st = case st of + StInclude a s e@(ExpValue _ _ (ValString path)) Nothing -> do + if notElem path seen then do + incMap <- get + case Map.lookup path incMap of + Just blocks' -> pure $ StInclude a s e (Just blocks') + Nothing -> do + (fullPath, inc) <- liftIO $ readInDirs dirs path + case f77lIncludesInner fullPath inc of + Right blocks -> do + blocks' <- descendBiM (f77lIncludesInline dirs (path:seen)) blocks + modify (Map.insert path blocks') + return $ StInclude a s e (Just blocks') + Left err -> liftIO $ throwIO err + else return st + _ -> return st + +readInDirs :: [String] -> String -> IO (String, B.ByteString) +readInDirs [] f = fail $ "cannot find file: " ++ f +readInDirs (d:ds) f = do + let path = df + b <- doesFileExist path + if b then + (path,) <$> B.readFile path + else + readInDirs ds f diff --git a/src/Language/Fortran/Parser/Common.hs b/src/Language/Fortran/Parser/Common.hs index dfdf57fe..1e38a6c2 100644 --- a/src/Language/Fortran/Parser/Common.hs +++ b/src/Language/Fortran/Parser/Common.hs @@ -80,7 +80,8 @@ data ParseResult b c a = ParseOk a (ParseState b) | ParseFailed (ParseError b c) data ParseErrorSimple = ParseErrorSimple { errorPos :: Position , errorFilename :: String - , errorMsg :: String } + , errorMsg :: String + } deriving (Exception) fromParseResultUnsafe :: (Show c) => ParseResult b c a -> a fromParseResultUnsafe (ParseOk a _) = a