fortran-src 0.14.0 → 0.15.0

raw patch · 5 files changed

+145/−40 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• fortran-src.cabal +1/−1
• src/Language/Fortran/Analysis/SemanticTypes.hs +11/−4
• src/Language/Fortran/Common/Array.hs +44/−13
• src/Language/Fortran/Repr/Eval/Value.hs +80/−22

@@ -1,3 +1,12 @@+### 0.15.0 (May 04, 2023)+  * handle more `INT` intrinsic forms+    [#263](https://github.com/camfort/fortran-src/pull/263)+  * add more `Language.Fortran.Common.Array` utils+    [#263](https://github.com/camfort/fortran-src/pull/263)+  * Analysis.SemanticTypes: use `type Dimensions = Dims NonEmpty (Maybe Int)`+    instead of `type Dimensions = Dims NonEmpty Int`+    [#263](https://github.com/camfort/fortran-src/pull/263)+ ### 0.14.0 (Mar 21, 2023)   * provide extended evaluated array dimensions type at     `Language.Fortran.Common.Array` (#261, @raehik)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           fortran-src-version:        0.14.0+version:        0.15.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 @<https://hackage.haskell.org/package/camfort CamFort>@ project, which uses fortran-src as its front end. category:       Language

@@ -52,7 +52,10 @@     deriving stock    (Ord, Eq, Show, Data, Generic)     deriving anyclass (NFData, Binary, Out) -type Dimensions = Dims NonEmpty Int+-- | The main dimension type is a non-empty list of dimensions where each bound+--   is @'Maybe' 'Int'@. @'Nothing'@ bounds indicate a dynamic bound (e.g. uses+--   a dummy variable).+type Dimensions = Dims NonEmpty (Maybe Int)  instance Pretty SemType where   pprint' v@@ -81,11 +84,15 @@ -- | Convert 'Dimensions' data type to its previous type synonym --   @(Maybe [(Int, Int)])@. ----- Will not return @Just []@.+-- Drops all information for array dimensions that aren't fully static/known. dimensionsToTuples :: Dimensions -> Maybe [(Int, Int)] dimensionsToTuples = \case-  DimsExplicitShape ds     ->-    Just $ NonEmpty.toList $ fmap (\(Dim lb ub) -> (lb, ub)) ds+  DimsExplicitShape ds     -> fmap NonEmpty.toList $ traverse go ds+    where+      go (Dim mlb mub) = do+          lb <- mlb+          ub <- mub+          pure $ (lb, ub)   DimsAssumedSize   _ds _d -> Nothing   DimsAssumedShape  _ss    -> Nothing 

@@ -12,6 +12,15 @@  import qualified Language.Fortran.PrettyPrint as F +-- | A single array dimension with bounds of type @a@.+--+--   * @'Num' a => 'Dim' a@ is a static, known-size dimension.+--   * @'Dim' ('Language.Fortran.AST.Expression' '()')@ is a dimension with+--     unevaluated bounds expressions. Note that these bounds may be constant+--     expressions, or refer to dummy variables, or be invalid.+--   * @'Num' a => 'Dim' ('Maybe' a)@ is a dimension where some bounds are+--     known, and others are not. This may be useful to record some information+--     about dynamic explicit-shape arrays. data Dim a = Dim   { dimLower :: a -- ^ Dimension lower bound.   , dimUpper :: a -- ^ Dimension upper bound.@@ -31,34 +40,38 @@ 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.+-- | Fortran array dimensions, defined by a list of 'Dim's storing lower and+--   upper bounds. -- -- You select the list type @t@ (which should be 'Functor', 'Foldable' and--- 'Traversable') and the numeric index type @a@ (e.g. 'Int').+-- 'Traversable') and the bound 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.+-- Using a non-empty list type such as 'Data.List.NonEmpty.NonEmpty' will+-- disallow representing zero-dimension arrays, providing extra 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.+--+-- Note that the 'Foldable' instance does not provide "dimension-like" access to+-- this type. That is, @'length' (a :: 'Dims' t a)@ will _not_ tell you how many+-- dimensions 'a' represents. Use 'dimsLength' for that. data Dims t a+  -- | Explicit-shape array. All dimensions are known.   = DimsExplicitShape       (t (Dim a)) -- ^ list of all dimensions +  -- | Assumed-size array. The final dimension has no upper bound (it is+  --   obtained from its effective argument). Earlier dimensions may be defined+  --   like explicit-shape arrays.   | DimsAssumedSize       (Maybe (t (Dim a))) -- ^ list of all dimensions except last-      a          -- ^ lower bound of last dimension+      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).+  -- | Assumed-shape array. Shape is taken from effective argument. We store the+  --   lower bound for each dimension, and thus also the rank (via list length).   | DimsAssumedShape       (t a) -- ^ list of lower bounds @@ -105,7 +118,8 @@ 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.+-- Faster is possible for non @[]@ list-likes, 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@@ -114,3 +128,20 @@  prettyAfter :: Foldable t => Pretty.Doc -> t Pretty.Doc -> Pretty.Doc prettyAfter dAfter = foldMap (\d -> d <> dAfter)++-- | Traverse over the functor in a 'Dims' value with a functor bound type.+--+-- For example, to turn a @'Dims' t ('Maybe' a)@ into a @'Maybe' ('Dims' t a)@.+dimsTraverse :: (Traversable t, Applicative f) => Dims t (f a) -> f (Dims t a)+dimsTraverse = traverse id+-- TODO provide a SPECIALIZE clause for the above Maybe case. performance! :)++-- | How many dimensions does the given 'Dims' represent?+dimsLength :: Foldable t => Dims t a -> Int+dimsLength = \case+  DimsExplicitShape ds -> length ds+  DimsAssumedShape ss -> length ss+  DimsAssumedSize mds _d ->+    case mds of+      Nothing -> 1+      Just ds -> length ds + 1

