fortran-src 0.4.2 → 0.4.3

raw patch · 20 files changed

+724/−326 lines, 20 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−0
• README.md +33/−10
• fortran-src.cabal +3/−2
• src/Language/Fortran/AST.hs +182/−134
• src/Language/Fortran/AST/AList.hs +65/−0
• src/Language/Fortran/Analysis/ModGraph.hs +1/−1
• src/Language/Fortran/Lexer/FixedForm.x +7/−2
• src/Language/Fortran/Parser/Any.hs +51/−33
• src/Language/Fortran/Parser/Fortran2003.y +21/−19
• src/Language/Fortran/Parser/Fortran66.y +27/−15
• src/Language/Fortran/Parser/Fortran77.y +114/−58
• src/Language/Fortran/Parser/Fortran90.y +20/−14
• src/Language/Fortran/Parser/Fortran95.y +22/−19
• src/Language/Fortran/PrettyPrint.hs +4/−0
• src/Language/Fortran/Transformer.hs +36/−15
• src/Language/Fortran/Util/Position.hs +76/−0
• src/Language/Fortran/Version.hs +6/−1
• src/Main.hs +2/−2
• test/Language/Fortran/Lexer/FixedFormSpec.hs +3/−0
• test/Language/Fortran/Parser/Fortran77/ParserSpec.hs +36/−1

@@ -1,3 +1,18 @@+### 0.4.3 (May 25, 2021)++  * Add Haddock documentation to AST module. Many parts of the AST now have+    commentary on meaning and usage, and the Haddock page is sectioned.+  * Add STATIC statement (should be similar/identical to SAVE attribute) to+    fixed-form lexer, support in Fortran 77 Extended parser.+  * Rewrite post-parse transformation handling. Parser modules now export more+    parsers which allow you to select post-parse transformations to apply,+    intended to enable quicker parsing if you know you don't need to certain+    transformations.+  * Support percent data references in fixed-form lexer, enable in Fortran 77+    parser+  * Now also testing on GHC 9.0+  * Cache INCLUDE-ed files to avoid unnecessary re-parsing+ ### 0.4.2 (March 03, 2021)    * `FortranVersion` from `ParserMonad` moved to its own module

@@ -1,5 +1,4 @@ # fortran-src- ![CI status badge](https://github.com/camfort/fortran-src/workflows/CI/badge.svg)  Provides lexing, parsing, and basic analyses of Fortran code covering standards: FORTRAN 66, FORTRAN 77, Fortran 90, Fortran 95 and part of Fortran 2003. Includes data flow and basic block analysis, a renamer, and type analysis. For example usage, see the 'camfort' project (https://github.com/camfort/camfort), which uses fortran-src as its front end.@@ -22,23 +21,47 @@                               --show-flows-to=AST-BLOCK-ID     dump a graph showing flows-to information from the given AST-block ID; prefix with 's' for supergraph                               --show-flows-from=AST-BLOCK-ID   dump a graph showing flows-from information from the given AST-block ID; prefix with 's' for supergraph -## Installation+## Usage/Installation+fortran-src is available on Hackage. Stackage has a very old version and is+definitely not what you want, but you can specify a newer Hackage version in+`stack.yaml`. -### Build from source+### As a dependency+Reference `fortran-src` in your (Stack/Cabal) project dependencies. If you're+using Stack, you can stuff a Hackage reference into `stack.yaml` using+`extra-deps`, like: -Stack 2.x is required for building. *(Stack 1.x may work with minor alternations -- you may have to download the resolver manually.)*+```yaml+resolver: ...+... -Clone the repository and install [Stack](https://docs.haskellstack.org/en/stable/README/).+extra-deps:+- ...+- fortran-src-$VERSION+``` +### As a CLI tool+If you have Cabal properly configured, you should be able install fortran-src+from Hackage:+ ```-stack setup-stack build+cabal install fortran-src ``` -### Using Cabal+Otherwise, we suggest building from source if you want to use the fortran-src+CLI tool. See [#Build from source](#build-from-source) for details. -Install [Cabal](https://www.haskell.org/cabal/).+## Development+As of 2021-04-28, fortran-src supports and is regularly tested on **GHC 8.6,+8.8, 8.10 and 9.0**. Releases prior to/newer than those may have issues. We+welcome fixes that would let us support a wider range of compilers. +### Build from source+#### Stack+Stack 2.x is required. *(Stack 1.x may work with minor alternations+-- you may have to download the resolver manually.)*+ ```-cabal install fortran-src+stack setup+stack build ```

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 50aa4fb72aab53b1e5d449fa390ff3290fb26bd9bf9297a7cac174a79ef92b3f+-- hash: f5d7e99716015530592de9c1b2546f0d2ad31a230d0574adb8385118e8bdba1f  name:           fortran-src-version:        0.4.2+version:        0.4.3 synopsis:       Parsers and analyses for Fortran standards 66, 77, 90 and 95. description:    Provides lexing, parsing, and basic analyses of Fortran code covering standards: FORTRAN 66, FORTRAN 77, Fortran 90, and Fortran 95 and some legacy extensions. Includes data flow and basic block analysis, a renamer, and type analysis. For example usage, see the 'camfort' project, which uses fortran-src as its front end. category:       Language@@ -35,6 +35,7 @@       Language.Fortran.Analysis.BBlocks       Language.Fortran.Analysis.DataFlow       Language.Fortran.AST+      Language.Fortran.AST.AList       Language.Fortran.Version       Language.Fortran.LValue       Language.Fortran.Intrinsics

