diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +### 0.14.0 (Mar 21, 2023) + * provide extended evaluated array dimensions type at + `Language.Fortran.Common.Array` (#261, @raehik) + * replace the previous `Dimensions` type in + `Language.Fortran.Analysis.SemanticTypes` + ### 0.13.0 (Mar 14, 2023) * better handling for line directives in free form lexer (#248, @mrd) * don't inline solo includes in relevant F77 parsers (#245, @RaoulHC) diff --git a/fortran-src.cabal b/fortran-src.cabal --- a/fortran-src.cabal +++ b/fortran-src.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: fortran-src -version: 0.13.0 +version: 0.14.0 synopsis: Parsers and analyses for Fortran standards 66, 77, 90, 95 and 2003 (partial). description: Provides lexing, parsing, and basic analyses of Fortran code covering standards: FORTRAN 66, FORTRAN 77, Fortran 90, Fortran 95, Fortran 2003 (partial) and some legacy extensions. Includes data flow and basic block analysis, a renamer, and type analysis. For example usage, see the @@ project, which uses fortran-src as its front end. category: Language @@ -80,6 +80,7 @@ Language.Fortran.AST.Literal.Boz Language.Fortran.AST.Literal.Complex Language.Fortran.AST.Literal.Real + Language.Fortran.Common.Array Language.Fortran.Intrinsics Language.Fortran.LValue Language.Fortran.Parser diff --git a/src/Language/Fortran/Analysis/SemanticTypes.hs b/src/Language/Fortran/Analysis/SemanticTypes.hs --- a/src/Language/Fortran/Analysis/SemanticTypes.hs +++ b/src/Language/Fortran/Analysis/SemanticTypes.hs @@ -1,7 +1,13 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} -module Language.Fortran.Analysis.SemanticTypes where +module Language.Fortran.Analysis.SemanticTypes + ( module Language.Fortran.Analysis.SemanticTypes + , module Language.Fortran.Common.Array + ) where +import Language.Fortran.Common.Array + import Data.Data ( Data ) import Control.DeepSeq ( NFData ) import GHC.Generics ( Generic ) @@ -14,9 +20,12 @@ import Language.Fortran.Version ( FortranVersion(..) ) import Data.Binary ( Binary ) import Text.PrettyPrint.GenericPretty ( Out(..) ) -import Text.PrettyPrint ( (<+>), parens ) import Language.Fortran.PrettyPrint ( Pretty(..) ) +import qualified Text.PrettyPrint as Pretty +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NonEmpty + type Kind = Int -- | Semantic type assigned to variables. @@ -35,9 +44,7 @@ | TCharacter CharacterLen Kind | TArray SemType Dimensions - -- ^ A Fortran array type is defined by a single type, and a set of - -- dimensions. Note that assumed-shape arrays which only "store" array rank - -- cannot be represented. + -- ^ A Fortran array type is represented by a type and a set of dimensions. | TCustom String -- ^ Constructor to use for F77 structures, F90 DDTs @@ -45,39 +52,31 @@ deriving stock (Ord, Eq, Show, Data, Generic) deriving anyclass (NFData, Binary, Out) --- TODO placeholder, not final or tested --- should really attempt to print with kind info, and change to DOUBLE PRECISION --- etc. for "integer" - TReal _ -> "real" - TComplex _ -> "complex" - TLogical _ -> "logical" - TByte _ -> "byte" - TCharacter _ _ -> "character" - TArray st _ -> pprint' v st <+> parens "(A)" - TCustom str -> pprint' v (TypeCustom str) - --- | The declared dimensions of an array variable. --- --- Each dimension is of the form @(dim_lower, dim_upper)@. --- --- This type should not be used to represent assumed-shape arrays, introduced in --- F90. They may be represented like @[Int]@ (known rank, known lower bounds). -data Dimensions - = DimensionsCons !(Int, Int) Dimensions - -- ^ Another dimension in the dimension list. - - | DimensionsEnd - -- ^ No more dimensions. +type Dimensions = Dims NonEmpty Int - | DimensionsFinalStar - -- ^ The final dimension is dynamic (represented by a star @*@ in syntax). - -- This indicates an assumed-size array. - deriving stock (Ord, Eq, Show, Data, Generic) - deriving anyclass (NFData, Binary, Out) +instance Pretty SemType where + pprint' v + | v >= Fortran90 = \case + TInteger k -> "integer"<>pd k + TReal k -> "real"<>pd k + TComplex k -> "complex"<>pd k + TLogical k -> "logical"<>pd k + TByte k -> "byte"<>pd k + TCharacter _ _ -> "character(TODO)" + TArray st dims -> pprint' v st <> pprint' v dims + TCustom str -> pprint' v (TypeCustom str) + | otherwise = \case + TInteger k -> "integer"<>ad k + TReal k -> "real"<>ad k + TComplex k -> "complex"<>ad k + TLogical k -> "logical"<>ad k + TByte k -> "byte"<>ad k + TCharacter _ _ -> "character*TODO" + TArray st dims -> pprint' v st <> pprint' v dims + TCustom str -> pprint' v (TypeCustom str) + where + pd = Pretty.parens . doc + ad k = doc '*' <> doc k -- | Convert 'Dimensions' data type to its previous type synonym -- @(Maybe [(Int, Int)])@. @@ -85,14 +84,10 @@ -- Will not return @Just []@. dimensionsToTuples :: Dimensions -> Maybe [(Int, Int)] dimensionsToTuples = \case - DimensionsCons bounds ds -> Just $ reverse $ go [bounds] ds - DimensionsEnd -> Nothing - DimensionsFinalStar -> Nothing - where - go boundss = \case - DimensionsCons bounds ds -> go (bounds:boundss) ds - DimensionsEnd -> boundss - DimensionsFinalStar -> boundss + DimsExplicitShape ds -> + Just $ NonEmpty.toList $ fmap (\(Dim lb ub) -> (lb, ub)) ds + DimsAssumedSize _ds _d -> Nothing + DimsAssumedShape _ss -> Nothing -------------------------------------------------------------------------------- diff --git a/src/Language/Fortran/Common/Array.hs b/src/Language/Fortran/Common/Array.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fortran/Common/Array.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE UndecidableInstances #-} -- required due to instance design + +module Language.Fortran.Common.Array where + +import Control.DeepSeq ( NFData ) +import GHC.Generics ( Generic ) +import Data.Data ( Data, Typeable ) +import Data.Binary ( Binary ) +import Text.PrettyPrint.GenericPretty ( Out(..) ) + +import qualified Text.PrettyPrint as Pretty + +import qualified Language.Fortran.PrettyPrint as F + +data Dim a = Dim + { dimLower :: a -- ^ Dimension lower bound. + , dimUpper :: a -- ^ Dimension upper bound. + } deriving stock (Show, Generic, Data, Eq) + deriving stock (Functor, Foldable, Traversable) + deriving anyclass (NFData, Binary) + + -- | This instance is purely for convenience. No definition of ordering is + -- provided, and the implementation may change at any time. + deriving stock Ord + +-- | Fortran syntax uses @lower:upper@, so only provide an 'Out' instance for +-- that style. +instance Out a => Out (Dim a) where + doc (Dim lb ub) = doc lb <> Pretty.char ':' <> doc ub + +instance Out (Dim a) => F.Pretty (Dim a) where + pprint' _ = doc + +-- | Evaluated dimensions of a Fortran array. +-- +-- A known-length dimension is defined by a lower bound and an upper bound. This +-- data type takes a syntactic view, rather than normalizing lower bound to 0 +-- and passing just dimension extents. +-- +-- You select the list type @t@ (which should be 'Functor', 'Foldable' and +-- 'Traversable') and the numeric index type @a@ (e.g. 'Int'). +-- +-- Note that using a non-empty list type such as 'Data.List.NonEmpty.NonEmpty' +-- will disallow representing zero-dimension arrays, which may be useful for +-- soundness. +-- +-- Note the following excerpt from the F2018 standard (8.5.8.2 Explicit-shape +-- array): +-- +-- > If the upper bound is less than the lower bound, the range is empty, the +-- > extent in that dimension is zero, and the array is of zero size. +data Dims t a + = DimsExplicitShape + (t (Dim a)) -- ^ list of all dimensions + + | DimsAssumedSize + (Maybe (t (Dim a))) -- ^ list of all dimensions except last + a -- ^ lower bound of last dimension + + -- | Assumed-shape array dimensions. Here, we only have the lower bound for + -- each dimension, and the rank (via length). + | DimsAssumedShape + (t a) -- ^ list of lower bounds + + deriving stock (Generic) + deriving stock (Functor, Foldable, Traversable) + +-- We have to standalone derive most instances due to the @t@ list-like. +deriving stock instance (Show a, Show (t a), Show (t (Dim a))) + => Show (Dims t a) +deriving anyclass instance (NFData a, NFData (t a), NFData (t (Dim a))) + => NFData (Dims t a) +deriving stock instance (Data a, Data (t a), Data (t (Dim a)), Typeable t) + => Data (Dims t a) +deriving stock instance (Eq a, Eq (t a), Eq (t (Dim a))) + => Eq (Dims t a) +deriving anyclass instance (Binary a, Binary (t a), Binary (t (Dim a))) + => Binary (Dims t a) + +-- | This instance is purely for convenience. No definition of ordering is +-- provided, and the implementation may change at any time. +deriving stock instance (Ord a, Ord (t a), Ord (t (Dim a))) + => Ord (Dims t a) + +instance (Foldable t, Functor t, Out (Dim a), Out a) + => Out (Dims t a) where + docPrec _ = doc + doc = Pretty.parens . \case + DimsExplicitShape ds -> + prettyIntersperse dimSep $ fmap doc ds + DimsAssumedShape ss -> + prettyIntersperse dimSep $ fmap go ss + where + go s = doc s <> Pretty.char ':' + DimsAssumedSize mds d -> + -- A bit fragile, but hopefully won't explode on empty 'Just's. + case mds of + Nothing -> prettyLast + Just ds -> prettyAfter dimSep (fmap doc ds) <> prettyLast + where + prettyLast = doc d <> Pretty.text ":*" + where + dimSep = Pretty.text ", " + +instance Out (Dims t a) => F.Pretty (Dims t a) where + pprint' _ = doc + +-- Faster is possible for non-@List@s, but this is OK for the general case. +prettyIntersperse :: Foldable t => Pretty.Doc -> t Pretty.Doc -> Pretty.Doc +prettyIntersperse dBetween ds = + case foldMap (\d -> [dBetween, d]) ds of + [] -> mempty + _:ds' -> mconcat ds' + +prettyAfter :: Foldable t => Pretty.Doc -> t Pretty.Doc -> Pretty.Doc +prettyAfter dAfter = foldMap (\d -> d <> dAfter) diff --git a/src/Language/Fortran/Repr/Type/Array.hs b/src/Language/Fortran/Repr/Type/Array.hs --- a/src/Language/Fortran/Repr/Type/Array.hs +++ b/src/Language/Fortran/Repr/Type/Array.hs @@ -14,6 +14,15 @@ , fatShape :: Shape } deriving stock (Generic, Data, Show, Eq, Ord) +-- | The shape of a Fortran array is a list of extents. (The rank of the array +-- is length of the list.) +-- +-- Note that the F90 standard limits maximum array rank to 7 (R512). +-- +-- TODO +-- * An empty list here feels nonsensical. Perhaps this should be NonEmpty. +-- * List type is inefficient here, since we don't care about pushing/popping, +-- and list length is important. Use a vector type instead. newtype Shape = Shape { getShape :: [Natural] } deriving stock (Generic, Data, Show, Eq, Ord)