Merge pull request #274 from camfort/raoul/postfix-and-inlining

Postfix boz in free form lexer and generalised include inlining

src/Language/Fortran/Parser.hs

@@ -17,6 +17,7 @@ module Language.Fortran.Parser
   , f66, f77, f77e, f77l, f90, f95, f2003
 
   -- * Main parsers without post-parse transformation
+  , byVerNoTransform
   , f66NoTransform, f77NoTransform, f77eNoTransform, f77lNoTransform
     , f90NoTransform, f95NoTransform, f2003NoTransform
 
@@ -30,6 +31,10 @@ module Language.Fortran.Parser
   , f66StmtNoTransform, f77StmtNoTransform, f77eStmtNoTransform
     , f77lStmtNoTransform, f90StmtNoTransform, f95StmtNoTransform
     , f2003StmtNoTransform
+  , byVerInclude
+  , f66IncludesNoTransform, f77IncludesNoTransform, f77eIncludesNoTransform
+  , f77lIncludesNoTransform, f90IncludesNoTransform, f95IncludesNoTransform
+  , f2003IncludesNoTransform
 
   -- * Various combinators
   , transformAs, defaultTransformation
@@ -43,7 +48,10 @@ module Language.Fortran.Parser
 
   -- * F77 with inlined includes
   -- $f77includes
-  , f77lInlineIncludes
+  , byVerInlineIncludes
+  , f66InlineIncludes, f77InlineIncludes, f77eInlineIncludes
+  , f77lInlineIncludes, f90InlineIncludes , f95InlineIncludes
+  , f2003InlineIncludes
   ) where
 
 import Language.Fortran.AST
@@ -175,6 +183,18 @@ byVerStmt = \case
   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
@@ -291,35 +311,47 @@ are thrown as IO exceptions.
 Can be cleaned up and generalized to use for other parsers.
 -}
 
-f77lInlineIncludes
-    :: [FilePath] -> ModFiles -> String -> B.ByteString
+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)
-f77lInlineIncludes 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 (f77lInlineIncludes' incs []) pf') Map.empty
-        let pf''' = runTransform (combinedTypeEnv mods)
-                                 (combinedModuleMap mods)
-                                 (defaultTransformation Fortran77Legacy)
-                                 pf''
-        return pf'''
-
-f77lInlineIncludes'
-    :: [FilePath] -> [FilePath] -> Statement 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)
-f77lInlineIncludes' dirs = go
+parserInlineIncludes version dirs = go
   where
     go seen st = case st of
       StInclude a s e@(ExpValue _ _ (ValString path)) Nothing -> do
-        if notElem path seen then 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 f77lIncludesNoTransform fullPath incBs of
+              case byVerInclude version fullPath incBs of
                 Right blocks -> do
                   blocks' <- descendBiM (go (path:seen)) blocks
                   modify (Map.insert path blocks')
@@ -328,8 +360,30 @@ f77lInlineIncludes' dirs = go
         else pure st
       _ -> pure st
 
-f77lIncludesNoTransform :: Parser [Block A0]
+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

src/Language/Fortran/Parser/Fixed/Fortran66.y

@@ -6,6 +6,7 @@ module Language.Fortran.Parser.Fixed.Fortran66
   , blockParser
   , statementParser
   , expressionParser
+  , includesParser
   ) where
 
 import Language.Fortran.Version
@@ -25,6 +26,7 @@ import Prelude hiding ( EQ, LT, GT ) -- Same constructors exist in the AST
 %name blockParser      BLOCK
 %name statementParser  STATEMENT
 %name expressionParser EXPRESSION
+%name includesParser   INCLUDES
 %monad { LexAction }
 %lexer { lexer } { TEOF _ }
 %tokentype { Token }
@@ -139,6 +141,9 @@ MAYBE_ARGUMENTS :: { Maybe (AList Expression A0) }
 
 NAME :: { Name } : id { let (TId _ name) = $1 in name }
 
+INCLUDES :: { [ Block A0 ] }
+: BLOCKS NEWLINE { reverse $1 }
+
 BLOCKS :: { [ Block A0 ] }
 : BLOCKS BLOCK { $2 : $1 }
 | {- EMPTY -}  { [ ] }