@@ -5,11 +5,114 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-}--- orphans are instances of package-natives-{-# OPTIONS_GHC -Wno-orphans #-} -module Language.Fortran.AST where+-- This module holds the data types used to represent Fortran code of various+-- versions.+--+-- fortran-src supports Fortran 66 through to Fortran 2003, and uses the same+-- types to represent them. The Fortran standard was largely refined as it grew,+-- often assimilating popular compiler extensions for the previous standard. We+-- try to be as permissible as reasonable when parsing; similarly, this AST+-- keeps close to the syntax, and includes statements, expressions, types etc.+-- only applicable to certain (newer) versions of Fortran.+--+-- Useful Fortran standard references:+--+--   * Fortran 77 ANSI standard: ANSI X3.9-1978+--   * Fortran 90 ANSI standard: ANSI X3.198-1992 (also ISO/IEC 1539:1991)+--   * Fortran 90 Handbook (J. Adams)+--+-- (The Fortran 66 ANSI standard lacks detail, and isn't as useful as the later+-- standards for implementing the language.)+--+-- /Some comments aren't reflected in the Haddock documentation, so you may also+-- wish to view this file's source./ +module Language.Fortran.AST+  (+  -- * AST nodes and types+  -- ** Statements and expressions+    ProgramFile(..)+  , ProgramUnit(..)+  , Block(..)+  , Statement(..)+  , Expression(..)+  , Index(..)+  , Value(..)+  , UnaryOp(..)+  , BinaryOp(..)++  -- ** Types and declarations+  , Name+  , BaseType(..)+  , CharacterLen(..)+  , TypeSpec(..)+  , Declarator(..)+  , Selector(..)+  , DimensionDeclarator(..)++  -- ** Annotated node list (re-export)+  , module Language.Fortran.AST.AList++  -- ** Other+  , Attribute(..)+  , Prefix(..)+  , Suffix(..)+  , ProcDecl(..)+  , ProcInterface(..)+  , Comment(..)+  , ForallHeader(..)+  , Only(..)+  , MetaInfo(..)+  , Prefixes+  , Suffixes+  , PrefixSuffix+  , ModuleNature(..)+  , Use(..)+  , Argument(..)+  , Intent(..)+  , ControlPair(..)+  , AllocOpt(..)+  , ImpList(..)+  , ImpElement(..)+  , CommonGroup(..)+  , Namelist(..)+  , DataGroup(..)+  , StructureItem(..)+  , UnionMap(..)+  , FormatItem(..)+  , FlushSpec(..)+  , DoSpecification(..)+  , ProgramUnitName(..)++  -- * Node annotations & related typeclasses+  , A0+  , Annotated(..)+  , Labeled(..)+  , Conditioned(..)+  , Named(..)++  -- * Helpers+  , charLenSelector+  , validPrefixSuffix+  , emptyPrefixes+  , emptySuffixes+  , emptyPrefixSuffix+  , nonExecutableStatement+  , nonExecutableStatementBlock+  , executableStatement+  , executableStatementBlock+  , setInitialisation++  -- ** Assorted getters & setters+  , pfSetFilename+  , pfGetFilename+  , programUnitBody+  , updateProgramUnitBody+  , programUnitSubprograms++  ) where+ import Prelude hiding (init) import Data.Data import Data.Generics.Uniplate.Data ()@@ -17,61 +120,35 @@ import Data.Binary import Control.DeepSeq import Text.PrettyPrint.GenericPretty-import Language.Fortran.ParserMonad (FortranVersion(..))+import Language.Fortran.Version (FortranVersion(..))  import Language.Fortran.Util.Position import Language.Fortran.Util.FirstParameter import Language.Fortran.Util.SecondParameter-+import Language.Fortran.AST.AList +-- | The empty annotation. type A0 = ()  type Name = String --- AST is polymorphic on some type a as that type is used for arbitrary--- annotations---- Many AST nodes such as executable statements, declerations, etc. may--- appear in lists, hence a dedicated annotated list type is defined-data AList t a = AList a SrcSpan [t a] deriving (Eq, Show, Data, Typeable, Generic)-instance Functor t => Functor (AList t) where-  fmap f (AList a s xs) = AList (f a) s (map (fmap f) xs)----- Convert non-empty list to AList.-fromList :: Spanned (t a) => a -> [ t a ] -> AList t a-fromList a xs = AList a (getSpan xs) xs---- Nothing iff list is empty-fromList' :: Spanned (t a) => a -> [ t a ] -> Maybe (AList t a)-fromList' _ [] = Nothing-fromList' a xs = Just $ fromList a xs--fromReverseList :: Spanned (t ()) => [ t () ] -> AList t ()-fromReverseList = fromList () . reverse--fromReverseList' :: Spanned (t ()) => [ t () ] -> Maybe (AList t ())-fromReverseList' = fromList' () . reverse--aCons :: t a -> AList t a -> AList t a-aCons x (AList a s xs) = AList a s $ x:xs--infixr 5 `aCons`--aReverse :: AList t a -> AList t a-aReverse (AList a s xs) = AList a s $ reverse xs--aStrip :: AList t a -> [t a]-aStrip (AList _ _ l) = l--aStrip' :: Maybe (AList t a) -> [t a]-aStrip' Nothing = []-aStrip' (Just a) = aStrip a--aMap :: (t a -> r a) -> AList t a -> AList r a-aMap f (AList a s xs) = AList a s (map f xs)-+-------------------------------------------------------------------------------- -- Basic AST nodes+--------------------------------------------------------------------------------++-- | Type name referenced in syntax.+--+-- In many Fortran specs and compilers, certain types are actually "synonyms"+-- for other types with specified kinds. The primary example is DOUBLE PRECISION+-- being equivalent to REAL(8). Type kinds were introduced in Fortran 90, and it+-- should be safe to replace all instances of DOUBLE PRECISION with REAL(8) in+-- Fortran 90 code. However, type kinds weren't present in (standard) Fortran+-- 77, so this equivalence was detached from the user.+--+-- In any case, it's unclear how strong the equivalence is and whether it can+-- be retroactively applied to previous standards. We choose to parse types+-- directly, and handle those transformations during type analysis, where we+-- assign most scalars a kind (see 'Analysis.SemType'). data BaseType =     TypeInteger   | TypeReal@@ -111,9 +188,24 @@       -- FIXME: some references refer to things like kind=kanji but I can't find any spec for it       | otherwise                                    = Nothing +-- | The type specification of a declaration statement, containing the syntactic+--   type name and kind selector.+--+-- See HP's F90 spec pg.24. data TypeSpec a = TypeSpec a SrcSpan BaseType (Maybe (Selector a))   deriving (Eq, Show, Data, Typeable, Generic, Functor) +-- | The "kind selector" of a declaration statement.+--+-- HP's F90 spec (pg.24) actually differentiates between "kind selectors" and+-- "char selectors", where char selectors can specify a length (alongside kind),+-- and the default meaning of an unlabelled kind parameter (the 8 in INTEGER(8))+-- is length instead of kind. We handle this correctly in the parsers, but place+-- both into this 'Selector' type.+--+-- The upshot is, length is invalid for non-CHARACTER types, and the parser+-- guarantees that it will be Nothing. For CHARACTER types, both maybe or may+-- not be present. data Selector a = --                   Maybe length         | Maybe kind   Selector a SrcSpan (Maybe (Expression a)) (Maybe (Expression a))@@ -299,6 +391,7 @@   | StVolatile            a SrcSpan (AList Declarator a)   | StData                a SrcSpan (AList DataGroup a)   | StAutomatic           a SrcSpan (AList Declarator a)+  | StStatic              a SrcSpan (AList Declarator a)   | StNamelist            a SrcSpan (AList Namelist a)   | StParameter           a SrcSpan (AList Declarator a)   | StExternal            a SrcSpan (AList Expression a)@@ -308,7 +401,11 @@   | StFormat              a SrcSpan (AList FormatItem a)   | StImplicit            a SrcSpan (Maybe (AList ImpList a))   | StEntry               a SrcSpan (Expression a) (Maybe (AList Expression a)) (Maybe (Expression a))+   | StInclude             a SrcSpan (Expression a) (Maybe [Block a])+  -- ^ Nothing indicates an yet-to-be processed include. (The F77 parser parses+  -- Nothing, then fills out each include statement in a post-parse step.)+   | StDo                  a SrcSpan (Maybe String) (Maybe (Expression a)) (Maybe (DoSpecification a))   | StDoWhile             a SrcSpan (Maybe String) (Maybe (Expression a)) (Expression a)   | StEnddo               a SrcSpan (Maybe String)@@ -545,16 +642,45 @@   | ValColon                   -- see R402 / C403 in Fortran2003 spec.   deriving (Eq, Show, Data, Typeable, Generic, Functor) +-- | Declarators.+--+-- Declaration statements can have multiple variables on the right of the double+-- colon, separated by commas. A 'Declarator' identifies a single one of these.+--+-- Each declared variable can have an initializing expression. These expressions+-- are defined in HP's F90 spec to be /initialization expressions/, which are+-- specialized constant expressions.+--+-- The length expressions here are defined in HP's F90 spec to be specifications+-- expressions, which are scalar integer expressions with a bunch of+-- restrictions similar to initialization expressions.+--+-- 'Declarator's are also used for some less-used syntax that let you set+-- variable attributes using statements, like:+--+--     integer arr+--     dimension arr(10)+--+-- Some of these only set part of the 'Declarator' (e.g. @parameter@ only sets+-- the initial value).+--+-- Syntax note: length is set like @character :: str*10@, dimensions are set+-- like @integer :: arr(10)@. Careful to not get confused.+--+-- Note that according to HP's F90 spec, lengths may only be specified for+-- CHARACTER types. So for any declarations that aren't 'TypeCharacter' in the+-- outer 'TypeSpec', the length expression should be Nothing. However, this is+-- not enforced by the AST or parser, so be warned. data Declarator a =     DeclVariable a SrcSpan-                 (Expression a) -- Variable-                 (Maybe (Expression a)) -- Length (character)-                 (Maybe (Expression a)) -- Initial value+                 (Expression a) -- ^ Variable+                 (Maybe (Expression a)) -- ^ Length (character)+                 (Maybe (Expression a)) -- ^ Initial value   | DeclArray a SrcSpan-              (Expression a) -- Array-              (AList DimensionDeclarator a) -- Dimensions-              (Maybe (Expression a)) -- Length (character)-              (Maybe (Expression a)) -- Initial value+              (Expression a) -- ^ Array+              (AList DimensionDeclarator a) -- ^ Dimensions+              (Maybe (Expression a)) -- ^ Length (character)+              (Maybe (Expression a)) -- ^ Initial value   deriving (Eq, Show, Data, Typeable, Generic, Functor)  setInitialisation :: Declarator a -> Expression a -> Declarator a@@ -565,6 +691,7 @@ -- do nothing when there is already a value setInitialisation d _ = d +-- | Dimension declarator stored in @dimension@ attributes and 'Declarator's. data DimensionDeclarator a =   DimensionDeclarator a SrcSpan (Maybe (Expression a)) (Maybe (Expression a))   deriving (Eq, Show, Data, Typeable, Generic, Functor)@@ -614,7 +741,6 @@    modifyAnnotation f x = setAnnotation (f (getAnnotation x)) x -instance FirstParameter (AList t a) a instance FirstParameter (ProgramUnit a) a instance FirstParameter (Prefix a) a instance FirstParameter (Suffix a) a@@ -644,7 +770,6 @@ instance FirstParameter (ControlPair a) a instance FirstParameter (AllocOpt a) a -instance SecondParameter (AList t a) SrcSpan instance SecondParameter (ProgramUnit a) SrcSpan instance SecondParameter (Prefix a) SrcSpan instance SecondParameter (Suffix a) SrcSpan@@ -702,7 +827,6 @@ instance Annotated ControlPair instance Annotated AllocOpt -instance Spanned (AList t a) instance Spanned (ProgramUnit a) instance Spanned (Prefix a) instance Spanned (Suffix a)@@ -740,78 +864,6 @@    setSpan _ _ = error "Cannot set span to a program unit" -instance (Spanned a) => Spanned [a] where-  getSpan [] = error "Trying to find how long an empty list spans for."-  getSpan [x]   = getSpan x-  getSpan (x:xs) = getTransSpan x (last xs)-  setSpan _ _ = error "Cannot set span to an array"--instance (Spanned a, Spanned b) => Spanned (a, Maybe b) where-  getSpan (x, Just y) = getTransSpan x y-  getSpan (x,_) = getSpan x-  setSpan _ = undefined--instance (Spanned a, Spanned b) => Spanned (Maybe a, b) where-  getSpan (Just x,y) = getTransSpan x y-  getSpan (_,y) = getSpan y-  setSpan _ = undefined--instance (Spanned a, Spanned b) => Spanned (Either a b) where-  getSpan (Left x) = getSpan x-  getSpan (Right x) = getSpan x-  setSpan _ = undefined--instance {-# OVERLAPPABLE #-} (Spanned a, Spanned b) => Spanned (a, b) where-  getSpan (x,y) = getTransSpan x y-  setSpan _ = undefined--instance {-# OVERLAPPING #-}(Spanned a, Spanned b, Spanned c) => Spanned (Maybe a, Maybe b, Maybe c) where-  getSpan (Just x,_,Just z) = getTransSpan x z-  getSpan (Just x,Just y,Nothing) = getTransSpan x y-  getSpan (Nothing,Just y,Just z) = getTransSpan y z-  getSpan (Just x,Nothing,Nothing) = getSpan x-  getSpan (Nothing,Just y,Nothing) = getSpan y-  getSpan (Nothing,Nothing,Just z) = getSpan z-  getSpan (Nothing,Nothing,Nothing) = undefined-  setSpan _ = undefined--instance {-# OVERLAPPING #-}(Spanned a, Spanned b, Spanned c) => Spanned (a, Maybe b, Maybe c) where-  getSpan (x,_,Just z) = getTransSpan x z-  getSpan (x,Just y,Nothing) = getTransSpan x y-  getSpan (x,Nothing,Nothing) = getSpan x-  setSpan _ = undefined--instance {-# OVERLAPPING #-} (Spanned a, Spanned b, Spanned c) => Spanned (Maybe a, b, c) where-  getSpan (Just x,_,z) = getTransSpan x z-  getSpan (_,y,z) = getSpan (y,z)-  setSpan _ = undefined--instance {-# OVERLAPPABLE #-} (Spanned a, Spanned b, Spanned c) => Spanned (a, b, c) where-  getSpan (x,_,z) = getTransSpan x z-  setSpan _ = undefined--class (Spanned a, Spanned b) => SpannedPair a b where-  getTransSpan :: a -> b -> SrcSpan--instance {-# OVERLAPPABLE #-} (Spanned a, Spanned b) => SpannedPair a b where-  getTransSpan x y = SrcSpan l1 l2'-    where SrcSpan l1 _ = getSpan x-          SrcSpan _ l2' = getSpan y--instance {-# OVERLAPS #-} (Spanned a, Spanned b) => SpannedPair a [b] where-  getTransSpan x [] = getSpan x-  getTransSpan x y = SrcSpan l1 l2'-    where SrcSpan l1 _ = getSpan x-          SrcSpan _ l2' = getSpan y--instance {-# OVERLAPS #-} (Spanned a, Spanned b) => SpannedPair a [[b]] where-  getTransSpan x [] = getSpan x-  getTransSpan x y | all null y = getSpan x-  getTransSpan x y | any null y = getTransSpan x (filter (not . null) y)-  getTransSpan x y = SrcSpan l1 l2'-    where SrcSpan l1 _ = getSpan x-          SrcSpan _ l2' = getSpan y- class Labeled f where   getLabel :: f a -> Maybe (Expression a)   getLastLabel :: f a -> Maybe (Expression a)@@ -885,13 +937,11 @@   -- Identity function if first arg is nameless or second arg is comment.   setName _ a = a -instance Out FortranVersion instance Out MetaInfo instance Out a => Out (ProgramFile a) instance Out a => Out (ProgramUnit a) instance Out a => Out (Prefix a) instance Out a => Out (Suffix a)-instance (Out a, Out (t a)) => Out (AList t a) instance Out a => Out (Statement a) instance Out a => Out (ProcDecl a) instance Out a => Out (ProcInterface a)@@ -981,7 +1031,6 @@ nonExecutableStatementBlock _ BlInterface{} = True nonExecutableStatementBlock _ _ = False -instance (NFData a, NFData (t a)) => NFData (AList t a) instance NFData a => NFData (ProgramFile a) instance NFData a => NFData (ProgramUnit a) instance NFData a => NFData (Block a)@@ -1015,7 +1064,6 @@ instance NFData a => NFData (StructureItem a) instance NFData a => NFData (UnionMap a) instance NFData MetaInfo-instance NFData FortranVersion instance NFData CharacterLen instance NFData BaseType instance NFData UnaryOp

@@ -0,0 +1,65 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}++module Language.Fortran.AST.AList where++import Language.Fortran.Util.FirstParameter+import Language.Fortran.Util.SecondParameter+import Language.Fortran.Util.Position (Spanned, SrcSpan(..), getSpan)++import Data.Data    (Data, Typeable)+import GHC.Generics (Generic)+import Control.DeepSeq (NFData)+import Text.PrettyPrint.GenericPretty (Out)++-- | A location-tagged list of @t a@s (@t@ decorated with an @a@ annotation).+--+-- The AST is polymorphic on some type @a@, which is used for arbitrary+-- annotations. Since many AST nodes use lists (e.g. executable statements,+-- declarations), we define a dedicated annotated list type to reuse.+--+-- Note that the list itself also holds an @a@ annotation.+data AList t a = AList a SrcSpan [t a] deriving (Eq, Show, Data, Typeable, Generic)+instance Functor t => Functor (AList t) where+  fmap f (AList a s xs) = AList (f a) s (map (fmap f) xs)++instance FirstParameter (AList t a) a+instance SecondParameter (AList t a) SrcSpan+instance Spanned (AList t a)+instance (Out a, Out (t a)) => Out (AList t a)+instance (NFData a, NFData (t a)) => NFData (AList t a)++-- | Convert a non-empty list to an 'AList'.+fromList :: Spanned (t a) => a -> [ t a ] -> AList t a+fromList a xs = AList a (getSpan xs) xs++-- | Convert a list to an 'AList', returning Nothing iff the list is empty.+fromList' :: Spanned (t a) => a -> [ t a ] -> Maybe (AList t a)+fromList' _ [] = Nothing+fromList' a xs = Just $ fromList a xs++fromReverseList :: Spanned (t ()) => [ t () ] -> AList t ()+fromReverseList = fromList () . reverse++fromReverseList' :: Spanned (t ()) => [ t () ] -> Maybe (AList t ())+fromReverseList' = fromList' () . reverse++aCons :: t a -> AList t a -> AList t a+aCons x (AList a s xs) = AList a s $ x:xs++infixr 5 `aCons`++aReverse :: AList t a -> AList t a+aReverse (AList a s xs) = AList a s $ reverse xs++aStrip :: AList t a -> [t a]+aStrip (AList _ _ l) = l++aStrip' :: Maybe (AList t a) -> [t a]+aStrip' Nothing = []+aStrip' (Just a) = aStrip a++aMap :: (t a -> r a) -> AList t a -> AList r a+aMap f (AList a s xs) = AList a s (map f xs)