@@ -29,6 +29,7 @@ import qualified Data.Text as Text import qualified Data.Char import qualified Data.Bits+import Data.Int  import Control.Monad.Except @@ -45,11 +46,19 @@   = ENoSuchVar F.Name   | EKindLitBadType F.Name FType   | ENoSuchKindForType String FKindLit+   | EUnsupported String+  -- ^ Syntax which probably should be supported, but (currently) isn't.+   | EOp Op.Error   | EOpTypeError String++  | ESpecial String+  -- ^ Special value-like expression that we can't evaluate usefully.+   | ELazy String   -- ^ Catch-all for non-grouped errors.+     deriving stock (Generic, Show, Eq)  -- | A convenience constraint tuple defining the base requirements of the@@ -156,13 +165,13 @@     warn "requested to evaluate BOZ literal with no context: defaulting to INTEGER(4)"     pure $ FSVInt $ FInt4 $ F.bozAsTwosComp boz   F.ValHollerith s -> pure $ FSVString $ Text.pack s-  F.ValIntrinsic{} -> error "you tried to evaluate a lit, but it was an intrinsic name"-  F.ValVariable{} ->  error "you tried to evaluate a lit, but it was a variable name"-  F.ValOperator{} ->  error "you tried to evaluate a lit, but it was a custom operator name"-  F.ValAssignment ->  error "you tried to evaluate a lit, but it was an overloaded assignment name"-  F.ValStar       ->  error "you tried to evaluate a lit, but it was a star"-  F.ValColon      ->  error "you tried to evaluate a lit, but it was a colon"-  F.ValType{}     ->  error "not used anywhere, don't know what it is"+  F.ValIntrinsic{} -> err $ ESpecial "lit was ValIntrinsic{} (intrinsic name)"+  F.ValVariable{}  -> err $ ESpecial "lit was ValVariable{} (variable name)"+  F.ValOperator{}  -> err $ ESpecial "lit was ValOperator{} (custom operator name)"+  F.ValAssignment  -> err $ ESpecial "lit was ValAssignment (overloaded assignment name)"+  F.ValStar        -> err $ ESpecial "lit was ValStar"+  F.ValColon       -> err $ ESpecial "lit was ValColon"+  F.ValType{}      -> err $ ELazy "lit was ValType: not used anywhere, don't know what it is"  err :: MonadError Error m => Error -> m a err = throwError@@ -339,21 +348,20 @@             err $ EOpTypeError $                 "not: expected INT(x), got "<>show (fScalarValueType v') -      "int"  -> do-        -- TODO a real pain. just implementing common bits for now-        -- TODO gfortran actually performs some range checks for constants!-        -- @int(128, 1)@ errors with "this INT(4) is too big for INT(1)".-        args' <- forceArgs 1 args-        let [v] = args'-        v' <- forceScalar v-        case v' of-          FSVInt{} ->-            pure $ MkFScalarValue v'-          FSVReal r ->-            pure $ MkFScalarValue $ FSVInt $ FInt4 $ fRealUOp truncate r-          _ ->-            err $ EOpTypeError $-                "int: unsupported or unimplemented type: "<>show (fScalarValueType v')+      "int"  ->+        case args of+          [] -> err $ EOpTypeError $ "int: expected 1 or 2 arguments, got 0"+          [v] -> do+            -- @INT(x)@ == @INT(x, 4)@ (F2018 16.9.100:23, pg.381)+            (MkFScalarValue . FSVInt . FInt4) <$> evalIntrinsicInt4 v+          [v, vk] -> do+            vk' <- forceScalar vk+            case vk' of+              FSVInt vkI -> (MkFScalarValue . FSVInt) <$> evalIntrinsicInt v vkI+              _ ->+                err $ EOpTypeError $+                    "int: kind argument must be INTEGER, got "<>show (fScalarValueType vk')+          _ -> err $ EOpTypeError $ "int: expected 1 or 2 arguments, got >2"        -- TODO all lies       "int2" -> do@@ -371,6 +379,52 @@        _      -> err $ EUnsupported $ "function call: " <> fname +-- TODO 2023-05-03 raehik: gfortran actually performs some range checks for+-- constants! @int(128, 1)@ errors with "this INT(4) is too big for INT(1)".+-- we don't do that currently. just means more plumbing+evalIntrinsicInt :: MonadFEvalValue m => FValue -> FInt -> m FInt+evalIntrinsicInt v = fIntUOp go+  where+    go :: (MonadFEvalValue m, Num a, Eq a) => a -> m FInt+    go = \case+      1 -> FInt1 <$> evalIntrinsicInt1 v+      2 -> FInt2 <$> evalIntrinsicInt2 v+      4 -> FInt4 <$> evalIntrinsicInt4 v+      8 -> FInt8 <$> evalIntrinsicInt8 v+      _ -> err $ ELazy "int: kind argument wasn't 1, 2, 4 or 8"++-- | @INT(a, 1)@+evalIntrinsicInt1 :: MonadFEvalValue m => FValue -> m Int8+evalIntrinsicInt1 = evalIntrinsicIntXCoerce coerceToI1+  where coerceToI1 = fIntUOp' id fromIntegral fromIntegral fromIntegral++-- | @INT(a, 2)@+evalIntrinsicInt2 :: MonadFEvalValue m => FValue -> m Int16+evalIntrinsicInt2 = evalIntrinsicIntXCoerce coerceToI2+  where coerceToI2 = fIntUOp' fromIntegral id fromIntegral fromIntegral++-- | @INT(a, 4)@, @INT(a)@+evalIntrinsicInt4 :: MonadFEvalValue m => FValue -> m Int32+evalIntrinsicInt4 = evalIntrinsicIntXCoerce coerceToI4+  where coerceToI4 = fIntUOp' fromIntegral fromIntegral id fromIntegral++-- | @INT(a, 8)@+evalIntrinsicInt8 :: MonadFEvalValue m => FValue -> m Int64+evalIntrinsicInt8 = evalIntrinsicIntXCoerce coerceToI8+  where coerceToI8 = fIntUOp' fromIntegral fromIntegral fromIntegral id++evalIntrinsicIntXCoerce+    :: forall r m+    .  (MonadFEvalValue m, Integral r) => (FInt -> r) -> FValue -> m r+evalIntrinsicIntXCoerce coerceToIX v = do+    v' <- forceScalar v+    case v' of+      FSVInt  i -> pure $ coerceToIX i+      FSVReal r -> pure $ fRealUOp truncate r+      _ ->+        err $ EOpTypeError $+            "int: unsupported or unimplemented type: "<>show (fScalarValueType v')+ evalArg :: MonadFEvalValue m => F.Argument a -> m FValue evalArg (F.Argument _ _ _ ae) =     case ae of@@ -437,3 +491,7 @@           _ ->             err $ EOpTypeError $                 "max: unsupported type: "<> show (fScalarValueType vCurMax)++-- | Evaluate a constant expression (F2018 10.1.12).+evalConstExpr :: MonadFEvalValue m => F.Expression a -> m FValue+evalConstExpr = evalExpr