src/Language/Fortran/Parser/Free/Fortran2003.y

@@ -7,6 +7,7 @@ module Language.Fortran.Parser.Free.Fortran2003
   , blockParser
   , statementParser
   , expressionParser
+  , includesParser
   ) where
 
 import Language.Fortran.Version
@@ -28,6 +29,7 @@ import qualified Data.List as List
 %name blockParser      BLOCK
 %name statementParser  STATEMENT
 %name expressionParser EXPRESSION
+%name includesParser   INCLUDES
 %monad { LexAction }
 %lexer { lexer } { TEOF _ }
 %tokentype { Token }
@@ -349,6 +351,9 @@ IMPORT_NAME_LIST :: { [Expression A0] }
 : IMPORT_NAME_LIST ',' VARIABLE { $3 : $1 }
 | VARIABLE { [ $1 ] }
 
+INCLUDES :: { [ Block A0 ] }
+: BLOCKS NEWLINE { reverse $1 }
+
 BLOCKS :: { [ Block A0 ] } : BLOCKS BLOCK { $2 : $1 } | {- EMPTY -} { [ ] }
 
 BLOCK :: { Block A0 }

src/Language/Fortran/Parser/Free/Fortran90.y

@@ -7,6 +7,7 @@ module Language.Fortran.Parser.Free.Fortran90
   , blockParser
   , statementParser
   , expressionParser
+  , includesParser
   ) where
 
 import Language.Fortran.Version
@@ -27,6 +28,7 @@ import qualified Data.List as List
 %name functionParser   SUBPROGRAM_UNIT
 %name blockParser      BLOCK
 %name statementParser  STATEMENT
+%name includesParser   INCLUDES
 %name expressionParser EXPRESSION
 %monad { LexAction }
 %lexer { lexer } { TEOF _ }
@@ -296,6 +298,9 @@ INTERFACE_END :: { Token }
 
 NAME :: { Name } : id { let (TId _ name) = $1 in name }
 
+INCLUDES :: { [ Block A0 ] }
+: BLOCKS NEWLINE { reverse $1 }
+
 BLOCKS :: { [ Block A0 ] } : BLOCKS BLOCK { $2 : $1 } | {- EMPTY -} { [ ] }
 
 BLOCK :: { Block A0 }

src/Language/Fortran/Parser/Free/Fortran95.y

@@ -7,6 +7,7 @@ module Language.Fortran.Parser.Free.Fortran95
   , blockParser
   , statementParser
   , expressionParser
+  , includesParser
   ) where
 
 import Language.Fortran.Version
@@ -28,6 +29,7 @@ import qualified Data.List as List
 %name blockParser      BLOCK
 %name statementParser  STATEMENT
 %name expressionParser EXPRESSION
+%name includesParser   INCLUDES
 %monad { LexAction }
 %lexer { lexer } { TEOF _ }
 %tokentype { Token }
@@ -305,6 +307,9 @@ INTERFACE_END :: { Token }
 
 NAME :: { Name } : id { let (TId _ name) = $1 in name }
 
+INCLUDES :: { [ Block A0 ] }
+: BLOCKS NEWLINE { reverse $1 }
+
 BLOCKS :: { [ Block A0 ] } : BLOCKS BLOCK { $2 : $1 } | {- EMPTY -} { [ ] }
 
 BLOCK :: { Block A0 }

src/Language/Fortran/Parser/Free/Lexer.x

@@ -51,9 +51,9 @@ $hash = [\#]
 @label = $digit{1,5}
 @name = $letter $alphanumeric*
 
-@binary = b\'$bit+\'
-@octal  = o\'$octalDigit+\'
-@hex    = z\'$hexDigit+\'
+@binary = b\'$bit+\' | \'$bit+\'b
+@octal  = o\'$octalDigit+\' | \'$octalDigit+\'o
+@hex    = [xz]\'$hexDigit+\' | \'$hexDigit+\'[xz]
 
 @digitString = $digit+
 @kindParam = (@digitString|@name)