@@ -86,7 +86,7 @@       iter path = do         contents <- liftIO $ flexReadFile path         let version = fromMaybe (deduceFortranVersion path) mversion-        let (Just parserF0) = lookup version parserWithModFilesVersions+        let parserF0 = parserWithModFilesVersions version         let parserF m b s = fromRight (parserF0 m b s)         fileMods <- liftIO $ decodeModFiles includeDirs         let mods = map snd fileMods

@@ -55,7 +55,7 @@ @id = $letter $alphanumeric{0,5} @label = $digit{1,5} -@idLegacy = [$letter \_ \%] [$alphanumericExtended \$]*+@idLegacy = [$letter \_] [$alphanumericExtended \$]*  @datatype = "integer" | "real" | "doubleprecision" | "complex" | "logical"           -- legacy extensions@@ -85,8 +85,9 @@    <0,st,keyword,iif,assn,doo> \n              { resetPar >> toSC 0 >> addSpan TNewline }   <0,st,keyword,iif,assn,doo> \r              ;-  <0,st,keyword,iif,assn,doo> ";"             { resetPar >> toSC keyword >> addSpan TNewline } +  <st,keyword,iif,assn,doo> ";"               { resetPar >> toSC keyword >> addSpan TNewline }+   <st> "("                                    { addSpan TLeftPar }   <keyword> "(" / { legacy77P }               { addSpan TLeftPar }   <iif> "("                                   { incPar >> addSpan TLeftPar }@@ -97,6 +98,7 @@   <st,iif> "/)" / { formatExtendedP }         { addSpan TRightArrayPar }   <st,iif,doo,keyword> ","                    { addSpan TComma }   <st,iif,keyword> "."                        { addSpan TDot }+  <st,iif,keyword> "%"                        { addSpan TPercent }   <keyword> "." / { legacy77P }               { addSpan TDot }   <st,iif> ":" / { fortran77P }               { addSpan TColon } @@ -196,6 +198,7 @@   -- Tokens related to data initalization statement   <keyword> "data"                            { toSC st >> addSpan TData  }   <keyword> "automatic" / { legacy77P }       { toSC st >> addSpan TAutomatic  }+  <keyword> "static" / { legacy77P }          { toSC st >> addSpan TStatic }    -- Tokens related to format statement   <keyword> "format"                          { toSC fmt >> enterFormat >> addSpan TFormat  }@@ -729,6 +732,7 @@            | TRightArrayPar       SrcSpan            | TComma               SrcSpan            | TDot                 SrcSpan+           | TPercent             SrcSpan            | TColon               SrcSpan            | TInclude             SrcSpan            | TProgram             SrcSpan@@ -793,6 +797,7 @@            | TNone                SrcSpan            | TParameter           SrcSpan            | TData                SrcSpan+           | TStatic              SrcSpan            | TAutomatic           SrcSpan            | TFormat              SrcSpan            | TBlob                SrcSpan String

@@ -1,3 +1,17 @@+{-# LANGUAGE LambdaCase #-}++-- | = Note on these parsers+--+-- Seperate parsers are provided for different Fortran versions. A few parsers+-- are provided for each version, offering built-in defaults or allowing you to+-- configure them yourself. They can be identified by their suffix:+--+--   * @parser@: all defaults (without mod files, default transformations)+--   * @parserWithModFiles@: select mod files, default transformations+--   * @parserWithTransforms@: without mod files, select transformations+--   * @parserWithModFilesWithTransforms@: select mod files, select transformations+--+ module Language.Fortran.Parser.Any where  import Language.Fortran.AST@@ -16,53 +30,57 @@ import qualified Data.ByteString.Char8 as B  type Parser = B.ByteString -> String -> Either ParseErrorSimple (ProgramFile A0)-parserVersions :: [(FortranVersion, Parser)]-parserVersions =-  [ (Fortran66, fromParseResult `after` fortran66Parser)-  , (Fortran77, fromParseResult `after` fortran77Parser)-  , (Fortran77Extended, fromParseResult `after` extended77Parser)-  , (Fortran77Legacy, fromParseResult `after` legacy77Parser)-  , (Fortran90, fromParseResult `after` fortran90Parser)-  , (Fortran95, fromParseResult `after` fortran95Parser)-  , (Fortran2003, fromParseResult `after` fortran2003Parser) ]+parserVersions :: FortranVersion -> Parser+parserVersions = \case+  Fortran66         -> fromParseResult `after` fortran66Parser+  Fortran77         -> fromParseResult `after` fortran77Parser+  Fortran77Extended -> fromParseResult `after` extended77Parser+  Fortran77Legacy   -> fromParseResult `after` legacy77Parser+  Fortran90         -> fromParseResult `after` fortran90Parser+  Fortran95         -> fromParseResult `after` fortran95Parser+  Fortran2003       -> fromParseResult `after` fortran2003Parser+  _                 -> error "no parser available for requested Fortran version"+  where+    after :: (b -> c) -> (t -> a -> b) -> t -> a -> c+    after g f x = g . f x  type ParserWithModFiles = ModFiles -> B.ByteString -> String -> Either ParseErrorSimple (ProgramFile A0)-parserWithModFilesVersions :: [(FortranVersion, ParserWithModFiles)]-parserWithModFilesVersions =-  [ (Fortran66, \m s -> fromParseResult . fortran66ParserWithModFiles m s)-  , (Fortran77, \m s -> fromParseResult . fortran77ParserWithModFiles m s)-  , (Fortran77Extended, \m s -> fromParseResult . extended77ParserWithModFiles m s)-  , (Fortran77Legacy, \m s -> fromParseResult . legacy77ParserWithModFiles m s)-  , (Fortran90, \m s -> fromParseResult . fortran90ParserWithModFiles m s)-  , (Fortran95, \m s -> fromParseResult . fortran95ParserWithModFiles m s)-  , (Fortran2003, \m s -> fromParseResult . fortran2003ParserWithModFiles m s) ]--after :: (b -> c) -> (t -> a -> b) -> t -> a -> c-after g f x = g . f x+parserWithModFilesVersions :: FortranVersion -> ParserWithModFiles+parserWithModFilesVersions = \case+  Fortran66         -> helper fortran66ParserWithModFiles+  Fortran77         -> helper fortran77ParserWithModFiles+  Fortran77Extended -> helper extended77ParserWithModFiles+  Fortran77Legacy   -> helper legacy77ParserWithModFiles+  Fortran90         -> helper fortran90ParserWithModFiles+  Fortran95         -> helper fortran95ParserWithModFiles+  Fortran2003       -> helper fortran2003ParserWithModFiles+  _                 -> error "no parser available for requested Fortran version"+  where+    helper parser m s = fromParseResult . parser m s  -- | Deduce the type of parser from the filename and parse the -- contents of the file. fortranParser :: Parser-fortranParser contents filename = do-   let Just parserF = lookup (deduceFortranVersion filename) parserVersions-   parserF contents filename+fortranParser contents filename =+   let parserF = parserVersions (deduceFortranVersion filename)+    in parserF contents filename  -- | Deduce the type of parser from the filename and parse the -- contents of the file, within the context of given "mod files". fortranParserWithModFiles :: ParserWithModFiles-fortranParserWithModFiles mods contents filename = do-   let Just parserF = lookup (deduceFortranVersion filename) parserWithModFilesVersions-   parserF mods contents filename+fortranParserWithModFiles mods contents filename =+   let parserF = parserWithModFilesVersions (deduceFortranVersion filename)+    in parserF mods contents filename  -- | Given a FortranVersion, parse the contents of the file. fortranParserWithVersion :: FortranVersion -> Parser-fortranParserWithVersion v contents filename = do-   let Just parserF = lookup v parserVersions-   parserF contents filename+fortranParserWithVersion v contents filename =+   let parserF = parserVersions v+    in parserF contents filename  -- | Given a FortranVersion, parse the contents of the file, within -- the context of given "mod files". fortranParserWithModFilesAndVersion :: FortranVersion -> ParserWithModFiles-fortranParserWithModFilesAndVersion v mods contents filename = do-   let Just parserF = lookup v parserWithModFilesVersions-   parserF mods contents filename+fortranParserWithModFilesAndVersion v mods contents filename =+   let parserF = parserWithModFilesVersions v+    in parserF mods contents filename

@@ -4,7 +4,9 @@ module Language.Fortran.Parser.Fortran2003 ( functionParser                                            , statementParser                                            , fortran2003Parser+                                           , fortran2003ParserWithTransforms                                            , fortran2003ParserWithModFiles+                                           , fortran2003ParserWithModFilesWithTransforms                                            ) where  import Prelude hiding (EQ,LT,GT) -- Same constructors exist in the AST@@ -1286,29 +1288,29 @@ unitNameCheck _ _ = return ()  parse = runParse programParser+defTransforms = defaultTransformations Fortran2003 -transformations2003 =-  [ GroupLabeledDo-  , GroupDo-  , GroupIf-  , GroupCase-  , DisambiguateIntrinsic-  , DisambiguateFunction-  ]+fortran2003Parser+    :: B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran2003Parser = fortran2003ParserWithTransforms defTransforms -fortran2003Parser ::-     B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-fortran2003Parser sourceCode filename =-    (pfSetFilename filename . transform transformations2003) <$> parse parseState-  where-    parseState = initParseState sourceCode Fortran2003 filename+fortran2003ParserWithTransforms+    :: [Transformation]+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran2003ParserWithTransforms =+    flip fortran2003ParserWithModFilesWithTransforms emptyModFiles -fortran2003ParserWithModFiles ::-     ModFiles -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-fortran2003ParserWithModFiles mods sourceCode filename =-    fmap (pfSetFilename filename . transform) $ parse parseState+fortran2003ParserWithModFiles+    :: ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran2003ParserWithModFiles = fortran2003ParserWithModFilesWithTransforms defTransforms++fortran2003ParserWithModFilesWithTransforms+    :: [Transformation] -> ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran2003ParserWithModFilesWithTransforms transforms mods sourceCode filename =+    fmap (pfSetFilename filename . transformWithModFiles mods transforms) $ parse parseState   where-    transform = transformWithModFiles mods transformations2003     parseState = initParseState sourceCode Fortran2003 filename  parseError :: Token -> LexAction a

@@ -1,10 +1,13 @@ -- -*- Mode: Haskell -*-+-- vim: ft=haskell { module Language.Fortran.Parser.Fortran66 ( expressionParser                                          , statementParser                                          , fortran66Parser-                                         , fortran66ParserWithModFiles )-where+                                         , fortran66ParserWithTransforms+                                         , fortran66ParserWithModFiles+                                         , fortran66ParserWithModFilesWithTransforms+                                         ) where  import Prelude hiding (EQ,LT,GT) -- Same constructors exist in the AST @@ -504,22 +507,31 @@       expStr  = case exp of { Just (_, s) -> s ; _ -> "" } in     ExpValue () span2 (ValReal $ i1Str ++ dotStr ++ i2Str ++ expStr) -transformations66 =-  [ GroupLabeledDo-  , DisambiguateIntrinsic-  , DisambiguateFunction-  ]+parse = runParse programParser+defTransforms = defaultTransformations Fortran66 -fortran66Parser ::-     B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-fortran66Parser = fortran66ParserWithModFiles emptyModFiles+fortran66Parser+    :: B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran66Parser = fortran66ParserWithTransforms defTransforms -fortran66ParserWithModFiles ::-    ModFiles -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-fortran66ParserWithModFiles mods sourceCode filename =-    fmap (pfSetFilename filename . transformWithModFiles mods transformations66) $ parse parseState+fortran66ParserWithTransforms+    :: [Transformation]+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran66ParserWithTransforms =+    flip fortran66ParserWithModFilesWithTransforms emptyModFiles++fortran66ParserWithModFiles+    :: ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran66ParserWithModFiles =+    fortran66ParserWithModFilesWithTransforms defTransforms++fortran66ParserWithModFilesWithTransforms+    :: [Transformation] -> ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran66ParserWithModFilesWithTransforms transforms mods sourceCode filename =+    fmap (pfSetFilename filename . transformWithModFiles mods transforms) $ parse parseState   where-    parse = runParse programParser     parseState = initParseState sourceCode Fortran66 filename  parseError :: Token -> LexAction a

@@ -4,13 +4,21 @@   ( expressionParser   , statementParser   , fortran77Parser-  , extended77Parser-  , legacy77Parser-  , includeParser+  , fortran77ParserWithTransforms   , fortran77ParserWithModFiles+  , fortran77ParserWithModFilesWithTransforms+  , extended77Parser+  , extended77ParserWithTransforms   , extended77ParserWithModFiles+  , extended77ParserWithModFilesWithTransforms+  , legacy77Parser+  , legacy77ParserWithTransforms   , legacy77ParserWithModFiles+  , legacy77ParserWithModFilesWithTransforms   , legacy77ParserWithIncludes+  , legacy77ParserWithIncludesWithTransforms+  , includeParser+   ) where  import Prelude hiding (EQ,LT,GT) -- Same constructors exist in the AST@@ -19,6 +27,7 @@ import Data.List import Data.Maybe (isNothing, fromJust) import qualified Data.ByteString.Char8 as B+import qualified Data.Map as M import Language.Fortran.Util.Position import Language.Fortran.Util.ModFile import Language.Fortran.ParserMonad@@ -49,6 +58,7 @@   '/)'                  { TRightArrayPar _ }   ','                   { TComma _ }   '.'                   { TDot _ }+  '%'                   { TPercent _ }   ':'                   { TColon _ }   include               { TInclude _ }   program               { TProgram _ }@@ -121,6 +131,7 @@   none                  { TNone _ }   data                  { TData _ }   automatic             { TAutomatic _ }+  static                { TStatic _ }   format                { TFormat _ }   blob                  { TBlob _ _ }   int                   { TInt _ _ }@@ -492,6 +503,7 @@ | pointer POINTER_LIST { StPointer () (getTransSpan $1 $2) (fromReverseList $2) } | data DATA_GROUPS { StData () (getTransSpan $1 $2) (fromReverseList $2) } | automatic DECLARATORS { StAutomatic () (getTransSpan $1 $2) (aReverse $2) }+| static DECLARATORS { StStatic () (getTransSpan $1 $2) (aReverse $2) } -- Following is a fake node to make arbitrary FORMAT statements parsable. -- Must be fixed in the future. TODO | format blob@@ -783,7 +795,15 @@ -- Expression all by itself subsumes all other callable expressions. CALLABLE_EXPRESSION :: { Argument A0 } CALLABLE_EXPRESSION-: id '=' EXPRESSION+-- Explicitly parse special intrinsics for argument passing types+: '%' id '(' EXPRESSION ')'+  { let { args = AList () (getSpan $4) $ [Argument () (getSpan $4) Nothing $4];+          TId _ name = $2;+          intr = ExpFunctionCall () (getTransSpan $1 $5)+                   (ExpValue () (getTransSpan $1 $2) (ValIntrinsic ('%':name)))+                   (Just args) }+    in Argument () (getTransSpan $1 $5) Nothing intr }+| id '=' EXPRESSION   { let TId span keyword = $1     in Argument () (getTransSpan span $3) (Just keyword) $3 } | EXPRESSION  { Argument () (getSpan $1) Nothing $1 }@@ -897,6 +917,8 @@ SUBSCRIPT : SUBSCRIPT '.' VARIABLE   { ExpDataRef () (getTransSpan $1 $3) $1 $3 }+| SUBSCRIPT '%' VARIABLE+  { ExpDataRef () (getTransSpan $1 $3) $1 $3 } | SUBSCRIPT '(' ')'   { ExpFunctionCall () (getTransSpan $1 $3) $1 Nothing } | SUBSCRIPT '(' INDICIES ')'@@ -1059,74 +1081,102 @@  parse = runParse programParser -transformations77 =-  [ GroupLabeledDo-  , GroupIf-  , DisambiguateIntrinsic-  , DisambiguateFunction-  ]-fortran77Parser ::-    B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-fortran77Parser = fortran77ParserWithModFiles emptyModFiles+defTransforms77  = defaultTransformations Fortran77+defTransforms77e = defaultTransformations Fortran77Extended+defTransforms77l = defaultTransformations Fortran77Legacy -fortran77ParserWithModFiles ::-    ModFiles -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-fortran77ParserWithModFiles mods sourceCode filename =+fortran77Parser+    :: B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran77Parser = fortran77ParserWithTransforms defTransforms77++fortran77ParserWithTransforms+    :: [Transformation]+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran77ParserWithTransforms =+    flip fortran77ParserWithModFilesWithTransforms emptyModFiles++fortran77ParserWithModFiles+    :: ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran77ParserWithModFiles =+    fortran77ParserWithModFilesWithTransforms defTransforms77++fortran77ParserWithModFilesWithTransforms+    :: [Transformation] -> ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran77ParserWithModFilesWithTransforms transforms mods sourceCode filename =     fmap (pfSetFilename filename . transform) $ parse parseState   where-    transform  = transformWithModFiles mods transformations77+    transform  = transformWithModFiles mods transforms     parseState = initParseState sourceCode Fortran77Extended filename -transformations77Extended =-  [ GroupLabeledDo-  , GroupDo-  , GroupIf-  , GroupCase-  , DisambiguateIntrinsic-  , DisambiguateFunction-  ]-extended77Parser ::-    B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-extended77Parser = extended77ParserWithModFiles emptyModFiles+extended77Parser+    :: B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+extended77Parser = extended77ParserWithTransforms defTransforms77e -extended77ParserWithModFiles ::-    ModFiles -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-extended77ParserWithModFiles mods sourceCode filename =+extended77ParserWithTransforms+    :: [Transformation]+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+extended77ParserWithTransforms =+    flip extended77ParserWithModFilesWithTransforms emptyModFiles++extended77ParserWithModFiles+    :: ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+extended77ParserWithModFiles =+    extended77ParserWithModFilesWithTransforms defTransforms77e++extended77ParserWithModFilesWithTransforms+    :: [Transformation] -> ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+extended77ParserWithModFilesWithTransforms transforms mods sourceCode filename =     fmap (pfSetFilename filename . transform) $ parse parseState   where-    transform = transformWithModFiles mods transformations77Extended+    transform = transformWithModFiles mods transforms     parseState = initParseState sourceCode Fortran77Extended filename -transformations77Legacy =-  [ GroupLabeledDo-  , GroupDo-  , GroupIf-  , DisambiguateIntrinsic-  , DisambiguateFunction-  ]-legacy77Parser ::-    B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-legacy77Parser = legacy77ParserWithModFiles emptyModFiles+legacy77Parser+    :: B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+legacy77Parser = legacy77ParserWithTransforms defTransforms77l -legacy77ParserWithModFiles ::-    ModFiles -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-legacy77ParserWithModFiles mods sourceCode filename =+legacy77ParserWithTransforms+    :: [Transformation]+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+legacy77ParserWithTransforms = flip legacy77ParserWithModFilesWithTransforms emptyModFiles++legacy77ParserWithModFiles+    :: ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+legacy77ParserWithModFiles =+    legacy77ParserWithModFilesWithTransforms defTransforms77l++legacy77ParserWithModFilesWithTransforms+    :: [Transformation] -> ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+legacy77ParserWithModFilesWithTransforms transforms mods sourceCode filename =     fmap (pfSetFilename filename . transform) $ parse parseState   where-    transform = transformWithModFiles mods transformations77Legacy+    transform = transformWithModFiles mods transforms     parseState = initParseState sourceCode Fortran77Legacy filename -legacy77ParserWithIncludes ::-  [String] -> B.ByteString -> String -> IO (ParseResult AlexInput Token (ProgramFile A0))-legacy77ParserWithIncludes incs sourceCode filename =+legacy77ParserWithIncludes+    :: [String]+    -> B.ByteString -> String -> IO (ParseResult AlexInput Token (ProgramFile A0))+legacy77ParserWithIncludes =+    legacy77ParserWithIncludesWithTransforms defTransforms77l++legacy77ParserWithIncludesWithTransforms+    :: [Transformation] -> [String]+    -> B.ByteString -> String -> IO (ParseResult AlexInput Token (ProgramFile A0))+legacy77ParserWithIncludesWithTransforms transforms incs sourceCode filename =     fmap (pfSetFilename filename . transform) <$> doParse   where     doParse = case parse parseState of       ParseFailed e -> return (ParseFailed e)       ParseOk p x -> do-        p' <- descendBiM (inlineInclude Fortran77Legacy incs []) p+        p' <- evalStateT (descendBiM (inlineInclude Fortran77Legacy incs []) p) M.empty         return (ParseOk p' x)-    transform = transformWithModFiles emptyModFiles transformations77Legacy+    transform = transformWithModFiles emptyModFiles transforms     parseState = initParseState sourceCode Fortran77Legacy filename  includeParser ::@@ -1137,16 +1187,22 @@     -- ensure the file ends with a newline..     parseState = initParseState (sourceCode `B.snoc` '\n') version filename -inlineInclude :: FortranVersion -> [String] -> [String] -> Statement A0 -> IO (Statement A0)+inlineInclude :: FortranVersion -> [String] -> [String] -> Statement A0 ->+  StateT (M.Map String [Block A0]) IO (Statement A0) inlineInclude fv dirs seen st = case st of   StInclude a s e@(ExpValue _ _ (ValString path)) Nothing -> do     if notElem path seen then do-      inc <- readInDirs dirs path-      case includeParser fv inc path of-        ParseOk blocks _ -> do-          blocks' <- descendBiM (inlineInclude fv dirs (path:seen)) blocks-          return $ StInclude a s e (Just blocks')-        ParseFailed e -> throwIO e+      incMap <- get+      case M.lookup path incMap of+        Just blocks' -> pure $ StInclude a s e (Just blocks')+        Nothing -> do+          inc <- liftIO $ readInDirs dirs path+          case includeParser fv inc path of+            ParseOk blocks _ -> do+              blocks' <- descendBiM (inlineInclude fv dirs (path:seen)) blocks+              modify (M.insert path blocks')+              return $ StInclude a s e (Just blocks')+            ParseFailed e -> liftIO $ throwIO e     else return st   _ -> return st 

@@ -3,7 +3,9 @@ module Language.Fortran.Parser.Fortran90 ( statementParser                                          , functionParser                                          , fortran90Parser+                                         , fortran90ParserWithTransforms                                          , fortran90ParserWithModFiles+                                         , fortran90ParserWithModFilesWithTransforms                                          ) where  import Prelude hiding (EQ,LT,GT) -- Same constructors exist in the AST@@ -1079,24 +1081,28 @@ unitNameCheck _ _ = return ()  parse = runParse programParser--transformations90 =-  [ GroupLabeledDo-  , GroupDo-  , GroupIf-  , GroupCase-  , DisambiguateIntrinsic-  , DisambiguateFunction-  ]+defTransforms = defaultTransformations Fortran90  fortran90Parser ::     B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-fortran90Parser = fortran90ParserWithModFiles emptyModFiles+fortran90Parser = fortran90ParserWithTransforms defTransforms -fortran90ParserWithModFiles ::-    ModFiles -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-fortran90ParserWithModFiles mods sourceCode filename =-    fmap (pfSetFilename filename . transformWithModFiles mods transformations90) $ parse parseState+fortran90ParserWithTransforms+    :: [Transformation]+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran90ParserWithTransforms =+    flip fortran90ParserWithModFilesWithTransforms emptyModFiles++fortran90ParserWithModFiles+    :: ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran90ParserWithModFiles = fortran90ParserWithModFilesWithTransforms defTransforms++fortran90ParserWithModFilesWithTransforms+    :: [Transformation] -> ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran90ParserWithModFilesWithTransforms transforms mods sourceCode filename =+    fmap (pfSetFilename filename . transformWithModFiles mods transforms) $ parse parseState   where     parseState = initParseState sourceCode Fortran90 filename 

@@ -3,9 +3,12 @@ module Language.Fortran.Parser.Fortran95 ( functionParser                                          , statementParser                                          , fortran95Parser+                                         , fortran95ParserWithTransforms                                          , fortran95ParserWithModFiles+                                         , fortran95ParserWithModFilesWithTransforms                                          ) where + import Prelude hiding (EQ,LT,GT) -- Same constructors exist in the AST import Control.Monad.State import Data.Maybe (fromMaybe, isJust)@@ -1146,29 +1149,29 @@ unitNameCheck _ _ = return ()  parse = runParse programParser+defTransforms = defaultTransformations Fortran95 -transformations95 =-  [ GroupLabeledDo-  , GroupDo-  , GroupIf-  , GroupCase-  , DisambiguateIntrinsic-  , DisambiguateFunction-  ]+fortran95Parser+    :: B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran95Parser = fortran95ParserWithTransforms defTransforms -fortran95Parser ::-     B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-fortran95Parser sourceCode filename =-    (pfSetFilename filename . transform transformations95) <$> parse parseState-  where-    parseState = initParseState sourceCode Fortran95 filename+fortran95ParserWithTransforms+    :: [Transformation]+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran95ParserWithTransforms =+    flip fortran95ParserWithModFilesWithTransforms emptyModFiles -fortran95ParserWithModFiles ::-     ModFiles -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)-fortran95ParserWithModFiles mods sourceCode filename =-    fmap (pfSetFilename filename . transform) $ parse parseState+fortran95ParserWithModFiles+    :: ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran95ParserWithModFiles = fortran95ParserWithModFilesWithTransforms defTransforms++fortran95ParserWithModFilesWithTransforms+    :: [Transformation] -> ModFiles+    -> B.ByteString -> String -> ParseResult AlexInput Token (ProgramFile A0)+fortran95ParserWithModFilesWithTransforms transforms mods sourceCode filename =+    fmap (pfSetFilename filename . transformWithModFiles mods transforms) $ parse parseState   where-    transform = transformWithModFiles mods transformations95     parseState = initParseState sourceCode Fortran95 filename  parseError :: Token -> LexAction a

@@ -486,6 +486,10 @@       | v == Fortran77Extended = "automatic" <+> pprint' v decls       | otherwise = tooOld v "Automatic statement" Fortran90 +    pprint' v (StStatic _ _ decls)+      | v == Fortran77Extended = "static" <+> pprint' v decls+      | otherwise = tooOld v "Static statement" Fortran90+     pprint' v (StNamelist _ _ namelist)       | v >= Fortran90 = "namelist" <+> pprint' v namelist       | otherwise = tooOld v "Namelist statement" Fortran90

@@ -1,7 +1,12 @@-module Language.Fortran.Transformer ( transform, transformWithModFiles-                                    , Transformation(..) ) where+{-# LANGUAGE LambdaCase #-} -import Data.Maybe (fromJust)+module Language.Fortran.Transformer+  ( transform+  , transformWithModFiles+  , Transformation(..)+  , defaultTransformations+  ) where+ import Data.Map (empty) import Data.Data @@ -11,6 +16,7 @@ import Language.Fortran.Transformation.Disambiguation.Intrinsic import Language.Fortran.Transformation.Grouping import Language.Fortran.AST (ProgramFile)+import Language.Fortran.Version (FortranVersion(..))  data Transformation =     GroupForall@@ -22,23 +28,38 @@   | DisambiguateIntrinsic   deriving (Eq) -transformationMapping :: Data a => [ (Transformation, Transform a ()) ]-transformationMapping =-  [ (GroupForall, groupForall)-  , (GroupIf, groupIf)-  , (GroupCase, groupCase)-  , (GroupDo, groupDo)-  , (GroupLabeledDo, groupLabeledDo)-  , (DisambiguateFunction, disambiguateFunction)-  , (DisambiguateIntrinsic, disambiguateIntrinsic)-  ]+transformationMapping :: Data a => Transformation -> Transform a ()+transformationMapping = \case+  GroupForall           -> groupForall+  GroupIf               -> groupIf+  GroupCase             -> groupCase+  GroupDo               -> groupDo+  GroupLabeledDo        -> groupLabeledDo+  DisambiguateFunction  -> disambiguateFunction+  DisambiguateIntrinsic -> disambiguateIntrinsic  transformWithModFiles :: Data a => ModFiles -> [ Transformation ] -> ProgramFile a -> ProgramFile a transformWithModFiles mods trs = runTransform (combinedTypeEnv mods) (combinedModuleMap mods) trans   where-    trans = mapM_ (\t -> fromJust $ lookup t transformationMapping) trs+    trans = mapM_ transformationMapping trs  transform :: Data a => [ Transformation ] -> ProgramFile a -> ProgramFile a transform trs = runTransform empty empty trans   where-    trans = mapM_ (\t -> fromJust $ lookup t transformationMapping) trs+    trans = mapM_ transformationMapping trs++-- | The default post-parse AST transformations for each Fortran version.+defaultTransformations :: FortranVersion -> [Transformation]+defaultTransformations = \case+  Fortran66 ->+    [ GroupLabeledDo+    , DisambiguateIntrinsic+    , DisambiguateFunction+    ]+  Fortran77         -> GroupIf   : defaultTransformations Fortran66+  Fortran77Legacy   -> GroupDo   : defaultTransformations Fortran77+  Fortran77Extended -> GroupCase : defaultTransformations Fortran77Legacy+  Fortran90   -> defaultTransformations Fortran77Extended+  Fortran95   -> defaultTransformations Fortran77Extended+  Fortran2003 -> defaultTransformations Fortran77Extended+  Fortran2008 -> defaultTransformations Fortran2003

@@ -1,6 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveGeneric #-}  module Language.Fortran.Util.Position where@@ -91,3 +93,77 @@    default setSpan :: (SecondParameter a SrcSpan) => SrcSpan -> a -> a   setSpan = setSecondParameter++class (Spanned a, Spanned b) => SpannedPair a b where+  getTransSpan :: a -> b -> SrcSpan++--------------------------------------------------------------------------------++instance (Spanned a) => Spanned [a] where+  getSpan [] = error "Trying to find how long an empty list spans for."+  getSpan [x]   = getSpan x+  getSpan (x:xs) = getTransSpan x (last xs)+  setSpan _ _ = error "Cannot set span to an array"++instance (Spanned a, Spanned b) => Spanned (a, Maybe b) where+  getSpan (x, Just y) = getTransSpan x y+  getSpan (x,_) = getSpan x+  setSpan _ = undefined++instance (Spanned a, Spanned b) => Spanned (Maybe a, b) where+  getSpan (Just x,y) = getTransSpan x y+  getSpan (_,y) = getSpan y+  setSpan _ = undefined++instance (Spanned a, Spanned b) => Spanned (Either a b) where+  getSpan (Left x) = getSpan x+  getSpan (Right x) = getSpan x+  setSpan _ = undefined++instance {-# OVERLAPPABLE #-} (Spanned a, Spanned b) => Spanned (a, b) where+  getSpan (x,y) = getTransSpan x y+  setSpan _ = undefined++instance {-# OVERLAPPING #-}(Spanned a, Spanned b, Spanned c) => Spanned (Maybe a, Maybe b, Maybe c) where+  getSpan (Just x,_,Just z) = getTransSpan x z+  getSpan (Just x,Just y,Nothing) = getTransSpan x y+  getSpan (Nothing,Just y,Just z) = getTransSpan y z+  getSpan (Just x,Nothing,Nothing) = getSpan x+  getSpan (Nothing,Just y,Nothing) = getSpan y+  getSpan (Nothing,Nothing,Just z) = getSpan z+  getSpan (Nothing,Nothing,Nothing) = undefined+  setSpan _ = undefined++instance {-# OVERLAPPING #-}(Spanned a, Spanned b, Spanned c) => Spanned (a, Maybe b, Maybe c) where+  getSpan (x,_,Just z) = getTransSpan x z+  getSpan (x,Just y,Nothing) = getTransSpan x y+  getSpan (x,Nothing,Nothing) = getSpan x+  setSpan _ = undefined++instance {-# OVERLAPPING #-} (Spanned a, Spanned b, Spanned c) => Spanned (Maybe a, b, c) where+  getSpan (Just x,_,z) = getTransSpan x z+  getSpan (_,y,z) = getSpan (y,z)+  setSpan _ = undefined++instance {-# OVERLAPPABLE #-} (Spanned a, Spanned b, Spanned c) => Spanned (a, b, c) where+  getSpan (x,_,z) = getTransSpan x z+  setSpan _ = undefined++instance {-# OVERLAPPABLE #-} (Spanned a, Spanned b) => SpannedPair a b where+  getTransSpan x y = SrcSpan l1 l2'+    where SrcSpan l1 _ = getSpan x+          SrcSpan _ l2' = getSpan y++instance {-# OVERLAPS #-} (Spanned a, Spanned b) => SpannedPair a [b] where+  getTransSpan x [] = getSpan x+  getTransSpan x y = SrcSpan l1 l2'+    where SrcSpan l1 _ = getSpan x+          SrcSpan _ l2' = getSpan y++instance {-# OVERLAPS #-} (Spanned a, Spanned b) => SpannedPair a [[b]] where+  getTransSpan x [] = getSpan x+  getTransSpan x y | all null y = getSpan x+  getTransSpan x y | any null y = getTransSpan x (filter (not . null) y)+  getTransSpan x y = SrcSpan l1 l2'+    where SrcSpan l1 _ = getSpan x+          SrcSpan _ l2' = getSpan y

@@ -14,8 +14,10 @@ import           Data.Char (toLower) import           Data.List (isInfixOf, isSuffixOf, find) -import Data.Data (Data, Typeable)+import Data.Data    (Data, Typeable) import GHC.Generics (Generic)+import Control.DeepSeq (NFData)+import Text.PrettyPrint.GenericPretty (Out)  data FortranVersion = Fortran66                     | Fortran77@@ -36,6 +38,9 @@   show Fortran95         = "Fortran 95"   show Fortran2003       = "Fortran 2003"   show Fortran2008       = "Fortran 2008"++instance Out    FortranVersion+instance NFData FortranVersion  fortranVersionAliases :: [(String, FortranVersion)] fortranVersionAliases = [ ("66" , Fortran66)

@@ -105,7 +105,7 @@     (path:_, actionOpt) -> do       contents <- flexReadFile path       let version = fromMaybe (deduceFortranVersion path) (fortranVersion opts)-      let (Just parserF0) = lookup version parserWithModFilesVersions+      let parserF0 = parserWithModFilesVersions version       let parserF m b s = fromRight (parserF0 m b s)       let outfmt = outputFormat opts       mods <- decodeModFiles $ includeDirs opts@@ -244,7 +244,7 @@ compileFileToMod mvers mods path moutfile = do   contents <- flexReadFile path   let version = fromMaybe (deduceFortranVersion path) mvers-  let (Just parserF0) = lookup version parserWithModFilesVersions+  let parserF0 = parserWithModFilesVersions version   let parserF m b s = fromRight (parserF0 m b s)   let mmap = combinedModuleMap mods   let tenv = combinedTypeEnv mods

@@ -226,6 +226,9 @@         resetSrcSpan (collectFixedTokens' Fortran77Legacy "      integer i; integer j")           `shouldBe` resetSrcSpan [TType u "integer", TId u "i", TNewline u, TType u "integer", TId u "j", TEOF u] +      it "does not lex ';' as a line-terminator in first 6 columns" $+        safeLex66 "; integer i; integer j" `shouldBe` Nothing+       it "lexes subscripts in assignments" $         resetSrcSpan (collectFixedTokens' Fortran77Legacy "      x(0,0) = 0")           `shouldBe` resetSrcSpan [TId u "x", TLeftPar u, TInt u "0", TComma u, TInt u "0", TRightPar u, TOpAssign u, TInt u "0", TEOF u]

@@ -34,7 +34,7 @@   fromParseResultUnsafe $ includeParser Fortran77Legacy (B.pack sourceCode) "<unknown>"  pParser :: String -> ProgramFile ()-pParser source = fromParseResultUnsafe $ fortran77Parser (B.pack source) "<unknown>"+pParser source = fromParseResultUnsafe $ legacy77Parser (B.pack source) "<unknown>"  spec :: Spec spec =@@ -286,6 +286,26 @@             st = StStructure () u (Just "foo") $ AList () u [innerst]         resetSrcSpan (slParser src) `shouldBe` st +      it "parses structure data references " $ do+        let src = init $ unlines [ "      print *, foo % bar"+                                 , "      print *, foo.bar" ]+            expStar = ExpValue () u ValStar+            foobar = ExpDataRef () u (ExpValue () u (ValVariable "foo")) (ExpValue () u (ValVariable "bar"))+            blStmt = BlStatement () u Nothing $ StPrint () u expStar $ Just $ AList () u [foobar]+        resetSrcSpan (iParser src) `shouldBe` [ blStmt, blStmt ]++      it "parse special intrinsics to arguments" $ do+        let blStmt stmt = BlStatement () u Nothing stmt+            var = ExpValue () u . ValVariable+            ext = blStmt $ StExternal () u $ AList () u [var "bar"]+            arg = Just . AList () u . pure . Argument () u Nothing+            valBar = ExpFunctionCall () u (ExpValue () u (ValIntrinsic "%val"))+                     $ arg $ var "baz"+            call = blStmt $ StCall () u (var "bar") $ arg valBar+            pu = ProgramFile mi77 [ PUSubroutine () u (Nothing, Nothing) "foo"+                                   (Just $ AList () u [var "baz"]) [ ext, call ] Nothing ]+        resetSrcSpan (pParser exampleProgram3) `shouldBe` pu+       it "parses character declarations with unspecfied lengths" $ do         let src = "      character s*(*)"             st = StDeclaration () u (TypeSpec () u (TypeCharacter Nothing Nothing) Nothing) Nothing $@@ -348,6 +368,14 @@             tgt3 = ExpSubscript () u (ExpDataRef () u (ExpValue () u (ValVariable "x")) (ExpValue () u (ValVariable "foo"))) (AList () u [mkIdx "0"])             st3 = StExpressionAssign () u tgt3 (ExpValue () u (ValInteger "0"))         resetSrcSpan (slParser src3) `shouldBe` st3+      it "parses automatic and static statements" $ do+        let decl = DeclVariable () u (varGen "x") Nothing Nothing+            autoStmt = StAutomatic () u (AList () u [decl])+            staticStmt = StStatic () u (AList () u [decl])+            autoSrc =  "      automatic x"+            staticSrc = "      static x"+        resetSrcSpan (slParser autoSrc) `shouldBe` autoStmt+        resetSrcSpan (slParser staticSrc) `shouldBe` staticStmt  exampleProgram1 :: String exampleProgram1 = unlines@@ -360,6 +388,13 @@   [ "      block data hello"   , "      integer x"   , "      end" ]++exampleProgram3 :: String+exampleProgram3 = unlines+  [ "      subroutine foo(baz)"+  , "      external bar"+  , "      call bar(%val(baz))"+  , "      end subroutine foo"]  -- Local variables: -- mode: haskell