[llvm-branch-commits] [flang] [Flang] KIND De-templatization (PR #216960)
Michael Kruse via llvm-branch-commits
llvm-branch-commits at lists.llvm.org
Tue Aug 18 01:49:23 PDT 2026
https://github.com/Meinersbur created https://github.com/llvm/llvm-project/pull/216960
Avoid template instantiation based on a type's kind, but pass the kind as runtime value. The cross-product of template instantiations (including nested `visit` calls of methods that are already per-kind) leads to super-linear compile-time bloat.
For more details, see the RFC: https://discourse.llvm.org/t/rfc-the-cost-of-templates-when-building-flang/91197.
By its nature, this patch is large, like the renaming of a central type would be. These kind of refactoring cannot be easily split up. However, it has already been split up into the following PR stack:
* #212956
* #206907 (this PR)
Feel free to suggest what else could be *feasibly* split off.
### Implementation notes
* The conversion is meant to be mostly mechanical, wherever possible. That is, the following rules were applied:
1. If a function implementation is independent of KIND, just remove the template argument
2. If another object is passed as argument (or exists as a field of the class) with the same KIND, get KIND from its `.kind()` method, and store it in a variable `const int kind`.
3. Otherwise, add a `kind` argument as the *first* function argument.
4. For class template arguments, implement a `kind()` method from another member that has the same `KIND` template parameter. This can be a `std::variant` case.
5. If there is none, introduce a `int kind_;` member.
`kind` as the first argument is because as a template parameter, it is written before all function arguments. But mostly I seriously confused myself with optional arguments. Having it as first function argument provides consistency.
* Most of the time KIND was part of a `Type<CAT,KIND>` template argument. This was reduced to `Type<CAT>` with a `kind_` runtime member.
* Some classes already had `GetKind()` methods. I canonicalized them to `kind()`
* Predefined Types such as `SubscriptInteger` now also have a corresponding `SubscriptIntegerKind`.
* Uses of `TypeCategory::Derived` have to use a kind of 0. In every other case it must be non-zero.
* Some `kind()` methods, such as `ProcedureRef::kind()` only exist because the compiler requires them to exist; they are never actually called.
* Propagation of kinds is checked for consistency with `CHECK` and `CHECK_KIND`. Consistency here means that it must have the same kind as the KIND template-parameter would have. For instance, two function arguments that originally have the same KIND template parameter, must pass `CHECK(x.kind() == y.kind())`.
* There are reoccuring idioms such as `Expr<T>{Constant<T>{Scalar<T>{c}}}` (sometime implicit through conversions). Each of these may need a new `kind` function argument. To avoid it being repeated up to three times on the same lines, I introduced helpers such as `MakeConstantExpr` to pass it just once. Some of them like `MakeExtentExpr` already existed. Most of the time this makes the statements shorter than even before KIND-detemplatiziation.
* A mechanical translation wasn't possible everywhere. Here are the most notable cases:
1. `common::SearchTypes` moved to `evaluate::SearchTypes`; despite the name `SearchTypes` was in "common", but the actual types to iterate through were provided by the caller. With this PR the caller can only decide a TypeCategory, the possible kinds are known by `evaluate::SearchTypes` itself. Since it know gained domain knowledge, I moved it out of `common`.
2. `lower::HashEvaluateExpr` uses the kind in its hash value and considers expressions with different kind to be unequal.
3. Naively, `match.h` would also require matching the kind of an expression, but it is only called with the same kinds anyway.
4. `ComplexPartExtractor` is dead code and doesn't even compile. It doesn't cause a build failure only because it was a template and thus the compiler skipped verifying it. With removing the template state, I had to delete this code.
* The original classes holding scalar constant values (`Integer`, `Real`, `Complex`, `Logical`, `std::basic_string<>`) are heavily template-dependent. They represent the value of a constant. With the code not being instantiated per-KIND anymore, the value must keep enough storage for any possible value. In Clang/LLVM/MLIR this is done with `APInt` and `APFloat`, in this PR it is a `std::variant` of the original scalar scalar.
| Original Scalar Class | KIND-Independent Class | Implementation | pImpl class |
|---------------|------------------------|----------------------------------------------------|--------------------|
| Integer | IntegerValue | `std::variant<I8,I16,I32,I64,I10,I80,I128>` | IntegerValueImpl |
| Logical | LogicalValue | `IntegerValue` | |
| Real | RealValue | `std::variant<R2,R3,R4,R8,R10,R16>` | RealValueImpl |
| Complex | ComplexValue | `RealValue re,im` | |
| | CharacterValue | `std::variant<std::string,std::u16string,std::u32string>` | CharacterValueImpl |
* The `std::variant` also has a "monostate" state which represents a default-initialized value of unknown kind (e.g. `Integer` is default-initialized to zero). To be able to replace `Integer`, `IntegerValue` also needs to default-initializable for uses such as `std::vector<IntegerValue>` to be possible.
* There is no original class representing values for variable of type CHARACTER. Instead, they have been representing compile-time dependent by `std::string`, `std::u16string`,`std::u32string` and handled with static methods in `CharacterUtils` in `character.h`. This makes it impossible to add a common interface such as a `kind()` method. This PR introduces `CharacterValue` as a value storage for CHARACTER.
* The endianness customization of the original scalar classes is unused: `IS_LITTLE_ENDIAN` always follows the host's endian format. That's a problem for `initial-image.cpp/.h` which should follow the target's endian. It contains a "TODO endianness". By the design of it, it seems that the idea once was that the binary representation of the scalars should be identical to what it would be on the target machine. This is incompatible with using reinterpret_cast in `host.h`. Even when not considering endianness, this is not true because x87 floating points are aligned to 16 bytes, but some targets align it to 4 bytes only. I think the better approach is to always use host-native alignment, and convert endianness in dedicated data load/store routines only. This allows using the host's native instructions set, and is also what Clang does with `llvm::APInt`, and every networking code I know of (`htonj`, `ntohl`, ...).
* The scalar classes are all used in `Evaluate/type.h` which is the central header for FortranEvaluate and therefore included into almost everything except maybe the FortranParser. To reduce the build time cost, the implementation details of the scalar classes are hidden using a pImpl-like idiom. Instead of a pointer to a heap-allocated object, it uses a reinterpret_cast of the object itself. For this work the sizes of both objects must be identical. It is determined ahead of the build using the `object-size-probe` executable.
* While this PR is NFCI (No Functional Change Intended), it includes some AI-generated regression tests, that it found to not yet be covered during the creation of this PR. It also includes #213573 and #208760. All tests should pass without this PR as well.
### Followup-Work
* Cleanup: Some purely mechanical changes allow a larger cleanup. For instance, now many `evaluate::SearchTypes` only iterate over a single TypeCategory, i.e. the entire mechanism becomes superfluous. If left them to not make this PR larger than it already is.
* The monostate of the scalar classes could be removed again if we compromise to a default kind. For now I did not want to add such implicit assumptions that would requires a closer review rather than mechanical correctness.
* The added `CHECK` and check `CHECK_KIND` are mostly used to verify the that the runtime kind matches the original KIND template parameter. With further changes, this invariant may not need to be upheld anymore.
* Some `kind` arguments are only needed to `CHECK` or to propagate it correctly. It may be possible to remove them again, such as for `Constant<T>` which could get the kind from the scalar passed to it. In this case, the scalar could be in monostate, such that it is not yet a reliable source for kind.
* Some type declaration became pointless, such as `Int1` and `Int8`, which now are the same type.
* `Type<CAT>` could be replaced globally with just `TypeCategory` when used as a template parameter. When instantiated, it acts like `DynamicType`, but with static `TypeCatergory`.
* IntegerValueImpl could be replaces with APInt and RealValueImpl with APFloat. I don't see the point why Flang should maintain its own arbitrary precision integer/floating point library, if LLVM already has one.
Assisted-by: AI (Claude, ChatGPT, Composer)
>From 9770edc6bbd7b07b0ccc9885624cc2e83cbc3eb8 Mon Sep 17 00:00:00 2001
From: Michael Kruse <llvm-project at meinersbur.de>
Date: Tue, 11 Aug 2026 02:29:10 +0200
Subject: [PATCH 1/9] [Flang] KIND De-templatization
---
flang/CMakeLists.txt | 1 +
flang/include/flang/Common/template.h | 32 -
flang/include/flang/Evaluate/call.h | 25 +-
.../include/flang/Evaluate/character-value.h | 196 ++++++
.../include/flang/Evaluate/characteristics.h | 3 +-
flang/include/flang/Evaluate/common.h | 7 +
flang/include/flang/Evaluate/complex-value.h | 166 +++++
flang/include/flang/Evaluate/complex.h | 114 ----
flang/include/flang/Evaluate/constant.h | 108 +++-
flang/include/flang/Evaluate/expression.h | 410 ++++++++----
.../include/flang/Evaluate/fold-designator.h | 10 +-
flang/include/flang/Evaluate/fold.h | 29 +-
flang/include/flang/Evaluate/initial-image.h | 43 +-
flang/include/flang/Evaluate/integer-value.h | 318 +++++++++
flang/include/flang/Evaluate/logical-value.h | 153 +++++
flang/include/flang/Evaluate/logical.h | 110 ----
flang/include/flang/Evaluate/match.h | 17 +-
flang/include/flang/Evaluate/object-sizes.h | 81 +++
flang/include/flang/Evaluate/real-value.h | 237 +++++++
flang/include/flang/Evaluate/rewrite.h | 19 +-
flang/include/flang/Evaluate/shape.h | 22 +-
flang/include/flang/Evaluate/static-data.h | 1 +
flang/include/flang/Evaluate/tools.h | 234 ++++---
flang/include/flang/Evaluate/type.h | 261 +++++---
flang/include/flang/Evaluate/variable.h | 52 +-
flang/include/flang/Lower/DirectivesCommon.h | 19 +-
flang/include/flang/Lower/Mangler.h | 19 +-
flang/include/flang/Lower/Support/Utils.h | 16 +-
flang/include/flang/Semantics/dump-expr.h | 6 +-
flang/include/flang/Semantics/scope.h | 3 +-
flang/include/flang/Semantics/type.h | 2 +
flang/lib/Evaluate/CMakeLists.txt | 17 +-
flang/lib/Evaluate/call.cpp | 3 +-
flang/lib/Evaluate/character-value-impl.cpp | 577 +++++++++++++++++
flang/lib/Evaluate/character-value-impl.h | 229 +++++++
flang/lib/Evaluate/character-value.cpp | 215 ++++++
flang/lib/Evaluate/character.h | 40 +-
flang/lib/Evaluate/characteristics.cpp | 8 +-
flang/lib/Evaluate/check-expression.cpp | 30 +-
flang/lib/Evaluate/common.cpp | 6 +
flang/lib/Evaluate/complex-value.cpp | 182 ++++++
flang/lib/Evaluate/complex.cpp | 136 ----
flang/lib/Evaluate/constant.cpp | 96 +--
flang/lib/Evaluate/expression.cpp | 107 +--
flang/lib/Evaluate/fold-character.cpp | 83 +--
flang/lib/Evaluate/fold-complex.cpp | 37 +-
flang/lib/Evaluate/fold-designator.cpp | 26 +-
flang/lib/Evaluate/fold-implementation.h | 593 ++++++++++-------
flang/lib/Evaluate/fold-integer.cpp | 610 ++++++++++--------
flang/lib/Evaluate/fold-logical.cpp | 558 ++++++----------
flang/lib/Evaluate/fold-matmul.h | 11 +-
flang/lib/Evaluate/fold-real.cpp | 169 ++---
flang/lib/Evaluate/fold-reduction.cpp | 5 +-
flang/lib/Evaluate/fold-reduction.h | 99 +--
flang/lib/Evaluate/fold.cpp | 8 +-
flang/lib/Evaluate/formatting.cpp | 71 +-
flang/lib/Evaluate/host.h | 101 ++-
flang/lib/Evaluate/initial-image.cpp | 84 +--
flang/lib/Evaluate/int-power.h | 10 +-
flang/lib/Evaluate/integer-value-impl.cpp | 583 +++++++++++++++++
flang/lib/Evaluate/integer-value-impl.h | 308 +++++++++
flang/lib/Evaluate/integer-value.cpp | 304 +++++++++
flang/lib/Evaluate/intrinsics-library.cpp | 16 +-
flang/lib/Evaluate/logical-value.cpp | 25 +
flang/lib/Evaluate/logical.cpp | 17 -
flang/lib/Evaluate/real-value-impl.cpp | 538 +++++++++++++++
flang/lib/Evaluate/real-value-impl.h | 266 ++++++++
flang/lib/Evaluate/real-value.cpp | 264 ++++++++
flang/lib/Evaluate/shape.cpp | 94 +--
flang/lib/Evaluate/static-data.cpp | 6 +
flang/lib/Evaluate/target.cpp | 38 +-
flang/lib/Evaluate/tools.cpp | 371 +++++------
flang/lib/Evaluate/type.cpp | 26 +-
flang/lib/Evaluate/variable.cpp | 39 +-
flang/lib/Lower/Bridge.cpp | 3 +-
flang/lib/Lower/CallInterface.cpp | 5 +-
flang/lib/Lower/ConvertArrayConstructor.cpp | 36 +-
flang/lib/Lower/ConvertConstant.cpp | 187 +++---
flang/lib/Lower/ConvertExprToHLFIR.cpp | 211 +++---
flang/lib/Lower/ConvertType.cpp | 38 +-
flang/lib/Lower/OpenMP/OpenMP.cpp | 4 +-
flang/lib/Lower/Support/Utils.cpp | 231 +++----
flang/lib/Semantics/check-call.cpp | 2 +-
flang/lib/Semantics/check-case.cpp | 40 +-
flang/lib/Semantics/check-coarray.cpp | 2 +-
flang/lib/Semantics/check-data.cpp | 2 +-
flang/lib/Semantics/check-io.h | 7 +-
flang/lib/Semantics/check-omp-atomic.cpp | 29 +-
flang/lib/Semantics/check-omp-structure.cpp | 2 +-
flang/lib/Semantics/data-to-inits.cpp | 4 +-
flang/lib/Semantics/dump-expr.cpp | 9 +-
flang/lib/Semantics/expression.cpp | 173 ++---
flang/lib/Semantics/openmp-utils.cpp | 4 +-
flang/lib/Semantics/pointer-assignment.cpp | 4 +-
flang/lib/Semantics/resolve-names-utils.cpp | 6 +-
flang/lib/Semantics/resolve-names.cpp | 39 +-
flang/lib/Semantics/runtime-type-info.cpp | 86 +--
flang/lib/Semantics/scope.cpp | 9 +-
flang/lib/Semantics/semantics.cpp | 4 +-
flang/lib/Semantics/type.cpp | 20 +-
flang/test/Evaluate/fold-ibits.f90 | 29 +
.../test/Evaluate/fold-real-storage-size.f90 | 24 +
.../Evaluate/fold-real10-storage-size.f90 | 41 ++
flang/test/Evaluate/fold-transfer-partial.f90 | 71 ++
flang/test/Lower/constant-literal-kinds.f90 | 63 ++
flang/tools/CMakeLists.txt | 1 +
flang/tools/object-size-probe/CMakeLists.txt | 42 ++
.../object-size-probe/object-size-probe.cpp | 99 +++
flang/unittests/CMakeLists.txt | 8 +
flang/unittests/Evaluate/expression.cpp | 23 +-
flang/unittests/Evaluate/folding.cpp | 27 +-
flang/unittests/Evaluate/intrinsics.cpp | 204 +++---
flang/unittests/Evaluate/logical.cpp | 57 +-
flang/unittests/Evaluate/real.cpp | 17 +-
114 files changed, 8403 insertions(+), 3180 deletions(-)
create mode 100644 flang/include/flang/Evaluate/character-value.h
create mode 100644 flang/include/flang/Evaluate/complex-value.h
delete mode 100644 flang/include/flang/Evaluate/complex.h
create mode 100644 flang/include/flang/Evaluate/integer-value.h
create mode 100644 flang/include/flang/Evaluate/logical-value.h
delete mode 100644 flang/include/flang/Evaluate/logical.h
create mode 100644 flang/include/flang/Evaluate/object-sizes.h
create mode 100644 flang/include/flang/Evaluate/real-value.h
create mode 100644 flang/lib/Evaluate/character-value-impl.cpp
create mode 100644 flang/lib/Evaluate/character-value-impl.h
create mode 100644 flang/lib/Evaluate/character-value.cpp
create mode 100644 flang/lib/Evaluate/complex-value.cpp
delete mode 100644 flang/lib/Evaluate/complex.cpp
create mode 100644 flang/lib/Evaluate/integer-value-impl.cpp
create mode 100644 flang/lib/Evaluate/integer-value-impl.h
create mode 100644 flang/lib/Evaluate/integer-value.cpp
create mode 100644 flang/lib/Evaluate/logical-value.cpp
delete mode 100644 flang/lib/Evaluate/logical.cpp
create mode 100644 flang/lib/Evaluate/real-value-impl.cpp
create mode 100644 flang/lib/Evaluate/real-value-impl.h
create mode 100644 flang/lib/Evaluate/real-value.cpp
create mode 100644 flang/test/Evaluate/fold-real-storage-size.f90
create mode 100644 flang/test/Evaluate/fold-real10-storage-size.f90
create mode 100644 flang/test/Evaluate/fold-transfer-partial.f90
create mode 100644 flang/test/Lower/constant-literal-kinds.f90
create mode 100644 flang/tools/object-size-probe/CMakeLists.txt
create mode 100644 flang/tools/object-size-probe/object-size-probe.cpp
diff --git a/flang/CMakeLists.txt b/flang/CMakeLists.txt
index 0c5a690f8712f..5a3b7c1d378be 100644
--- a/flang/CMakeLists.txt
+++ b/flang/CMakeLists.txt
@@ -301,6 +301,7 @@ endif()
set(LLVM_BUILD_TOOLS ON)
include_directories(BEFORE
+ ${FLANG_BINARY_DIR}/include/object-sizes/$<CONFIG>
${FLANG_BINARY_DIR}/include
${FLANG_SOURCE_DIR}/include)
diff --git a/flang/include/flang/Common/template.h b/flang/include/flang/Common/template.h
index 6501994133759..cf7ddd02cbfa5 100644
--- a/flang/include/flang/Common/template.h
+++ b/flang/include/flang/Common/template.h
@@ -289,37 +289,5 @@ std::optional<R> MapOptional(R (*f)(A &&...), std::optional<A> &&...x) {
return MapOptional(std::function<R(A && ...)>{f}, std::move(x)...);
}
-// Given a VISITOR class of the general form
-// struct VISITOR {
-// using Result = ...;
-// using Types = std::tuple<...>;
-// template<typename T> Result Test() { ... }
-// };
-// SearchTypes will traverse the element types in the tuple in order
-// and invoke VISITOR::Test<T>() on each until it returns a value that
-// casts to true. If no invocation of Test succeeds, SearchTypes will
-// return a default value.
-template <std::size_t J, typename VISITOR>
-common::IfNoLvalue<typename VISITOR::Result, VISITOR> SearchTypesHelper(
- VISITOR &&visitor, typename VISITOR::Result &&defaultResult) {
- using Tuple = typename VISITOR::Types;
- if constexpr (J < std::tuple_size_v<Tuple>) {
- if (auto result{visitor.template Test<std::tuple_element_t<J, Tuple>>()}) {
- return result;
- }
- return SearchTypesHelper<J + 1, VISITOR>(
- std::move(visitor), std::move(defaultResult));
- } else {
- return std::move(defaultResult);
- }
-}
-
-template <typename VISITOR>
-common::IfNoLvalue<typename VISITOR::Result, VISITOR> SearchTypes(
- VISITOR &&visitor,
- typename VISITOR::Result defaultResult = typename VISITOR::Result{}) {
- return SearchTypesHelper<0, VISITOR>(
- std::move(visitor), std::move(defaultResult));
-}
} // namespace Fortran::common
#endif // FORTRAN_COMMON_TEMPLATE_H_
diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h
index f04ec6c373c88..5001fbc85920e 100644
--- a/flang/include/flang/Evaluate/call.h
+++ b/flang/include/flang/Evaluate/call.h
@@ -296,6 +296,11 @@ struct SpecificIntrinsic {
};
struct ProcedureDesignator {
+ static int kind() {
+ llvm_unreachable("This class has no kind");
+ return 0;
+ }
+
EVALUATE_UNION_CLASS_BOILERPLATE(ProcedureDesignator)
explicit ProcedureDesignator(SpecificIntrinsic &&i) : u{std::move(i)} {}
explicit ProcedureDesignator(const Symbol &n) : u{n} {}
@@ -333,6 +338,11 @@ using Chevrons = std::vector<Expr<SomeType>>;
class ProcedureRef {
public:
+ static int kind() {
+ llvm_unreachable("This class has no kind");
+ return 0;
+ }
+
CLASS_BOILERPLATE(ProcedureRef)
ProcedureRef(ProcedureDesignator &&p, ActualArguments &&a,
bool hasAlternateReturns = false)
@@ -393,15 +403,19 @@ class ProcedureRef {
template <typename A> class FunctionRef : public ProcedureRef {
public:
+ constexpr int kind() const { return kind_; }
+
using Result = A;
CLASS_BOILERPLATE(FunctionRef)
- explicit FunctionRef(ProcedureRef &&pr) : ProcedureRef{std::move(pr)} {}
- FunctionRef(ProcedureDesignator &&p, ActualArguments &&a)
- : ProcedureRef{std::move(p), std::move(a)} {}
+
+ explicit FunctionRef(int kind, ProcedureRef &&pr)
+ : ProcedureRef{std::move(pr)}, kind_{kind} {}
+ FunctionRef(int kind, ProcedureDesignator &&p, ActualArguments &&a)
+ : ProcedureRef{std::move(p), std::move(a)}, kind_{kind} {}
std::optional<DynamicType> GetType() const {
if constexpr (IsLengthlessIntrinsicType<A>) {
- return A::GetType();
+ return DynamicType{A::category, kind_};
} else if (auto type{proc_.GetType()}) {
// TODO: Non constant explicit length parameters of PDTs result should
// likely be dropped too. This is not as easy as for characters since some
@@ -413,6 +427,9 @@ template <typename A> class FunctionRef : public ProcedureRef {
return std::nullopt;
}
}
+
+private:
+ int kind_;
};
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_CALL_H_
diff --git a/flang/include/flang/Evaluate/character-value.h b/flang/include/flang/Evaluate/character-value.h
new file mode 100644
index 0000000000000..aff74cf8a5cb1
--- /dev/null
+++ b/flang/include/flang/Evaluate/character-value.h
@@ -0,0 +1,196 @@
+//===-- include/flang/Evaluate/character-value.h ----------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_EVALUATE_CHAR_VALUE_H_
+#define FORTRAN_EVALUATE_CHAR_VALUE_H_
+
+#include "flang/Evaluate/common.h"
+#include "flang/Evaluate/object-sizes.h"
+#include <cstddef>
+#include <iosfwd>
+#include <optional>
+#include <string>
+
+namespace Fortran::evaluate::value {
+class CharacterValueImpl;
+
+/// A character string with dynamic character representation with
+/// std::basic_string-like API.
+///
+/// The character type is dynamic between char, char16_t, and char32_t. As being
+/// able to represent all values, char32_t is used when passing single
+/// characters. It is also kind-aware, i.e. knows which CHARACTER kind it
+/// currently represents.
+///
+/// The implementation is hidden from this header using a pImpl-like idiom.
+class CharacterValue {
+public:
+ /// A default-initialized CharacterValue is in a so-called "monostate"; it
+ /// represents an empty string, but its kind is not yet known. Not all
+ /// operations are supported in this state.
+ CharacterValue();
+
+ // rule-of-five
+ ~CharacterValue();
+ CharacterValue(const CharacterValue &);
+ CharacterValue(CharacterValue &&);
+ CharacterValue &operator=(const CharacterValue &);
+ CharacterValue &operator=(CharacterValue &&);
+
+ // ctors
+ explicit CharacterValue(int kind, std::string s);
+ explicit CharacterValue(int kind, std::u16string s);
+ explicit CharacterValue(int kind, std::u32string s);
+
+ /// Fill constructor: create a string of n copies of the given character.
+ CharacterValue(int kind, std::size_t n, char32_t c);
+
+ // Named ctors
+ static CharacterValue Zero(int kind);
+ static CharacterValue FromRawBytes(
+ int kind, const void *raw, size_t byteSize);
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+ LLVM_DUMP_METHOD void dump() const;
+#endif
+
+ /// Whether this object represents a default-initialized value (zero) of
+ /// not-yet-known kind.
+ bool IsMonostate() const;
+
+ /// The kind of the value currently stored.
+ int kind() const;
+
+ bool empty() const;
+ std::size_t size() const;
+ std::size_t length() const { return size(); }
+
+ /// Byte size of one character unit (1, 2, or 4).
+ std::size_t charSize() const { return kind(); }
+
+ /// Number of bytes accessed by FromRawBytes/StoreRawBytes
+ size_t bytesStored() const { return length() * kind(); }
+
+ // Casting to other representations
+ std::optional<llvm::StringRef> AsStringRef() const;
+ std::optional<std::string> AsStdString() const {
+ if (auto str{AsStringRef()}) {
+ return str->str();
+ }
+ return std::nullopt;
+ }
+ std::optional<std::u16string> AsU16String() const;
+ std::optional<std::u32string> AsU32String() const;
+
+ // Comparisons
+ Ordering Compare(const CharacterValue &y) const;
+ bool operator<(const CharacterValue &y) const;
+ bool operator<=(const CharacterValue &y) const { return !(y < *this); }
+ bool operator==(const CharacterValue &y) const;
+ bool operator!=(const CharacterValue &y) const { return !(*this == y); }
+ bool operator>=(const CharacterValue &y) const { return !(*this < y); }
+ bool operator>(const CharacterValue &y) const { return y < *this; }
+
+ CharacterValue ToAscii(int kind) const;
+
+ /// Assign n copies of the given character, fixing the kind from the char
+ /// type.
+ void assign(int kind, std::size_t n, char32_t c);
+
+ /// Assign from a raw character pointer and length.
+ void assign(const char *p, std::size_t n);
+ void assign(const char16_t *p, std::size_t n);
+ void assign(const char32_t *p, std::size_t n);
+
+ /// Erase from position pos to end.
+ void erase(std::size_t pos);
+
+ /// Append n copies of the given character (widened to the stored type).
+ void append(std::size_t n, char32_t c);
+
+ /// Replace the substring [pos, pos+len) with characters from other.
+ CharacterValue &replace(
+ std::size_t pos, std::size_t len, const CharacterValue &other);
+
+ /// Return a suffix starting at pos.
+ CharacterValue substr(std::size_t pos) const;
+
+ /// Return a substring of len characters starting at pos.
+ CharacterValue substr(std::size_t pos, std::size_t len) const;
+
+ /// Reserve storage for at least n characters.
+ void reserve(std::size_t n);
+
+ /// Return the character at position i
+ char32_t operator[](std::size_t i) const;
+
+ /// Concatenate two same-kind strings.
+ CharacterValue operator+(const CharacterValue &y) const;
+
+ /// Append another same-kind string.
+ CharacterValue &operator+=(const CharacterValue &y);
+
+ /// Append a character, converting it to the string's element type.
+ CharacterValue &operator+=(char c);
+
+ /// Sentinel value for "not found" positions (same as std::string::npos).
+ static constexpr std::size_t npos{std::string::npos};
+
+ // Find-family methods; return npos when not found.
+ std::size_t find(const CharacterValue &pattern) const;
+ std::size_t rfind(const CharacterValue &pattern) const;
+ std::size_t find_first_of(const CharacterValue &set) const;
+ std::size_t find_last_of(const CharacterValue &set) const;
+ std::size_t find_first_not_of(char32_t c) const;
+ std::size_t find_last_not_of(char32_t c) const;
+ std::size_t find_first_not_of(const CharacterValue &set) const;
+ std::size_t find_last_not_of(const CharacterValue &set) const;
+
+ /// Raw byte pointer to the underlying character data
+ void *data();
+ const void *data() const;
+
+ /// Like data(), but pre-casted to char
+ char *charData() { return static_cast<char *>(data()); }
+ const char *charData() const { return static_cast<const char *>(data()); }
+
+ void *at(size_t pos) { return &charData()[pos * charSize()]; }
+ const void *at(size_t pos) const { return &charData()[pos * charSize()]; }
+
+ void StoreRawBytes(void *dst, size_t size, bool *changed = nullptr) const;
+
+ template <typename F> decltype(auto) withStdString(F &&f) const {
+ switch (kind()) {
+ case 1:
+ return f(*AsStdString());
+ case 2:
+ return f(*AsU16String());
+ case 4:
+ return f(*AsU32String());
+ default:
+ llvm_unreachable("unsupported KIND");
+ }
+ }
+
+private:
+ static CharacterValue FromImpl(const CharacterValueImpl &y);
+ static CharacterValue FromImpl(CharacterValueImpl &&y);
+
+ CharacterValueImpl &impl() {
+ return *reinterpret_cast<CharacterValueImpl *>(this);
+ }
+ const CharacterValueImpl &impl() const {
+ return *reinterpret_cast<const CharacterValueImpl *>(this);
+ }
+
+ [[maybe_unused]] alignas(
+ detail::kCharacterObjectAlign) char opaque_[detail::kCharacterObjectSize];
+};
+
+} // namespace Fortran::evaluate::value
+#endif // FORTRAN_EVALUATE_CHAR_VALUE_H_
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 1ba0bf693c763..492a128ab10f1 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -118,9 +118,8 @@ class TypeAndShape {
}
// Specialization for character designators
- template <int KIND>
static std::optional<TypeAndShape> Characterize(
- const Designator<Type<TypeCategory::Character, KIND>> &x,
+ const Designator<Type<TypeCategory::Character>> &x,
FoldingContext &context, bool invariantOnly = true) {
const auto *symbol{UnwrapWholeSymbolOrComponentDataRef(x)};
if (symbol && !symbol->owner().IsDerivedType()) { // Whole variable
diff --git a/flang/include/flang/Evaluate/common.h b/flang/include/flang/Evaluate/common.h
index 6adf395442edf..7368a424b46b1 100644
--- a/flang/include/flang/Evaluate/common.h
+++ b/flang/include/flang/Evaluate/common.h
@@ -34,6 +34,10 @@ namespace Fortran::evaluate {
class IntrinsicProcTable;
class TargetCharacteristics;
+namespace value {
+class CharacterValue;
+}
+
using common::ConstantSubscript;
using common::RealFlag;
using common::RealFlags;
@@ -74,6 +78,9 @@ static constexpr Ordering Compare(
}
}
+Ordering Compare(
+ const value::CharacterValue &x, const value::CharacterValue &y);
+
static constexpr Ordering Reverse(Ordering ordering) {
if (ordering == Ordering::Less) {
return Ordering::Greater;
diff --git a/flang/include/flang/Evaluate/complex-value.h b/flang/include/flang/Evaluate/complex-value.h
new file mode 100644
index 0000000000000..9fc1b7eeb8fe6
--- /dev/null
+++ b/flang/include/flang/Evaluate/complex-value.h
@@ -0,0 +1,166 @@
+//===-- include/flang/Evaluate/complex-value.h ------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_EVALUATE_COMPLEX_VALUE_H_
+#define FORTRAN_EVALUATE_COMPLEX_VALUE_H_
+
+#include "real-value.h"
+
+namespace llvm {
+class raw_ostream;
+}
+
+namespace Fortran::evaluate::value {
+
+/// A complex floating-point value with dynamic precision.
+///
+/// The precision is dynamic, but only a predefined set of Fortran kinds are
+/// allowed. It is also kind-aware, i.e. knows which COMPLEX kind it currently
+/// represents.
+///
+/// The implementation is a pair of RealValue objects.
+class ComplexValue {
+public:
+ ComplexValue() = default;
+ ComplexValue(const ComplexValue &) = default;
+ ComplexValue(ComplexValue &&) = default;
+ ComplexValue &operator=(const ComplexValue &) = default;
+ ComplexValue &operator=(ComplexValue &&) = default;
+
+ ComplexValue(const RealValue &r, const RealValue &i)
+ : re_{r},
+ im_{r.IsMonostate() ? i : RealValue::Convert(r.kind(), i).value} {}
+
+ explicit ComplexValue(const RealValue &r)
+ : ComplexValue{r, RealValue::Zero(r.kind())} {}
+
+ ComplexValue(int kind, const RealValue &r) : ComplexValue{r} {
+ CHECK(kind == r.kind());
+ }
+
+ ComplexValue(int kind, const ComplexValue &v) : ComplexValue{v} {
+ CHECK(kind == v.kind());
+ }
+
+ ComplexValue(int kind, ComplexValue &&v) : ComplexValue{std::move(v)} {
+ CHECK(kind == v.kind());
+ }
+
+ /// Creates a complex value (+0.0 + +0.0i) of a given kind. This is
+ /// different from the default-ctor which creates a "monostate" that
+ /// represents zero of unknown kind.
+ static ComplexValue Zero(int kind) {
+ RealValue zero{RealValue::Zero(kind)};
+ return ComplexValue{zero, zero};
+ }
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+ LLVM_DUMP_METHOD void dump() const;
+#endif
+
+ /// Whether this object represents a default-initialized value (zero) of
+ /// not-yet-known kind.
+ bool IsMonostate() const {
+ CHECK(re_.IsMonostate() == im_.IsMonostate());
+ return re_.IsMonostate();
+ }
+
+ /// The kind of the value currently stored.
+ int kind() const {
+ CHECK(re_.kind() == im_.kind());
+ return re_.kind();
+ }
+
+ /// Number of bytes accessed by FromRawBytes/StoreRawBytes
+ std::size_t bytesStored() const {
+ return re_.bytesStored() + im_.bytesStored();
+ }
+ static std::size_t bytesStored(int kind) {
+ return 2 * RealValue::bytesStored(kind);
+ }
+
+ RealValue REAL() const { return re_; }
+
+ RealValue AIMAG() const { return im_; }
+
+ ComplexValue CONJG() const { return ComplexValue{re_, im_.Negate()}; }
+
+ ComplexValue Negate() const {
+ return ComplexValue{re_.Negate(), im_.Negate()};
+ }
+
+ bool Equals(const ComplexValue &y) const {
+ return re_.Compare(y.re_) == Relation::Equal &&
+ im_.Compare(y.im_) == Relation::Equal;
+ }
+
+ bool operator==(const ComplexValue &y) const {
+ return re_ == y.re_ && im_ == y.im_;
+ }
+
+ bool operator!=(const ComplexValue &y) const { return !(*this == y); }
+
+ bool IsZero() const { return re_.IsZero() && im_.IsZero(); }
+
+ bool IsInfinite() const { return re_.IsInfinite() || im_.IsInfinite(); }
+
+ bool IsNotANumber() const { return re_.IsNotANumber() || im_.IsNotANumber(); }
+
+ bool IsSignalingNaN() const {
+ return re_.IsSignalingNaN() || im_.IsSignalingNaN();
+ }
+
+ static ValueWithRealFlags<ComplexValue> FromInteger(int kind,
+ const IntegerValue &n, bool isUnsigned = false,
+ Rounding rounding = TargetCharacteristics::defaultRounding);
+
+ ValueWithRealFlags<ComplexValue> Add(const ComplexValue &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ ValueWithRealFlags<ComplexValue> Subtract(const ComplexValue &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<ComplexValue> Multiply(const ComplexValue &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<ComplexValue> Divide(const ComplexValue &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ ValueWithRealFlags<ComplexValue> KahanSummation(const ComplexValue &y,
+ ComplexValue &correction,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ /// ABS/CABS = HYPOT(re_, imag_) = SQRT(re_**2 + im_**2)
+ ValueWithRealFlags<RealValue> ABS(
+ Rounding rounding = TargetCharacteristics::defaultRounding) const {
+ return re_.HYPOT(im_, rounding);
+ }
+
+ ComplexValue FlushSubnormalToZero() const {
+ return ComplexValue{re_.FlushSubnormalToZero(), im_.FlushSubnormalToZero()};
+ }
+
+ static ComplexValue NotANumber(int kind) {
+ return {RealValue::NotANumber(kind), RealValue::NotANumber(kind)};
+ }
+
+ std::string DumpHexadecimal() const;
+
+ llvm::raw_ostream &AsFortran(llvm::raw_ostream &, int kind) const;
+
+ void StoreRawBytes(void *dst, size_t size, bool *changed = nullptr) const;
+
+ static ComplexValue FromRawBytes(
+ int kind, const void *raw, std::size_t expectedSize);
+
+ // TODO: unit testing
+
+private:
+ RealValue re_, im_;
+};
+
+} // namespace Fortran::evaluate::value
+#endif // FORTRAN_EVALUATE_COMPLEX_VALUE_H_
diff --git a/flang/include/flang/Evaluate/complex.h b/flang/include/flang/Evaluate/complex.h
deleted file mode 100644
index 9781db9a25a64..0000000000000
--- a/flang/include/flang/Evaluate/complex.h
+++ /dev/null
@@ -1,114 +0,0 @@
-//===-- include/flang/Evaluate/complex.h ------------------------*- C++ -*-===//
-//
-// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
-// See https://llvm.org/LICENSE.txt for license information.
-// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-//
-//===----------------------------------------------------------------------===//
-
-#ifndef FORTRAN_EVALUATE_COMPLEX_H_
-#define FORTRAN_EVALUATE_COMPLEX_H_
-
-#include "formatting.h"
-#include "real.h"
-#include <string>
-
-namespace llvm {
-class raw_ostream;
-}
-
-namespace Fortran::evaluate::value {
-
-template <typename REAL_TYPE> class Complex {
-public:
- using Part = REAL_TYPE;
- static constexpr int bits{2 * Part::bits};
-
- constexpr Complex() {} // (+0.0, +0.0)
- constexpr Complex(const Complex &) = default;
- constexpr Complex(const Part &r, const Part &i) : re_{r}, im_{i} {}
- explicit constexpr Complex(const Part &r) : re_{r} {}
- constexpr Complex &operator=(const Complex &) = default;
- constexpr Complex &operator=(Complex &&) = default;
-
- constexpr bool operator==(const Complex &that) const {
- return re_ == that.re_ && im_ == that.im_;
- }
-
- constexpr const Part &REAL() const { return re_; }
- constexpr const Part &AIMAG() const { return im_; }
- constexpr Complex CONJG() const { return {re_, im_.Negate()}; }
- constexpr Complex Negate() const { return {re_.Negate(), im_.Negate()}; }
-
- constexpr bool Equals(const Complex &that) const {
- return re_.Compare(that.re_) == Relation::Equal &&
- im_.Compare(that.im_) == Relation::Equal;
- }
-
- constexpr bool IsZero() const { return re_.IsZero() && im_.IsZero(); }
-
- constexpr bool IsInfinite() const {
- return re_.IsInfinite() || im_.IsInfinite();
- }
-
- constexpr bool IsNotANumber() const {
- return re_.IsNotANumber() || im_.IsNotANumber();
- }
-
- constexpr bool IsSignalingNaN() const {
- return re_.IsSignalingNaN() || im_.IsSignalingNaN();
- }
-
- template <typename INT>
- static ValueWithRealFlags<Complex> FromInteger(const INT &n,
- bool isUnsigned = false,
- Rounding rounding = TargetCharacteristics::defaultRounding) {
- ValueWithRealFlags<Complex> result;
- result.value.re_ = Part::FromInteger(n, isUnsigned, rounding)
- .AccumulateFlags(result.flags);
- return result;
- }
-
- ValueWithRealFlags<Complex> Add(const Complex &,
- Rounding rounding = TargetCharacteristics::defaultRounding) const;
- ValueWithRealFlags<Complex> Subtract(const Complex &,
- Rounding rounding = TargetCharacteristics::defaultRounding) const;
- ValueWithRealFlags<Complex> Multiply(const Complex &,
- Rounding rounding = TargetCharacteristics::defaultRounding) const;
- ValueWithRealFlags<Complex> Divide(const Complex &,
- Rounding rounding = TargetCharacteristics::defaultRounding) const;
- ValueWithRealFlags<Complex> KahanSummation(const Complex &,
- Complex &correction,
- Rounding rounding = TargetCharacteristics::defaultRounding) const;
-
- // ABS/CABS = HYPOT(re_, imag_) = SQRT(re_**2 + im_**2)
- ValueWithRealFlags<Part> ABS(
- Rounding rounding = TargetCharacteristics::defaultRounding) const {
- return re_.HYPOT(im_, rounding);
- }
-
- constexpr Complex FlushSubnormalToZero() const {
- return {re_.FlushSubnormalToZero(), im_.FlushSubnormalToZero()};
- }
-
- static constexpr Complex NotANumber() {
- return {Part::NotANumber(), Part::NotANumber()};
- }
-
- std::string DumpHexadecimal() const;
- llvm::raw_ostream &AsFortran(llvm::raw_ostream &, int kind) const;
-
- // TODO: unit testing
-
-private:
- Part re_, im_;
-};
-
-extern template class Complex<Real<Integer<16>, 11>>;
-extern template class Complex<Real<Integer<16>, 8>>;
-extern template class Complex<Real<Integer<32>, 24>>;
-extern template class Complex<Real<Integer<64>, 53>>;
-extern template class Complex<Real<X87IntegerContainer, 64>>;
-extern template class Complex<Real<Integer<128>, 113>>;
-} // namespace Fortran::evaluate::value
-#endif // FORTRAN_EVALUATE_COMPLEX_H_
diff --git a/flang/include/flang/Evaluate/constant.h b/flang/include/flang/Evaluate/constant.h
index 9ae37cd999aa9..530328e1802bb 100644
--- a/flang/include/flang/Evaluate/constant.h
+++ b/flang/include/flang/Evaluate/constant.h
@@ -110,16 +110,48 @@ class ConstantBase : public ConstantBounds {
using Result = RESULT;
using Element = ELEMENT;
+ constexpr int kind() const { return kind_; }
+
// Constructor for creating ConstantBase from an actual value (i.e.
// literals, etc.)
- template <typename A,
- typename = std::enable_if_t<std::is_convertible_v<A, Element>>>
- ConstantBase(const A &x, Result res = Result{}) : result_{res}, values_{x} {}
+ template <typename A>
+ ConstantBase(int kind, const A &x, Result res)
+ : kind_{kind}, result_{res}, values_{A{kind, x}} {
+ CHECK_KIND(kind, RESULT);
+ }
+ ConstantBase(int kind, ELEMENT &&x)
+ : kind_{kind}, result_{Result{kind}}, values_{std::move(x)} {
+ CHECK_KIND(kind, RESULT);
+ }
- ConstantBase(ELEMENT &&x, Result res = Result{})
- : result_{res}, values_{std::move(x)} {}
+ template <TypeCategory CAT>
+ ConstantBase(int kind, const SomeKind<CAT> &x)
+ : kind_{kind}, result_{Result{kind}}, values_{x} {
+ CHECK_KIND(kind, RESULT);
+ }
+ template <TypeCategory CAT>
+ ConstantBase(int kind, SomeKind<CAT> &&x)
+ : kind_{kind}, result_{Result{kind}}, values_{std::move(x)} {
+ CHECK_KIND(kind, RESULT);
+ }
+
+ template <typename A>
+ ConstantBase(int kind, const A &x)
+ : kind_{kind}, result_{Result{kind}}, values_{A{kind, x}} {
+ CHECK_KIND(kind, RESULT);
+ }
+ ConstantBase(int kind, ELEMENT &&x, Result res)
+ : kind_{kind}, result_{res}, values_{std::move(x)} {
+ CHECK_KIND(kind, RESULT);
+ }
+
+ ConstantBase(int kind, std::vector<Element> &&x, ConstantSubscripts &&sh)
+ : ConstantBase{kind, std::move(x), std::move(sh), Result{kind}} {}
ConstantBase(
- std::vector<Element> &&, ConstantSubscripts &&, Result = Result{});
+ int kind, std::vector<Element> &&, ConstantSubscripts &&, Result);
+ template <typename A, typename B, typename C>
+ ConstantBase(int kind, const std::map<A, B, C> &x, Result res = Result{})
+ : kind_{kind}, result_{res}, values_{x} {}
DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(ConstantBase)
~ConstantBase();
@@ -140,6 +172,7 @@ class ConstantBase : public ConstantBounds {
std::size_t CopyFrom(const ConstantBase &source, std::size_t count,
ConstantSubscripts &resultSubscripts, const std::vector<int> *dimOrder);
+ int kind_;
Result result_; // usually empty except for Real & Complex
std::vector<Element> values_;
};
@@ -170,22 +203,24 @@ template <typename T> class Constant : public ConstantBase<T> {
ConstantSubscripts &resultSubscripts, const std::vector<int> *dimOrder);
};
-template <int KIND>
-class Constant<Type<TypeCategory::Character, KIND>> : public ConstantBounds {
+template <>
+class Constant<Type<TypeCategory::Character>> : public ConstantBounds {
public:
- using Result = Type<TypeCategory::Character, KIND>;
+ using Result = Type<TypeCategory::Character>;
using Element = Scalar<Result>;
+ constexpr int kind() const { return kind_; }
+
CLASS_BOILERPLATE(Constant)
- explicit Constant(const Scalar<Result> &);
- explicit Constant(Scalar<Result> &&);
- Constant(
- ConstantSubscript length, std::vector<Element> &&, ConstantSubscripts &&);
+ explicit Constant(int kind, const Scalar<Result> &);
+ explicit Constant(int kind, Scalar<Result> &&);
+ Constant(int kind, ConstantSubscript length, std::vector<Element> &&,
+ ConstantSubscripts &&);
~Constant();
bool operator==(const Constant &that) const {
- return LEN() == that.LEN() && shape() == that.shape() &&
- values_ == that.values_;
+ return kind() == that.kind() && LEN() == that.LEN() &&
+ shape() == that.shape() && values_ == that.values_;
}
bool empty() const;
std::size_t size() const;
@@ -212,11 +247,12 @@ class Constant<Type<TypeCategory::Character, KIND>> : public ConstantBounds {
Constant Reshape(ConstantSubscripts &&) const;
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
std::string AsFortran() const;
- DynamicType GetType() const { return {KIND, length_}; }
+ DynamicType GetType() const { return {kind_, length_}; }
std::size_t CopyFrom(const Constant &source, std::size_t count,
ConstantSubscripts &resultSubscripts, const std::vector<int> *dimOrder);
private:
+ int kind_;
Scalar<Result> values_; // one contiguous string
ConstantSubscript length_;
bool wasHollerith_{false};
@@ -239,6 +275,12 @@ class Constant<SomeDerived>
Constant(const StructureConstructor &);
Constant(StructureConstructor &&);
+ Constant(int kind, const StructureConstructor &v) : Constant(v) {
+ CHECK(kind == 0);
+ }
+ Constant(int kind, StructureConstructor &&v) : Constant(std::move(v)) {
+ CHECK(kind == 0);
+ }
Constant(const semantics::DerivedTypeSpec &,
std::vector<StructureConstructorValues> &&, ConstantSubscripts &&);
Constant(const semantics::DerivedTypeSpec &,
@@ -254,6 +296,40 @@ class Constant<SomeDerived>
ConstantSubscripts &resultSubscripts, const std::vector<int> *dimOrder);
};
+inline Constant<SubscriptInteger> MakeSubscriptIntConstant(int64_t v) {
+ return Constant<SubscriptInteger>{
+ SubscriptIntegerKind, Scalar<SubscriptInteger>{SubscriptIntegerKind, v}};
+}
+
+inline Constant<CInteger> MakeCIntegerConstant(int32_t v) {
+ return Constant<CInteger>{CIntegerKind, Scalar<CInteger>{CIntegerKind, v}};
+}
+
+inline Constant<LogicalResult> MakeLogicalResultConstant(bool v) {
+ return Constant<LogicalResult>{
+ LogicalResultKind, Scalar<LogicalResult>{LogicalResultKind, v}};
+}
+
+template <typename T, typename CharT,
+ typename =
+ std::enable_if_t<std::is_same_v<T, Type<TypeCategory::Character>>>>
+inline Constant<T> MakeConstant(int kind, const std::basic_string<CharT> &v) {
+ return Constant<T>{kind, value::CharacterValue{kind, v}};
+}
+
+template <typename T, typename CharT,
+ typename =
+ std::enable_if_t<std::is_same_v<T, Type<TypeCategory::Character>>>>
+inline Constant<T> MakeConstant(int kind, std::basic_string<CharT> &&v) {
+ return Constant<T>{kind, value::CharacterValue{kind, std::move(v)}};
+}
+
+template <typename T,
+ typename = std::enable_if_t<std::is_same_v<T, Type<TypeCategory::Integer>>>>
+inline Constant<T> MakeConstant(int kind, int64_t v) {
+ return Constant<T>{kind, value::IntegerValue{kind, v}};
+}
+
FOR_EACH_LENGTHLESS_INTRINSIC_KIND(extern template class ConstantBase, )
extern template class ConstantBase<SomeDerived, StructureConstructorValues>;
FOR_EACH_INTRINSIC_KIND(extern template class Constant, )
diff --git a/flang/include/flang/Evaluate/expression.h b/flang/include/flang/Evaluate/expression.h
index 48a6b635f6350..ba8f2b744bd9c 100644
--- a/flang/include/flang/Evaluate/expression.h
+++ b/flang/include/flang/Evaluate/expression.h
@@ -60,12 +60,15 @@ using common::RelationalOperator;
// maps to some instantiation of Type<CATEGORY, KIND>, SomeKind<CATEGORY>,
// or SomeType. (Exception: BOZ literal constants in generic Expr<SomeType>.)
template <typename A> using ResultType = typename std::decay_t<A>::Result;
+template <typename A> constexpr int ResultKind = std::decay_t<A>::kind();
// Common Expr<> behaviors: every Expr<T> derives from ExpressionBase<T>.
template <typename RESULT> class ExpressionBase {
public:
using Result = RESULT;
+ int kind() const;
+
private:
using Derived = Expr<Result>;
#if defined(__APPLE__) && defined(__GNUC__)
@@ -125,6 +128,8 @@ class Operation {
(operands == 1 && std::is_same_v<Result, SomeDerived>));
template <int J> using Operand = std::tuple_element_t<J, OperandTypes>;
+ constexpr int kind() const { return kind_; }
+
// Unary operations wrap a single Expr with a CopyableIndirection.
// Binary operations wrap a tuple of CopyableIndirections to Exprs.
private:
@@ -134,8 +139,14 @@ class Operation {
public:
CLASS_BOILERPLATE(Operation)
- explicit Operation(const Expr<OPERANDS> &...x) : operand_{x...} {}
- explicit Operation(Expr<OPERANDS> &&...x) : operand_{std::move(x)...} {}
+ explicit Operation(int kind, const Expr<OPERANDS> &...x)
+ : kind_{kind}, operand_{x...} {
+ CHECK_KIND(kind, RESULT);
+ }
+ explicit Operation(int kind, Expr<OPERANDS> &&...x)
+ : kind_{kind}, operand_{std::move(x)...} {
+ CHECK_KIND(kind, RESULT);
+ }
Derived &derived() { return *static_cast<Derived *>(this); }
const Derived &derived() const { return *static_cast<const Derived *>(this); }
@@ -177,10 +188,8 @@ class Operation {
}
}
- static constexpr std::conditional_t<Result::category != TypeCategory::Derived,
- std::optional<DynamicType>, void>
- GetType() {
- return Result::GetType();
+ constexpr std::optional<DynamicType> GetType() const {
+ return DynamicType{Result::category, kind()};
}
int Rank() const {
int rank{left().Rank()};
@@ -199,6 +208,7 @@ class Operation {
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
private:
+ int kind_;
Container operand_;
};
@@ -221,6 +231,7 @@ struct Convert : public Operation<Convert<TO, FROMCAT>, TO, SomeKind<FROMCAT>> {
using Operand = SomeKind<FROMCAT>;
using Base = Operation<Convert, Result, Operand>;
using Base::Base;
+ using Base::kind;
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
};
@@ -230,6 +241,9 @@ struct Parentheses : public Operation<Parentheses<A>, A, A> {
using Operand = A;
using Base = Operation<Parentheses, A, A>;
using Base::Base;
+
+ Parentheses(const Expr<A> &x) : Base{x.kind(), x} {};
+ Parentheses(Expr<A> &&x) : Base{x.kind(), std::move(x)} {};
};
template <>
@@ -241,6 +255,9 @@ struct Parentheses<SomeDerived>
using Base = Operation<Parentheses, SomeDerived, SomeDerived>;
using Base::Base;
DynamicType GetType() const;
+
+ Parentheses(const Expr<SomeDerived> &x);
+ Parentheses(Expr<SomeDerived> &&x);
};
template <typename A> struct Negate : public Operation<Negate<A>, A, A> {
@@ -248,28 +265,27 @@ template <typename A> struct Negate : public Operation<Negate<A>, A, A> {
using Operand = A;
using Base = Operation<Negate, A, A>;
using Base::Base;
+
+ Negate(const Expr<A> &x) : Base{x.kind(), x} {};
+ Negate(Expr<A> &&x) : Base{x.kind(), std::move(x)} {};
};
-template <int KIND>
struct ComplexComponent
- : public Operation<ComplexComponent<KIND>, Type<TypeCategory::Real, KIND>,
- Type<TypeCategory::Complex, KIND>> {
- using Result = Type<TypeCategory::Real, KIND>;
- using Operand = Type<TypeCategory::Complex, KIND>;
+ : public Operation<ComplexComponent, Type<TypeCategory::Real>,
+ Type<TypeCategory::Complex>> {
+ using Result = Type<TypeCategory::Real>;
+ using Operand = Type<TypeCategory::Complex>;
using Base = Operation<ComplexComponent, Result, Operand>;
CLASS_BOILERPLATE(ComplexComponent)
- ComplexComponent(bool isImaginary, const Expr<Operand> &x)
- : Base{x}, isImaginaryPart{isImaginary} {}
- ComplexComponent(bool isImaginary, Expr<Operand> &&x)
- : Base{std::move(x)}, isImaginaryPart{isImaginary} {}
+ ComplexComponent(bool isImaginary, const Expr<Operand> &x);
+ ComplexComponent(bool isImaginary, Expr<Operand> &&x);
bool isImaginaryPart{true};
};
-template <int KIND>
-struct Not : public Operation<Not<KIND>, Type<TypeCategory::Logical, KIND>,
- Type<TypeCategory::Logical, KIND>> {
- using Result = Type<TypeCategory::Logical, KIND>;
+struct Not : public Operation<Not, Type<TypeCategory::Logical>,
+ Type<TypeCategory::Logical>> {
+ using Result = Type<TypeCategory::Logical>;
using Operand = Result;
using Base = Operation<Not, Result, Operand>;
using Base::Base;
@@ -279,11 +295,9 @@ struct Not : public Operation<Not<KIND>, Type<TypeCategory::Logical, KIND>,
// have explicit syntax for changing them. Expressions represent
// changes of length (e.g., for assignments and structure constructors)
// with this operation.
-template <int KIND>
-struct SetLength
- : public Operation<SetLength<KIND>, Type<TypeCategory::Character, KIND>,
- Type<TypeCategory::Character, KIND>, SubscriptInteger> {
- using Result = Type<TypeCategory::Character, KIND>;
+struct SetLength : public Operation<SetLength, Type<TypeCategory::Character>,
+ Type<TypeCategory::Character>, SubscriptInteger> {
+ using Result = Type<TypeCategory::Character>;
using CharacterOperand = Result;
using LengthOperand = SubscriptInteger;
using Base = Operation<SetLength, Result, CharacterOperand, LengthOperand>;
@@ -342,49 +356,55 @@ template <typename A> struct Extremum : public Operation<Extremum<A>, A, A, A> {
using Base = Operation<Extremum, A, A, A>;
CLASS_BOILERPLATE(Extremum)
Extremum(Ordering ord, const Expr<Operand> &x, const Expr<Operand> &y)
- : Base{x, y}, ordering{ord} {}
+ : Base{x.kind(), x, y}, ordering{ord} {
+ CHECK(x.kind() == y.kind());
+ }
Extremum(Ordering ord, Expr<Operand> &&x, Expr<Operand> &&y)
- : Base{std::move(x), std::move(y)}, ordering{ord} {}
+ : Base{x.kind(), std::move(x), std::move(y)}, ordering{ord} {
+ CHECK(x.kind() == y.kind());
+ }
bool operator==(const Extremum &) const;
Ordering ordering{Ordering::Greater};
};
-template <int KIND>
struct ComplexConstructor
- : public Operation<ComplexConstructor<KIND>,
- Type<TypeCategory::Complex, KIND>, Type<TypeCategory::Real, KIND>,
- Type<TypeCategory::Real, KIND>> {
- using Result = Type<TypeCategory::Complex, KIND>;
- using Operand = Type<TypeCategory::Real, KIND>;
+ : public Operation<ComplexConstructor, Type<TypeCategory::Complex>,
+ Type<TypeCategory::Real>, Type<TypeCategory::Real>> {
+ using Result = Type<TypeCategory::Complex>;
+ using Operand = Type<TypeCategory::Real>;
using Base = Operation<ComplexConstructor, Result, Operand, Operand>;
using Base::Base;
+
+ ComplexConstructor(const Expr<Type<TypeCategory::Real>> &re,
+ const Expr<Type<TypeCategory::Real>> &im);
+ ComplexConstructor(
+ Expr<Type<TypeCategory::Real>> &&re, Expr<Type<TypeCategory::Real>> &&im);
};
-template <int KIND>
struct Concat
- : public Operation<Concat<KIND>, Type<TypeCategory::Character, KIND>,
- Type<TypeCategory::Character, KIND>,
- Type<TypeCategory::Character, KIND>> {
- using Result = Type<TypeCategory::Character, KIND>;
+ : public Operation<Concat, Type<TypeCategory::Character>,
+ Type<TypeCategory::Character>, Type<TypeCategory::Character>> {
+ using Result = Type<TypeCategory::Character>;
using Operand = Result;
using Base = Operation<Concat, Result, Operand, Operand>;
using Base::Base;
+
+ Concat(const Expr<Type<TypeCategory::Character>> &x,
+ const Expr<Type<TypeCategory::Character>> &y);
+ Concat(Expr<Type<TypeCategory::Character>> &&x,
+ Expr<Type<TypeCategory::Character>> &&y);
};
-template <int KIND>
struct LogicalOperation
- : public Operation<LogicalOperation<KIND>,
- Type<TypeCategory::Logical, KIND>, Type<TypeCategory::Logical, KIND>,
- Type<TypeCategory::Logical, KIND>> {
- using Result = Type<TypeCategory::Logical, KIND>;
+ : public Operation<LogicalOperation, Type<TypeCategory::Logical>,
+ Type<TypeCategory::Logical>, Type<TypeCategory::Logical>> {
+ using Result = Type<TypeCategory::Logical>;
using Operand = Result;
using Base = Operation<LogicalOperation, Result, Operand, Operand>;
CLASS_BOILERPLATE(LogicalOperation)
LogicalOperation(
- LogicalOperator opr, const Expr<Operand> &x, const Expr<Operand> &y)
- : Base{x, y}, logicalOperator{opr} {}
- LogicalOperation(LogicalOperator opr, Expr<Operand> &&x, Expr<Operand> &&y)
- : Base{std::move(x), std::move(y)}, logicalOperator{opr} {}
+ LogicalOperator opr, const Expr<Operand> &x, const Expr<Operand> &y);
+ LogicalOperation(LogicalOperator opr, Expr<Operand> &&x, Expr<Operand> &&y);
bool operator==(const LogicalOperation &) const;
LogicalOperator logicalOperator;
};
@@ -394,11 +414,17 @@ struct LogicalOperation
template <typename T> class ConditionalExpr {
public:
using Result = T;
+
+ constexpr int kind() const { return kind_; }
+
CLASS_BOILERPLATE(ConditionalExpr)
ConditionalExpr(Expr<LogicalResult> &&cond, Expr<Result> &&thenVal,
Expr<Result> &&elseVal)
- : condition_{std::move(cond)}, thenValue_{std::move(thenVal)},
- elseValue_{std::move(elseVal)} {}
+ : kind_{thenVal.kind()}, condition_{std::move(cond)},
+ thenValue_{std::move(thenVal)}, elseValue_{std::move(elseVal)} {
+ CHECK_KIND(kind(), Result);
+ CHECK(thenVal.kind() == elseVal.kind());
+ }
bool operator==(const ConditionalExpr &) const;
Expr<LogicalResult> &condition() { return condition_.value(); }
const Expr<LogicalResult> &condition() const { return condition_.value(); }
@@ -425,6 +451,7 @@ template <typename T> class ConditionalExpr {
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
private:
+ int kind_;
common::CopyableIndirection<Expr<LogicalResult>> condition_;
common::CopyableIndirection<Expr<Result>> thenValue_;
common::CopyableIndirection<Expr<Result>> elseValue_;
@@ -436,6 +463,12 @@ template <typename RESULT> class ArrayConstructorValues;
struct ImpliedDoIndex {
using Result = SubscriptInteger;
bool operator==(const ImpliedDoIndex &) const;
+
+ static constexpr int kind() { return SubscriptIntegerKind; }
+
+ static constexpr DynamicType GetType() {
+ return {TypeCategory::Integer, kind()};
+ }
static constexpr int Rank() { return 0; }
static constexpr int Corank() { return 0; }
parser::CharBlock name; // nested implied DOs must use distinct names
@@ -507,33 +540,55 @@ class ArrayConstructor : public ArrayConstructorValues<RESULT> {
public:
using Result = RESULT;
using Base = ArrayConstructorValues<Result>;
+
+ constexpr int kind() const { return kind_; }
+
DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(ArrayConstructor)
- explicit ArrayConstructor(Base &&values) : Base{std::move(values)} {}
- template <typename T> explicit ArrayConstructor(const Expr<T> &) {}
- static constexpr Result result() { return Result{}; }
- static constexpr DynamicType GetType() { return Result::GetType(); }
+ explicit ArrayConstructor(int kind, Base &&values)
+ : Base{std::move(values)}, kind_{kind} {
+ CHECK_KIND(kind, RESULT);
+ }
+ template <typename T>
+ explicit ArrayConstructor(int kind, const Expr<T> &) : kind_{kind} {
+ CHECK_KIND(kind, RESULT);
+ }
+ static constexpr Result result(int kind) { return Result{kind}; }
+ DynamicType GetType() const { return {Result::category, kind_}; }
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
+
+private:
+ int kind_;
};
-template <int KIND>
-class ArrayConstructor<Type<TypeCategory::Character, KIND>>
- : public ArrayConstructorValues<Type<TypeCategory::Character, KIND>> {
+template <>
+class ArrayConstructor<Type<TypeCategory::Character>>
+ : public ArrayConstructorValues<Type<TypeCategory::Character>> {
public:
- using Result = Type<TypeCategory::Character, KIND>;
+ using Result = Type<TypeCategory::Character>;
using Base = ArrayConstructorValues<Result>;
+
+ constexpr int kind() const { return kind_; }
+
DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(ArrayConstructor)
- explicit ArrayConstructor(Base &&values) : Base{std::move(values)} {}
- template <typename T> explicit ArrayConstructor(const Expr<T> &) {}
+ explicit ArrayConstructor(int kind, Base &&values)
+ : Base{std::move(values)}, kind_{kind} {
+ CHECK(kind != 0);
+ }
+ template <typename T>
+ explicit ArrayConstructor(int kind, const Expr<T> &) : kind_{kind} {
+ CHECK(kind != 0);
+ }
ArrayConstructor &set_LEN(Expr<SubscriptInteger> &&);
bool operator==(const ArrayConstructor &) const;
- static constexpr Result result() { return Result{}; }
- static constexpr DynamicType GetType() { return Result::GetType(); }
+ static constexpr Result result(int kind) { return Result{kind}; }
+ DynamicType GetType() const { return {Result::category, kind()}; }
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
const Expr<SubscriptInteger> *LEN() const {
return length_ ? &length_->value() : nullptr;
}
private:
+ int kind_;
std::optional<common::CopyableIndirection<Expr<SubscriptInteger>>> length_;
};
@@ -543,6 +598,9 @@ class ArrayConstructor<SomeDerived>
public:
using Result = SomeDerived;
using Base = ArrayConstructorValues<Result>;
+
+ constexpr int kind() const { return 0; }
+
CLASS_BOILERPLATE(ArrayConstructor)
ArrayConstructor(const semantics::DerivedTypeSpec &spec, Base &&v)
@@ -550,6 +608,11 @@ class ArrayConstructor<SomeDerived>
template <typename A>
explicit ArrayConstructor(const A &prototype)
: result_{prototype.GetType().value().GetDerivedTypeSpec()} {}
+ template <typename A>
+ explicit ArrayConstructor(int kind, const A &prototype)
+ : result_{prototype.GetType().value().GetDerivedTypeSpec()} {
+ CHECK(kind == 0);
+ }
bool operator==(const ArrayConstructor &) const;
constexpr Result result() const { return result_; }
@@ -562,11 +625,11 @@ class ArrayConstructor<SomeDerived>
// Expression representations for each type category.
-template <int KIND>
-class Expr<Type<TypeCategory::Integer, KIND>>
- : public ExpressionBase<Type<TypeCategory::Integer, KIND>> {
+template <>
+class Expr<Type<TypeCategory::Integer>>
+ : public ExpressionBase<Type<TypeCategory::Integer>> {
public:
- using Result = Type<TypeCategory::Integer, KIND>;
+ using Result = Type<TypeCategory::Integer>;
EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
@@ -577,17 +640,10 @@ class Expr<Type<TypeCategory::Integer, KIND>>
using Operations = std::tuple<Parentheses<Result>, Negate<Result>,
Add<Result>, Subtract<Result>, Multiply<Result>, Divide<Result>,
Power<Result>, Extremum<Result>, ConditionalExpr<Result>>;
- using Indices = std::conditional_t<KIND == ImpliedDoIndex::Result::kind,
- std::tuple<ImpliedDoIndex>, std::tuple<>>;
- using TypeParamInquiries =
- std::conditional_t<KIND == TypeParamInquiry::Result::kind,
- std::tuple<TypeParamInquiry>, std::tuple<>>;
- using DescriptorInquiries =
- std::conditional_t<KIND == DescriptorInquiry::Result::kind,
- std::tuple<DescriptorInquiry>, std::tuple<>>;
- using RankOneBoundElements =
- std::conditional_t<KIND == RankOneBoundElement::Result::kind,
- std::tuple<RankOneBoundElement>, std::tuple<>>;
+ using Indices = std::tuple<ImpliedDoIndex>;
+ using TypeParamInquiries = std::tuple<TypeParamInquiry>;
+ using DescriptorInquiries = std::tuple<DescriptorInquiry>;
+ using RankOneBoundElements = std::tuple<RankOneBoundElement>;
using Others = std::tuple<Constant<Result>, ArrayConstructor<Result>,
Designator<Result>, FunctionRef<Result>>;
@@ -597,11 +653,11 @@ class Expr<Type<TypeCategory::Integer, KIND>>
u;
};
-template <int KIND>
-class Expr<Type<TypeCategory::Unsigned, KIND>>
- : public ExpressionBase<Type<TypeCategory::Unsigned, KIND>> {
+template <>
+class Expr<Type<TypeCategory::Unsigned>>
+ : public ExpressionBase<Type<TypeCategory::Unsigned>> {
public:
- using Result = Type<TypeCategory::Unsigned, KIND>;
+ using Result = Type<TypeCategory::Unsigned>;
EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
@@ -620,14 +676,15 @@ class Expr<Type<TypeCategory::Unsigned, KIND>>
u;
};
-template <int KIND>
-class Expr<Type<TypeCategory::Real, KIND>>
- : public ExpressionBase<Type<TypeCategory::Real, KIND>> {
+template <>
+class Expr<Type<TypeCategory::Real>>
+ : public ExpressionBase<Type<TypeCategory::Real>> {
public:
- using Result = Type<TypeCategory::Real, KIND>;
+ using Result = Type<TypeCategory::Real>;
EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
- explicit Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
+ explicit Expr(int kind, const Scalar<Result> &x)
+ : u{Constant<Result>{kind, x}} {}
private:
// N.B. Real->Complex and Complex->Real conversions are done with CMPLX
@@ -635,7 +692,7 @@ class Expr<Type<TypeCategory::Real, KIND>>
using Conversions = std::variant<Convert<Result, TypeCategory::Integer>,
Convert<Result, TypeCategory::Real>,
Convert<Result, TypeCategory::Unsigned>>;
- using Operations = std::variant<ComplexComponent<KIND>, Parentheses<Result>,
+ using Operations = std::variant<ComplexComponent, Parentheses<Result>,
Negate<Result>, Add<Result>, Subtract<Result>, Multiply<Result>,
Divide<Result>, Power<Result>, RealToIntPower<Result>, Extremum<Result>,
ConditionalExpr<Result>>;
@@ -646,17 +703,18 @@ class Expr<Type<TypeCategory::Real, KIND>>
common::CombineVariants<Operations, Conversions, Others> u;
};
-template <int KIND>
-class Expr<Type<TypeCategory::Complex, KIND>>
- : public ExpressionBase<Type<TypeCategory::Complex, KIND>> {
+template <>
+class Expr<Type<TypeCategory::Complex>>
+ : public ExpressionBase<Type<TypeCategory::Complex>> {
public:
- using Result = Type<TypeCategory::Complex, KIND>;
+ using Result = Type<TypeCategory::Complex>;
EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
- explicit Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
+ explicit Expr(int kind, const Scalar<Result> &x)
+ : u{Constant<Result>{kind, x}} {}
using Operations = std::variant<Parentheses<Result>, Negate<Result>,
Convert<Result, TypeCategory::Complex>, Add<Result>, Subtract<Result>,
Multiply<Result>, Divide<Result>, Power<Result>, RealToIntPower<Result>,
- ComplexConstructor<KIND>, ConditionalExpr<Result>>;
+ ComplexConstructor, ConditionalExpr<Result>>;
using Others = std::variant<Constant<Result>, ArrayConstructor<Result>,
Designator<Result>, FunctionRef<Result>>;
@@ -669,20 +727,22 @@ FOR_EACH_UNSIGNED_KIND(extern template class Expr, )
FOR_EACH_REAL_KIND(extern template class Expr, )
FOR_EACH_COMPLEX_KIND(extern template class Expr, )
-template <int KIND>
-class Expr<Type<TypeCategory::Character, KIND>>
- : public ExpressionBase<Type<TypeCategory::Character, KIND>> {
+template <>
+class Expr<Type<TypeCategory::Character>>
+ : public ExpressionBase<Type<TypeCategory::Character>> {
public:
- using Result = Type<TypeCategory::Character, KIND>;
+ using Result = Type<TypeCategory::Character>;
EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
- explicit Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
- explicit Expr(Scalar<Result> &&x) : u{Constant<Result>{std::move(x)}} {}
+ explicit Expr(int kind, const Scalar<Result> &x)
+ : u{Constant<Result>{kind, x}} {}
+ explicit Expr(int kind, Scalar<Result> &&x)
+ : u{Constant<Result>{kind, std::move(x)}} {}
std::optional<Expr<SubscriptInteger>> LEN() const;
std::variant<Constant<Result>, ArrayConstructor<Result>, Designator<Result>,
- FunctionRef<Result>, Parentheses<Result>, Convert<Result>, Concat<KIND>,
- Extremum<Result>, SetLength<KIND>, ConditionalExpr<Result>>
+ FunctionRef<Result>, Parentheses<Result>, Convert<Result>, Concat,
+ Extremum<Result>, SetLength, ConditionalExpr<Result>>
u;
};
@@ -710,9 +770,16 @@ class Relational : public Operation<Relational<T>, LogicalResult, T, T> {
CLASS_BOILERPLATE(Relational)
Relational(
RelationalOperator r, const Expr<Operand> &a, const Expr<Operand> &b)
- : Base{a, b}, opr{r} {}
+ : Base{LogicalResultKind, a, b}, opr{r} {
+ CHECK(a.kind() == b.kind());
+ }
Relational(RelationalOperator r, Expr<Operand> &&a, Expr<Operand> &&b)
- : Base{std::move(a), std::move(b)}, opr{r} {}
+ : Base{LogicalResultKind, std::move(a), std::move(b)}, opr{r} {
+ CHECK(a.kind() == b.kind());
+ }
+ static constexpr std::optional<DynamicType> GetType() {
+ return DynamicType{TypeCategory::Logical, LogicalResultKind};
+ }
bool operator==(const Relational &) const;
RelationalOperator opr;
};
@@ -724,7 +791,12 @@ template <> class Relational<SomeType> {
public:
using Result = LogicalResult;
EVALUATE_UNION_CLASS_BOILERPLATE(Relational)
- static constexpr DynamicType GetType() { return Result::GetType(); }
+ int kind() const {
+ return common::visit([](const auto &x) { return x.kind(); }, u);
+ }
+ static constexpr DynamicType GetType() {
+ return {TypeCategory::Logical, LogicalResultKind};
+ }
int Rank() const {
return common::visit([](const auto &x) { return x.Rank(); }, u);
}
@@ -743,20 +815,23 @@ extern template class Relational<SomeType>;
// do not include Relational<> operations as possibilities,
// since the results of Relationals are always LogicalResult
// (kind=4).
-template <int KIND>
-class Expr<Type<TypeCategory::Logical, KIND>>
- : public ExpressionBase<Type<TypeCategory::Logical, KIND>> {
+template <>
+class Expr<Type<TypeCategory::Logical>>
+ : public ExpressionBase<Type<TypeCategory::Logical>> {
public:
- using Result = Type<TypeCategory::Logical, KIND>;
+ using Result = Type<TypeCategory::Logical>;
EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
- explicit Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
- explicit Expr(bool x) : u{Constant<Result>{x}} {}
+
+ explicit Expr(const Scalar<Result> &x) : u{Constant<Result>{x.kind(), x}} {}
+ explicit Expr(int kind, const Scalar<Result> &x)
+ : u{Constant<Result>{kind, x}} {}
+ explicit Expr(int kind, bool x)
+ : u{Constant<Result>{kind, Scalar<Result>{kind, x}}} {}
private:
- using Operations = std::tuple<Convert<Result>, Parentheses<Result>, Not<KIND>,
- LogicalOperation<KIND>, ConditionalExpr<Result>>;
- using Relations = std::conditional_t<KIND == LogicalResult::kind,
- std::tuple<Relational<SomeType>>, std::tuple<>>;
+ using Operations = std::tuple<Convert<Result>, Parentheses<Result>, Not,
+ LogicalOperation, ConditionalExpr<Result>>;
+ using Relations = std::tuple<Relational<SomeType>>;
using Others = std::tuple<Constant<Result>, ArrayConstructor<Result>,
Designator<Result>, FunctionRef<Result>>;
@@ -785,6 +860,8 @@ class StructureConstructor {
public:
using Result = SomeDerived;
+ static int kind() { return 0; }
+
explicit StructureConstructor(const semantics::DerivedTypeSpec &spec)
: result_{spec} {}
StructureConstructor(
@@ -845,7 +922,6 @@ class Expr<SomeKind<CAT>> : public ExpressionBase<SomeKind<CAT>> {
public:
using Result = SomeKind<CAT>;
EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
- int GetKind() const;
common::MapTemplate<evaluate::Expr, CategoryTypes<CAT>> u;
};
@@ -853,7 +929,6 @@ template <> class Expr<SomeCharacter> : public ExpressionBase<SomeCharacter> {
public:
using Result = SomeCharacter;
EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
- int GetKind() const;
std::optional<Expr<SubscriptInteger>> LEN() const;
common::MapTemplate<Expr, CategoryTypes<TypeCategory::Character>> u;
};
@@ -867,9 +942,12 @@ using CategoryExpression = common::MapTemplate<Expr, SomeCategory>;
// distinguishable from other integer constants, since they are permitted
// to be used in only a few situations.
using BOZLiteralConstant = typename LargestReal::Scalar::Word;
+static constexpr int BOZLiteralConstantKind = LargestRealKind;
// Null pointers without MOLD= arguments are typed by context.
struct NullPointer {
+ static constexpr int kind() { return 0; }
+
constexpr bool operator==(const NullPointer &) const { return true; }
static constexpr int Rank() { return 0; }
static constexpr int Corank() { return 0; }
@@ -886,6 +964,9 @@ using TypelessExpression = std::variant<BOZLiteralConstant, NullPointer,
template <> class Expr<SomeType> : public ExpressionBase<SomeType> {
public:
using Result = SomeType;
+
+ static int kind() { return 0; }
+
EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
// Owning references to these generic expressions can appear in other
@@ -893,21 +974,18 @@ template <> class Expr<SomeType> : public ExpressionBase<SomeType> {
// its destructor is externalized to reduce redundant default instances.
~Expr();
- template <TypeCategory CAT, int KIND>
- explicit Expr(const Expr<Type<CAT, KIND>> &x) : u{Expr<SomeKind<CAT>>{x}} {}
+ template <TypeCategory CAT>
+ explicit Expr(const Expr<Type<CAT>> &x) : u{Expr<SomeKind<CAT>>{x}} {}
- template <TypeCategory CAT, int KIND>
- explicit Expr(Expr<Type<CAT, KIND>> &&x)
- : u{Expr<SomeKind<CAT>>{std::move(x)}} {}
+ template <TypeCategory CAT>
+ explicit Expr(Expr<Type<CAT>> &&x) : u{Expr<SomeKind<CAT>>{std::move(x)}} {}
- template <TypeCategory CAT, int KIND>
- Expr &operator=(const Expr<Type<CAT, KIND>> &x) {
+ template <TypeCategory CAT> Expr &operator=(const Expr<Type<CAT>> &x) {
u = Expr<SomeKind<CAT>>{x};
return *this;
}
- template <TypeCategory CAT, int KIND>
- Expr &operator=(Expr<Type<CAT, KIND>> &&x) {
+ template <TypeCategory CAT> Expr &operator=(Expr<Type<CAT>> &&x) {
u = Expr<SomeKind<CAT>>{std::move(x)};
return *this;
}
@@ -976,5 +1054,91 @@ FOR_EACH_INTRINSIC_KIND(extern template class ArrayConstructor, )
FOR_EACH_INTRINSIC_KIND(template class ArrayConstructorValues, ) \
FOR_EACH_INTRINSIC_KIND(template class ArrayConstructor, ) \
FOR_EACH_INTRINSIC_KIND(template class ConditionalExpr, )
+
+template <typename T>
+inline Expr<T> MakeConstantExpr(int kind, const Scalar<T> &v) {
+ CHECK(kind == v.kind());
+ return Expr<T>{Constant<T>{kind, v}};
+}
+
+template <typename T> inline Expr<T> MakeConstantExpr(int kind, Scalar<T> &&v) {
+ CHECK(kind == v.kind());
+ return Expr<T>{Constant<T>{kind, std::move(v)}};
+}
+
+template <typename T>
+inline Expr<T> MakeConstantExpr(int kind, const Constant<T> &c) {
+ CHECK(kind == c.kind());
+ return Expr<T>{c};
+}
+
+template <typename T>
+inline Expr<T> MakeConstantExpr(int kind, Constant<T> &&c) {
+ CHECK(kind == c.kind());
+ return Expr<T>{std::move(c)};
+}
+
+template <typename T,
+ typename =
+ std::enable_if_t<std::is_same_v<T, Type<TypeCategory::Character>>>>
+inline Expr<T> MakeConstantExpr(int kind, const std::string &v) {
+ return Expr<T>{MakeConstant<T>(kind, v)};
+}
+
+template <typename T,
+ typename = std::enable_if_t<std::is_same_v<T, Type<TypeCategory::Integer>>>>
+inline Expr<T> MakeConstantExpr(int kind, int64_t v) {
+ return Expr<T>{Constant<T>{kind, Scalar<T>{kind, v}}};
+}
+
+template <typename T,
+ typename =
+ std::enable_if_t<std::is_same_v<T, Type<TypeCategory::Unsigned>>>>
+inline Expr<T> MakeConstantExpr(int kind, uint64_t v) {
+ return Expr<T>{Constant<T>{kind, Scalar<T>{kind, v}}};
+}
+
+template <typename T,
+ typename = std::enable_if_t<std::is_same_v<T, Type<TypeCategory::Logical>>>>
+inline Expr<T> MakeConstantExpr(int kind, bool v) {
+ return Expr<T>{Constant<T>{kind, Scalar<T>{kind, v}}};
+}
+
+template <typename T> inline Expr<T> MakeZeroExpr(int kind) {
+ return MakeConstantExpr<T>(kind, Scalar<T>::Zero(kind));
+}
+
+inline Expr<SubscriptInteger> MakeSubscriptIntExpr(int64_t v) {
+ return Expr<SubscriptInteger>{MakeSubscriptIntConstant(v)};
+}
+
+inline Expr<SubscriptInteger> MakeSubscriptIntExpr(
+ const Scalar<SubscriptInteger> &v) {
+ return Expr<SubscriptInteger>{
+ Constant<SubscriptInteger>{SubscriptIntegerKind, v}};
+}
+
+inline Expr<SubscriptInteger> MakeSubscriptIntExpr(
+ Scalar<SubscriptInteger> &&v) {
+ return Expr<SubscriptInteger>{
+ Constant<SubscriptInteger>{SubscriptIntegerKind, std::move(v)}};
+}
+
+inline Expr<CInteger> MakeCIntegerExpr(int32_t v) {
+ return Expr<CInteger>{MakeCIntegerConstant(v)};
+}
+
+inline Expr<LogicalResult> MakeLogicalResultExpr(bool v) {
+ return Expr<LogicalResult>{MakeLogicalResultConstant(v)};
+}
+
+inline Expr<Ascii> MakeAsciiExpr(const std::string &v) {
+ return Expr<Ascii>{MakeConstant<Ascii>(AsciiKind, v)};
+}
+
+inline Expr<Ascii> MakeAsciiExpr(std::string &&v) {
+ return Expr<Ascii>{MakeConstant<Ascii>(AsciiKind, std::move(v))};
+}
+
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_EXPRESSION_H_
diff --git a/flang/include/flang/Evaluate/fold-designator.h b/flang/include/flang/Evaluate/fold-designator.h
index 919f3c6db547b..8c1495b41511a 100644
--- a/flang/include/flang/Evaluate/fold-designator.h
+++ b/flang/include/flang/Evaluate/fold-designator.h
@@ -113,13 +113,13 @@ class DesignatorFolder {
return common::visit(
[&](const auto &x) { return FoldDesignator(x, which); }, designator.u);
}
- template <int KIND>
std::optional<OffsetSymbol> FoldDesignator(
- const Designator<Type<TypeCategory::Character, KIND>> &designator,
+ const Designator<Type<TypeCategory::Character>> &designator,
ConstantSubscript which) {
+ const int kind{designator.kind()};
return common::visit(
common::visitors{
- [&](const Substring &ss) {
+ [&, kind](const Substring &ss) {
if (const auto *dataRef{ss.GetParentIf<DataRef>()}) {
if (auto result{FoldDesignator(*dataRef, which)}) {
if (auto start{ToInt64(ss.lower())}) {
@@ -134,9 +134,9 @@ class DesignatorFolder {
if (*start < 1) {
isOutOfRange_ = true;
}
- result->Augment(KIND * (*start - 1));
+ result->Augment(kind * (*start - 1));
result->set_size(
- *end >= *start ? KIND * (*end - *start + 1) : 0);
+ *end >= *start ? kind * (*end - *start + 1) : 0);
if (len) {
if (auto lenVal{ToInt64(*len)}) {
if (*end > *lenVal) {
diff --git a/flang/include/flang/Evaluate/fold.h b/flang/include/flang/Evaluate/fold.h
index 709b40ec1aac3..40ed44b620356 100644
--- a/flang/include/flang/Evaluate/fold.h
+++ b/flang/include/flang/Evaluate/fold.h
@@ -74,25 +74,34 @@ constexpr auto GetScalarConstantValue(const EXPR &expr)
return std::nullopt;
}
}
+template <typename T, typename EXPR>
+constexpr auto GetScalarConstantValue(int kind, const EXPR &expr)
+ -> std::optional<Scalar<T>> {
+ if (const Constant<T> *constant{UnwrapConstantValue<T>(expr)}) {
+ if (constant->kind() == kind) {
+ return constant->GetScalarValue();
+ } else {
+ return std::nullopt;
+ }
+ } else {
+ return std::nullopt;
+ }
+}
// When an expression is a constant integer, ToInt64() extracts its value.
// Ensure that the expression has been folded beforehand when folding might
// be required.
-template <int KIND>
-constexpr std::optional<std::int64_t> ToInt64(
- const Expr<Type<TypeCategory::Integer, KIND>> &expr) {
- if (auto scalar{
- GetScalarConstantValue<Type<TypeCategory::Integer, KIND>>(expr)}) {
+inline std::optional<std::int64_t> ToInt64(
+ const Expr<Type<TypeCategory::Integer>> &expr) {
+ if (auto scalar{GetScalarConstantValue<Type<TypeCategory::Integer>>(expr)}) {
return scalar->ToInt64();
} else {
return std::nullopt;
}
}
-template <int KIND>
-constexpr std::optional<std::int64_t> ToInt64(
- const Expr<Type<TypeCategory::Unsigned, KIND>> &expr) {
- if (auto scalar{
- GetScalarConstantValue<Type<TypeCategory::Unsigned, KIND>>(expr)}) {
+inline std::optional<std::int64_t> ToInt64(
+ const Expr<Type<TypeCategory::Unsigned>> &expr) {
+ if (auto scalar{GetScalarConstantValue<Type<TypeCategory::Unsigned>>(expr)}) {
return scalar->ToInt64();
} else {
return std::nullopt;
diff --git a/flang/include/flang/Evaluate/initial-image.h b/flang/include/flang/Evaluate/initial-image.h
index 9a767db95f6c6..59de3a883f258 100644
--- a/flang/include/flang/Evaluate/initial-image.h
+++ b/flang/include/flang/Evaluate/initial-image.h
@@ -20,6 +20,25 @@
namespace Fortran::evaluate {
+template <typename SCALAR>
+inline void StoreSerialValues(int kind, char *dst,
+ llvm::ArrayRef<SCALAR> values, size_t elementSize,
+ bool *changed = nullptr) {
+ for (auto [i, v] : llvm::enumerate(values)) {
+ CHECK(v.kind() == kind);
+ v.StoreRawBytes(dst + i * elementSize, elementSize, changed);
+ }
+}
+
+template <typename SCALAR>
+inline void LoadSerialValues(int kind, const char *src,
+ llvm::MutableArrayRef<SCALAR> values, size_t stride) {
+ for (auto it : llvm::enumerate(values)) {
+ it.value() = SCALAR::FromRawBytes(
+ kind, src + stride * it.index(), SCALAR::bytesStored(kind));
+ }
+}
+
class InitialImage {
public:
enum Result {
@@ -44,6 +63,7 @@ class InitialImage {
template <typename T>
Result Add(ConstantSubscript offset, std::size_t bytes, const Constant<T> &x,
FoldingContext &context) {
+ const int kind{x.kind()};
if (offset < 0 || offset + bytes > data_.size()) {
return OutOfRange;
} else {
@@ -56,21 +76,16 @@ class InitialImage {
return OkNoChange;
} else {
// TODO endianness
- auto *to{&data_.at(offset)};
- const auto *from{&x.values().at(0)};
- if (std::memcmp(to, from, bytes) == 0) {
- return OkNoChange;
- } else {
- std::memcpy(to, from, bytes);
- return Ok;
- }
+ bool changed{false};
+ StoreSerialValues(kind, &data_.at(offset),
+ llvm::ArrayRef<Scalar<T>>(x.values()), *elementBytes, &changed);
+ return changed ? Ok : OkNoChange;
}
}
}
- template <int KIND>
Result Add(ConstantSubscript offset, std::size_t bytes,
- const Constant<Type<TypeCategory::Character, KIND>> &x,
- FoldingContext &) {
+ const Constant<Type<TypeCategory::Character>> &x, FoldingContext &) {
+ const int kind{x.kind()};
if (offset < 0 || offset + bytes > data_.size()) {
return OutOfRange;
} else {
@@ -87,13 +102,13 @@ class InitialImage {
} else {
Result result{OkNoChange};
for (auto at{x.lbounds()}; elements-- > 0; x.IncrementSubscripts(at)) {
- auto scalar{x.At(at)}; // this is a std string; size() in chars
- auto scalarBytes{scalar.size() * KIND};
+ auto scalar{x.At(at)}; // a CharacterValue; size() in chars
+ auto scalarBytes{scalar.size() * kind};
if (scalarBytes != elementBytes) {
result = LengthMismatch;
}
// Blank padding when short
- for (; scalarBytes < elementBytes; scalarBytes += KIND) {
+ for (; scalarBytes < elementBytes; scalarBytes += kind) {
scalar += ' ';
}
// TODO endianness
diff --git a/flang/include/flang/Evaluate/integer-value.h b/flang/include/flang/Evaluate/integer-value.h
new file mode 100644
index 0000000000000..c1777faf7ea95
--- /dev/null
+++ b/flang/include/flang/Evaluate/integer-value.h
@@ -0,0 +1,318 @@
+//===-- include/flang/Evaluate/integer-value.h ------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_EVALUATE_INTEGER_VALUE_H_
+#define FORTRAN_EVALUATE_INTEGER_VALUE_H_
+
+#include "flang/Evaluate/common.h"
+#include "flang/Evaluate/object-sizes.h"
+#include <cstdint>
+#include <type_traits>
+
+// Some environments, viz. glibc 2.17 and *BSD, allow the macro HUGE
+// to leak out of <math.h>.
+#undef HUGE
+
+namespace Fortran::evaluate::value {
+class IntegerValueImpl;
+
+/// A two's-complement integer with dynamic bitwidth.
+///
+/// The bitwidth is dynamic, but only a predefined set of Fortran kinds are
+/// allowed. It is also kind-aware, i.e. knows which INTEGER kind it currently
+/// represents.
+///
+/// The implementation is hidden from this header using a pImpl-like idiom.
+class IntegerValue {
+ friend class RealValueImpl;
+
+public:
+ struct ValueWithOverflow;
+ struct ValueWithCarry;
+ struct Product;
+ struct QuotientWithRemainder;
+ struct PowerWithErrors;
+
+ IntegerValue();
+ ~IntegerValue();
+ IntegerValue(const IntegerValue &);
+ IntegerValue(IntegerValue &&);
+ IntegerValue &operator=(const IntegerValue &);
+ IntegerValue &operator=(IntegerValue &&);
+
+ IntegerValue(int kind, const IntegerValue &x) : IntegerValue(x) {
+ CHECK(x.kind() == kind);
+ }
+ IntegerValue(int kind, IntegerValue &&x) : IntegerValue(std::move(x)) {
+ CHECK(x.kind() == kind);
+ }
+
+ template <typename INT, typename = std::enable_if_t<std::is_integral_v<INT>>>
+ IntegerValue(int kind, INT n) {
+ ConstructFromIntegral(
+ kind, static_cast<std::uint64_t>(n), std::is_signed_v<INT>);
+ }
+
+ /// Creates an integer with value 0 of a given kind. This is different from
+ /// the default-ctor which creates a "monostate" that represents 0 of unknown
+ /// kind.
+ static IntegerValue Zero(int kind);
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+ LLVM_DUMP_METHOD void dump() const;
+#endif
+
+ /// Whether this object represents a default-initialized value (zero) of
+ /// not-yet-known kind.
+ bool IsMonostate() const;
+
+ /// The kind of the value currently stored.
+ int kind() const;
+
+ int bits() const { return bits(kind()); }
+ static constexpr int bits(int kind) { return bytesStored(kind) * 8; }
+
+ /// Number of bytes accessed by FromRawBytes/StoreRawBytes
+ std::size_t bytesStored() const { return bytesStored(kind()); }
+ static constexpr std::size_t bytesStored(int kind) {
+ switch (kind) {
+ case 3:
+ return 2;
+ case 10:
+ return 16;
+ default:
+ return kind;
+ }
+ }
+
+ bool operator<(const IntegerValue &y) const {
+ return CompareSigned(y) == Ordering::Less;
+ }
+ bool operator<=(const IntegerValue &y) const { return !(y < *this); }
+ bool operator==(const IntegerValue &y) const;
+ bool operator!=(const IntegerValue &y) const { return !(*this == y); }
+ bool operator>=(const IntegerValue &y) const { return !(*this < y); }
+ bool operator>(const IntegerValue &y) const { return y < *this; }
+
+ /// Left-justified mask (e.g., MASKL(1) has only its sign bit set)
+ static IntegerValue MASKL(int kind, int places);
+
+ /// Right-justified mask (e.g., MASKR(1) == 1, MASKR(2) == 3, &c.)
+ static IntegerValue MASKR(int kind, int places);
+
+ static ValueWithOverflow Read(
+ int kind, const char *&pp, int base, bool isSigned);
+
+ /// ZExt or Trunc
+ static ValueWithOverflow ConvertUnsigned(
+ const IntegerValue &from, int toBits);
+
+ /// SExt or Trunc
+ static ValueWithOverflow ConvertSigned(const IntegerValue &from, int toBits);
+
+ std::string UnsignedDecimal() const;
+
+ std::string SignedDecimal() const;
+
+ /// Omits a leading "0x".
+ std::string Hexadecimal() const;
+
+ static constexpr int DIGITS(int kind) {
+ // don't count the sign bit
+ return bits(kind) - 1;
+ }
+
+ static IntegerValue HUGE(int kind);
+
+ static IntegerValue Least(int kind);
+
+ static int RANGE(int kind);
+
+ static int UnsignedRANGE(int kind);
+
+ bool IsZero() const;
+
+ bool IsNegative() const;
+
+ Ordering CompareToZeroSigned() const;
+
+ /// Count the number of contiguous most-significant bit positions
+ /// that are clear.
+ int LEADZ() const;
+
+ /// Count the number of bit positions that are set.
+ int POPCNT() const;
+
+ /// True when POPCNT is odd.
+ bool POPPAR() const;
+
+ int TRAILZ() const;
+
+ bool BTEST(int pos) const;
+
+ Ordering CompareUnsigned(const IntegerValue &y) const;
+
+ bool BGE(const IntegerValue &y) const {
+ return CompareUnsigned(y) != Ordering::Less;
+ }
+ bool BGT(const IntegerValue &y) const {
+ return CompareUnsigned(y) == Ordering::Greater;
+ }
+ bool BLE(const IntegerValue &y) const { return !BGT(y); }
+ bool BLT(const IntegerValue &y) const { return !BGE(y); }
+
+ Ordering CompareSigned(const IntegerValue &y) const;
+
+ std::uint64_t ToUInt64() const;
+
+ std::int64_t ToInt64() const;
+
+ std::int64_t ToSInt() const { return ToInt64(); }
+
+ /// Ones'-complement (i.e., C's ~)
+ IntegerValue NOT() const;
+
+ /// Two's-complement negation (-x = ~x + 1).
+ /// An overflow flag accompanies the result, and will be true when the
+ /// operand is the most negative signed number (MASKL(1)).
+ ValueWithOverflow Negate() const;
+
+ ValueWithOverflow ABS() const;
+
+ /// Shifts the operand left when the count is positive, right when negative.
+ /// Vacated bit positions are filled with zeroes.
+ IntegerValue ISHFT(int count) const {
+ return count < 0 ? SHIFTR(-count) : SHIFTL(count);
+ }
+
+ /// Left shift with zero fill.
+ IntegerValue SHIFTL(int count) const;
+
+ /// Circular shift of a field of least-significant bits. The least-order
+ /// "size" bits are shifted circularly in place by "count" positions;
+ /// the shift is leftward if count is nonnegative, rightward otherwise.
+ /// Higher-order bits are unchanged.
+ IntegerValue ISHFTC(int count, int size) const;
+ IntegerValue ISHFTC(int count) const;
+
+ /// DSHIFTL(I,J) shifts I:J left; the second argument is the right fill.
+ IntegerValue DSHIFTL(const IntegerValue &fill, int count) const;
+
+ /// DSHIFTR(I,J) shifts I:J right; the *first* argument is the left fill.
+ IntegerValue DSHIFTR(const IntegerValue &v2, int count) const;
+
+ /// Vacated upper bits are filled with zeroes.
+ IntegerValue SHIFTR(int count) const;
+
+ /// Be advised, an arithmetic (sign-filling) right shift is not
+ /// the same as a division by a power of two in all cases.
+ IntegerValue SHIFTA(int count) const;
+
+ /// Clears a single bit.
+ IntegerValue IBCLR(int pos) const;
+
+ /// Sets a single bit.
+ IntegerValue IBSET(int pos) const;
+
+ /// Extracts a field.
+ IntegerValue IBITS(int pos, int size) const;
+
+ IntegerValue IAND(const IntegerValue &y) const;
+
+ IntegerValue IOR(const IntegerValue &y) const;
+
+ IntegerValue IEOR(const IntegerValue &y) const;
+
+ IntegerValue MERGE_BITS(
+ const IntegerValue &y, const IntegerValue &mask) const;
+
+ IntegerValue MAX(const IntegerValue &y) const {
+ return CompareSigned(y) == Ordering::Less ? y : *this;
+ }
+
+ IntegerValue MIN(const IntegerValue &y) const {
+ return CompareSigned(y) == Ordering::Less ? *this : y;
+ }
+
+ ValueWithCarry AddUnsigned(const IntegerValue &y, bool carryIn = false) const;
+
+ ValueWithOverflow AddSigned(const IntegerValue &y) const;
+
+ ValueWithOverflow SubtractSigned(const IntegerValue &y) const;
+
+ /// DIM(X,Y)=MAX(X-Y, 0)
+ ValueWithOverflow DIM(const IntegerValue &y) const;
+
+ ValueWithOverflow SIGN(const IntegerValue &sign) const;
+
+ Product MultiplyUnsigned(const IntegerValue &y) const;
+
+ Product MultiplySigned(const IntegerValue &y) const;
+
+ QuotientWithRemainder DivideUnsigned(const IntegerValue &y) const;
+
+ /// A nonzero remainder has the sign of the dividend, i.e., it computes
+ /// the MOD intrinsic (X-INT(X/Y)*Y), not MODULO (which is below).
+ /// 8/5 = 1r3; -8/5 = -1r-3; 8/-5 = -1r3; -8/-5 = 1r-3
+ QuotientWithRemainder DivideSigned(const IntegerValue &y) const;
+
+ /// Result has the sign of the divisor argument.
+ /// 8 mod 5 = 3; -8 mod 5 = 2; 8 mod -5 = -2; -8 mod -5 = -3
+ ValueWithOverflow MODULO(const IntegerValue &y) const;
+
+ PowerWithErrors Power(const IntegerValue &e) const;
+
+ static IntegerValue FromRawBytes(
+ int kind, const void *raw, std::size_t expectedSize);
+ void StoreRawBytes(void *dst, size_t size, bool *changed = nullptr) const;
+
+private:
+ void ConstructFromIntegral(int kind, std::uint64_t n, bool isSigned);
+
+ static IntegerValue FromImpl(const IntegerValueImpl &x);
+ static IntegerValue FromImpl(IntegerValueImpl &&x);
+
+ IntegerValueImpl &impl() {
+ return *reinterpret_cast<IntegerValueImpl *>(this);
+ }
+ const IntegerValueImpl &impl() const {
+ return *reinterpret_cast<const IntegerValueImpl *>(this);
+ }
+
+ [[maybe_unused]] alignas(
+ detail::kIntegerObjectAlign) char opaque_[detail::kIntegerObjectSize];
+};
+
+struct IntegerValue::ValueWithOverflow {
+ IntegerValue value;
+ bool overflow{false};
+};
+
+struct IntegerValue::ValueWithCarry {
+ IntegerValue value;
+ bool carry{false};
+};
+
+struct IntegerValue::Product {
+ IntegerValue upper, lower;
+ bool SignedMultiplicationOverflowed() const { return overflow; }
+ bool overflow{false};
+};
+
+struct IntegerValue::QuotientWithRemainder {
+ IntegerValue quotient, remainder;
+ bool divisionByZero{false}, overflow{false};
+};
+
+struct IntegerValue::PowerWithErrors {
+ IntegerValue power;
+ bool divisionByZero{false}, overflow{false}, zeroToZero{false};
+};
+
+} // namespace Fortran::evaluate::value
+#endif // FORTRAN_EVALUATE_INTEGER_VALUE_H_
diff --git a/flang/include/flang/Evaluate/logical-value.h b/flang/include/flang/Evaluate/logical-value.h
new file mode 100644
index 0000000000000..cfc5e8db6abd7
--- /dev/null
+++ b/flang/include/flang/Evaluate/logical-value.h
@@ -0,0 +1,153 @@
+//===-- include/flang/Evaluate/logical-value.h ------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_EVALUATE_LOGICAL_VALUE_H_
+#define FORTRAN_EVALUATE_LOGICAL_VALUE_H_
+
+#include "integer-value.h"
+#include <utility>
+
+namespace Fortran::evaluate::value {
+
+/// A Fortran LOGICAL value.
+///
+/// The kind is dynamic, but only a predefined set of Fortran kinds are
+/// allowed. It is also kind-aware, i.e. knows which LOGICAL kind it currently
+/// represents.
+///
+/// It is implemented as a wrapper around IntegerValue.
+class LogicalValue {
+public:
+ using Word = IntegerValue;
+
+ LogicalValue() {}
+ LogicalValue(const LogicalValue &) = default;
+ LogicalValue(LogicalValue &&) = default;
+ LogicalValue &operator=(const LogicalValue &) = default;
+ LogicalValue &operator=(LogicalValue &&) = default;
+
+ LogicalValue(int kind, const LogicalValue &v) : LogicalValue{v} {
+ CHECK(kind == v.kind());
+ }
+
+ LogicalValue(int kind, LogicalValue &&v) : LogicalValue{std::move(v)} {
+ CHECK(kind == v.kind());
+ }
+
+ LogicalValue(int kind, bool truth) : word_(Represent(kind, truth)) {}
+
+ LogicalValue(int kind, const Word &w) : word_(kind, w) {}
+
+ /// Creates a logical with value 'false' of a given kind. This is in contrast
+ /// to the default-ctor which creates a "monostate" that represents 'false' of
+ /// a not-yet-known kind.
+ static LogicalValue Zero(int kind) { return LogicalValue{kind, false}; }
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+ LLVM_DUMP_METHOD void dump() const;
+#endif
+
+ /// Whether this object represents a default-initialized value ('false') of
+ /// unknown kind.
+ bool IsMonostate() const { return word_.IsMonostate(); }
+
+ /// The kind of the value currently stored.
+ int kind() const { return word_.kind(); }
+
+ int bits() const { return bits(kind()); }
+ static constexpr int bits(int kind) { return Word::bits(kind); }
+
+ /// Number of bytes accessed by FromRawBytes/StoreRawBytes
+ std::size_t bytesStored() const { return bytesStored(kind()); }
+ static constexpr std::size_t bytesStored(int kind) {
+ return Word::bytesStored(kind);
+ }
+
+ Word word() const { return word_; }
+
+ bool IsCanonical() const {
+ const int kind{this->kind()};
+ return word_ == canonicalFalse(kind) || word_ == canonicalTrue(kind);
+ }
+
+ /// Fortran actually has only .EQV. & .NEQV. relational operations
+ /// for LOGICAL, but this class supports more so that it can be used
+ /// with the STL for sorting and as a key type for std::set<> & std::map<>.
+ bool operator<(const LogicalValue &that) const {
+ return !IsTrue() && that.IsTrue();
+ }
+ bool operator<=(const LogicalValue &that) const { return !IsTrue(); }
+ bool operator==(const LogicalValue &that) const {
+ return IsTrue() == that.IsTrue();
+ }
+ bool operator!=(const LogicalValue &that) const {
+ return IsTrue() != that.IsTrue();
+ }
+
+ bool operator>=(const LogicalValue &that) const { return IsTrue(); }
+
+ bool operator>(const LogicalValue &that) const {
+ return IsTrue() && !that.IsTrue();
+ }
+
+ bool IsTrue() const { return !word_.IsZero(); }
+
+ LogicalValue NOT() const {
+ return FromWord(word_.IEOR(canonicalTrue(kind())));
+ }
+
+ LogicalValue AND(const LogicalValue &that) const {
+ return FromWord(word_.IAND(that.word()));
+ }
+
+ LogicalValue OR(const LogicalValue &that) const {
+ return FromWord(word_.IOR(that.word()));
+ }
+
+ LogicalValue EQV(const LogicalValue &that) const { return NEQV(that).NOT(); }
+
+ LogicalValue NEQV(const LogicalValue &that) const {
+ return FromWord(word_.IEOR(that.word()));
+ }
+
+ static LogicalValue FromRawBytes(
+ int kind, const void *raw, std::size_t expectedSize) {
+ Word w{Word::FromRawBytes(kind, raw, expectedSize)};
+ return LogicalValue{w.kind(), w};
+ }
+
+ void StoreRawBytes(void *dst, size_t size, bool *changed = nullptr) const {
+ word_.StoreRawBytes(dst, size, changed);
+ }
+
+private:
+ static Word canonicalTrue(int kind) { return Word{kind, 1}; }
+
+ static Word canonicalFalse(int kind) { return Word{kind, 0}; }
+
+ static Word Represent(int kind, bool x) {
+ return x ? canonicalTrue(kind) : canonicalFalse(kind);
+ }
+
+ static LogicalValue FromWord(const Word &w) {
+ LogicalValue v;
+ v.word_ = w;
+ return v;
+ }
+
+ static LogicalValue FromWord(Word &&w) {
+ LogicalValue v;
+ v.word_ = std::move(w);
+ return v;
+ }
+
+ Word word_;
+};
+
+} // namespace Fortran::evaluate::value
+#endif // FORTRAN_EVALUATE_LOGICAL_VALUE_H_
diff --git a/flang/include/flang/Evaluate/logical.h b/flang/include/flang/Evaluate/logical.h
deleted file mode 100644
index 5996853215e30..0000000000000
--- a/flang/include/flang/Evaluate/logical.h
+++ /dev/null
@@ -1,110 +0,0 @@
-//===-- include/flang/Evaluate/logical.h ------------------------*- C++ -*-===//
-//
-// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
-// See https://llvm.org/LICENSE.txt for license information.
-// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-//
-//===----------------------------------------------------------------------===//
-
-#ifndef FORTRAN_EVALUATE_LOGICAL_H_
-#define FORTRAN_EVALUATE_LOGICAL_H_
-
-#include "integer.h"
-#include <cinttypes>
-
-namespace Fortran::evaluate::value {
-
-template <int BITS, bool IS_LIKE_C = true> class Logical {
-public:
- static constexpr int bits{BITS};
- using Word = Integer<bits>;
-
- // Module ISO_C_BINDING kind C_BOOL is LOGICAL(KIND=1) and must have
- // C's bit representation (.TRUE. -> 1, .FALSE. -> 0).
- static constexpr bool IsLikeC{BITS <= 8 || IS_LIKE_C};
-
- constexpr Logical() {} // .FALSE.
- template <int B, bool C>
- constexpr Logical(Logical<B, C> x) : word_{Represent(x.IsTrue())} {}
- constexpr Logical(bool truth) : word_{Represent(truth)} {}
- // A raw word, for DATA initialization
- constexpr Logical(Word &&w) : word_{std::move(w)} {}
-
- template <int B, bool C> constexpr Logical &operator=(Logical<B, C> x) {
- word_ = Represent(x.IsTrue());
- return *this;
- }
-
- Word word() const { return word_; }
- bool IsCanonical() const {
- return word_ == canonicalFalse || word_ == canonicalTrue;
- }
-
- // Fortran actually has only .EQV. & .NEQV. relational operations
- // for LOGICAL, but this template class supports more so that
- // it can be used with the STL for sorting and as a key type for
- // std::set<> & std::map<>.
- template <int B, bool C>
- constexpr bool operator<(const Logical<B, C> &that) const {
- return !IsTrue() && that.IsTrue();
- }
- template <int B, bool C>
- constexpr bool operator<=(const Logical<B, C> &) const {
- return !IsTrue();
- }
- template <int B, bool C>
- constexpr bool operator==(const Logical<B, C> &that) const {
- return IsTrue() == that.IsTrue();
- }
- template <int B, bool C>
- constexpr bool operator!=(const Logical<B, C> &that) const {
- return IsTrue() != that.IsTrue();
- }
- template <int B, bool C>
- constexpr bool operator>=(const Logical<B, C> &) const {
- return IsTrue();
- }
- template <int B, bool C>
- constexpr bool operator>(const Logical<B, C> &that) const {
- return IsTrue() && !that.IsTrue();
- }
-
- constexpr bool IsTrue() const {
- if constexpr (IsLikeC) {
- return !word_.IsZero();
- } else {
- return word_.BTEST(0);
- }
- }
-
- constexpr Logical NOT() const { return {word_.IEOR(canonicalTrue)}; }
-
- constexpr Logical AND(const Logical &that) const {
- return {word_.IAND(that.word_)};
- }
-
- constexpr Logical OR(const Logical &that) const {
- return {word_.IOR(that.word_)};
- }
-
- constexpr Logical EQV(const Logical &that) const { return NEQV(that).NOT(); }
-
- constexpr Logical NEQV(const Logical &that) const {
- return {word_.IEOR(that.word_)};
- }
-
-private:
- static constexpr Word canonicalTrue{IsLikeC ? 1 : -std::uint64_t{1}};
- static constexpr Word canonicalFalse{0};
- static constexpr Word Represent(bool x) {
- return x ? canonicalTrue : canonicalFalse;
- }
- Word word_;
-};
-
-extern template class Logical<8>;
-extern template class Logical<16>;
-extern template class Logical<32>;
-extern template class Logical<64>;
-} // namespace Fortran::evaluate::value
-#endif // FORTRAN_EVALUATE_LOGICAL_H_
diff --git a/flang/include/flang/Evaluate/match.h b/flang/include/flang/Evaluate/match.h
index dfbfd1b4b64e3..c579862752ee9 100644
--- a/flang/include/flang/Evaluate/match.h
+++ b/flang/include/flang/Evaluate/match.h
@@ -36,9 +36,9 @@ struct IsOperation<T, std::void_t<decltype(T::operands)>> {
template <typename T>
constexpr bool is_operation_v{detail::IsOperation<T>::value};
-template <common::TypeCategory C, int K>
-const evaluate::Expr<Type<C, K>> &deparen(const evaluate::Expr<Type<C, K>> &x) {
- if (auto *parens{std::get_if<Parentheses<Type<C, K>>>(&x.u)}) {
+template <common::TypeCategory C>
+const evaluate::Expr<Type<C>> &deparen(const evaluate::Expr<Type<C>> &x) {
+ if (auto *parens{std::get_if<Parentheses<Type<C>>>(&x.u)}) {
return deparen(parens->template operand<0>());
} else {
return x;
@@ -189,16 +189,13 @@ OperationPattern(const Ops &..., llvm::type_identity<OpType>)
// only from operand patterns. This will make it usable in AnyOfPattern.
template <common::LogicalOperator Operator, typename ValType, typename... Ops>
struct LogicalOperationPattern
- : public OperationPattern<LogicalOperation<ValType::kind>, Ops...> {
- using Base = OperationPattern<LogicalOperation<ValType::kind>, Ops...>;
+ : public OperationPattern<LogicalOperation, Ops...> {
+ using Base = OperationPattern<LogicalOperation, Ops...>;
static constexpr common::LogicalOperator opCode{Operator};
private:
- template <int K> bool matchOp(const LogicalOperation<K> &op) const {
- if constexpr (ValType::kind == K) {
- return op.logicalOperator == opCode;
- }
- return false;
+ bool matchOp(const LogicalOperation &op) const {
+ return op.logicalOperator == opCode;
}
template <typename U> bool matchOp(const U &) const { return false; }
diff --git a/flang/include/flang/Evaluate/object-sizes.h b/flang/include/flang/Evaluate/object-sizes.h
new file mode 100644
index 0000000000000..eae220d34fff0
--- /dev/null
+++ b/flang/include/flang/Evaluate/object-sizes.h
@@ -0,0 +1,81 @@
+//===-- include/flang/Evaluate/object-sizes.h -------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Object size/alignment for the opaque facades IntegerValue, RealValue,
+// CharacterValue and their variant-backed implementations IntegerValueImpl,
+// RealValueImpl, CharacterValueImpl.
+//
+// When not cross-compiling, flang-evaluate-object-size-probe measures these
+// with the very toolchain (and per build configuration) used for the build and
+// emits object-sizes-generated.h into the build tree's include
+// directory. Those values directly measured are preferred whenever that header
+// is available on the include path, regardless of -I ordering. The constants
+// below are the fallback used otherwise -- in particular when cross-compiling,
+// where the probe cannot run on the build host. They are verified against the
+// implementation classes by static_asserts in integer-value.cpp, real-value.cpp
+// and character-value.cpp.
+//
+// The probe itself (object-size-probe.cpp) compiles with
+// FLANG_OBJECT_SIZE_PROBE defined: it generates the header, so it
+// must not depend on it. The dedicated #if branch below omits __has_include so
+// dependency scanners do not record the generated header (probe -> generated
+// header -> probe cycle).
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_EVALUATE_OBJECT_SIZES_H_
+#define FORTRAN_EVALUATE_OBJECT_SIZES_H_
+
+#include <cstddef>
+
+#ifdef FLANG_OBJECT_SIZE_PROBE
+#error This header must not be included into the object-size-probe executable itself (in particular, integer-value-impl.h, real-value-impl.h, character-value-impl.h); it would cause a dependency cycle in incremental builds.
+#endif
+
+#if __has_include(<flang/Evaluate/object-sizes-generated.h>)
+// Measured object sizes
+#include <flang/Evaluate/object-sizes-generated.h>
+#else
+// Fallback known object sizes
+//
+// These fallbacks assume a 64-bit (LP64/LLP64) host, which covers the targets
+// flang is built for (x86_64, AArch64, PowerPC64).
+namespace Fortran::evaluate::value::detail {
+
+inline constexpr std::size_t kIntegerObjectSize{20};
+inline constexpr std::size_t kIntegerObjectAlign{4};
+
+inline constexpr std::size_t kRealObjectSize{32};
+inline constexpr std::size_t kRealObjectAlign{16};
+
+// CharacterValueImpl is a
+// std::variant<std::string, std::u16string, std::u32string>.
+//
+// * MSVC STL: 48 bytes with _ITERATOR_DEBUG_LEVEL==2
+// 40 bytes otherwise
+// * libc++: 32 bytes
+// invariant to _LIBCPP_HARDENING_MODE
+// * libstdc++: 40 bytes
+// invariant to _GLIBCXX_ASSERTIONS or _GLIBCXX_DEBUG
+#if defined(_MSC_VER) && \
+ ((defined(_ITERATOR_DEBUG_LEVEL) && _ITERATOR_DEBUG_LEVEL >= 2) || \
+ (!defined(_ITERATOR_DEBUG_LEVEL) && defined(_DEBUG)))
+inline constexpr std::size_t kCharacterObjectSize{48};
+#elif defined(_LIBCPP_VERSION)
+inline constexpr std::size_t kCharacterObjectSize{32};
+#elif defined(__GLIBCXX__) || defined(__GLIBCPP__)
+inline constexpr std::size_t kCharacterObjectSize{40};
+#else
+#error Unknown STL implementation
+#endif
+inline constexpr std::size_t kCharacterObjectAlign{8};
+
+} // namespace Fortran::evaluate::value::detail
+#endif
+
+#endif // FORTRAN_EVALUATE_OBJECT_SIZES_H_
diff --git a/flang/include/flang/Evaluate/real-value.h b/flang/include/flang/Evaluate/real-value.h
new file mode 100644
index 0000000000000..aa1ab0164b20b
--- /dev/null
+++ b/flang/include/flang/Evaluate/real-value.h
@@ -0,0 +1,237 @@
+//===-- include/flang/Evaluate/real-value.h ---------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_EVALUATE_REAL_VALUE_H_
+#define FORTRAN_EVALUATE_REAL_VALUE_H_
+
+#include "flang/Evaluate/integer-value.h"
+#include "flang/Evaluate/object-sizes.h"
+#include "flang/Evaluate/target.h"
+
+// Some environments, viz. glibc 2.17 and *BSD, allow the macro HUGE
+// to leak out of <math.h>.
+#undef HUGE
+
+namespace Fortran::evaluate::value {
+class RealValueImpl;
+
+/// A floating-point value with dynamic precision.
+///
+/// The precision is dynamic, but only a predefined set of Fortran kinds are
+/// allowed. It is also kind-aware, i.e. knows which REAL kind it currently
+/// represents.
+///
+/// The implementation is hidden from this header using a pImpl-like idiom.
+class RealValue {
+public:
+ using Word = IntegerValue;
+
+ RealValue();
+ ~RealValue();
+ RealValue(const RealValue &);
+ RealValue(RealValue &&);
+ RealValue &operator=(const RealValue &);
+ RealValue &operator=(RealValue &&);
+
+ RealValue(int kind, const RealValue &v) : RealValue(v) {
+ CHECK(kind == v.kind());
+ }
+ RealValue(int kind, RealValue &&v) : RealValue(std::move(v)) {
+ CHECK(kind == v.kind());
+ }
+
+ /// Interpret w as the raw bit pattern for the given runtime kind.
+ RealValue(int kind, const Word &w);
+
+ /// Creates a floating-point with value +0.0 of a given kind. In contrast, the
+ /// default ctor creates a "monostate" that represents +0.0 of unknown kind.
+ static RealValue Zero(int kind);
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+ LLVM_DUMP_METHOD void dump() const;
+#endif
+
+ /// Whether this object represents a default-initialized value (zero) or
+ /// unknown value.
+ bool IsMonostate() const;
+
+ /// The kind of the value currently stored.
+ int kind() const;
+
+ int bits() const { return bits(kind()); }
+ static constexpr int bits(int kind) { return bytesStored(kind) * 8; }
+
+ /// Number of bytes accessed by FromRawBytes/StoreRawBytes
+ std::size_t bytesStored() const { return bytesStored(kind()); }
+ static constexpr std::size_t bytesStored(int kind) {
+ switch (kind) {
+ case 3:
+ return 2;
+ case 10:
+ return 16;
+ default:
+ return kind;
+ }
+ }
+
+ bool operator==(const RealValue &y) const;
+ bool operator!=(const RealValue &y) const { return !operator==(y); }
+
+ bool IsNegative() const;
+
+ bool IsNotANumber() const;
+
+ bool IsSignalingNaN() const;
+
+ bool IsInfinite() const;
+
+ bool IsFinite() const;
+
+ bool IsZero() const;
+
+ bool IsNormal() const;
+
+ RealValue ABS() const;
+
+ RealValue SetSign(bool toNegative) const;
+
+ RealValue SIGN(const RealValue &x) const;
+
+ RealValue Negate() const;
+
+ Relation Compare(const RealValue &y) const;
+
+ ValueWithRealFlags<RealValue> Add(const RealValue &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ ValueWithRealFlags<RealValue> Subtract(const RealValue &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ ValueWithRealFlags<RealValue> Multiply(const RealValue &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ ValueWithRealFlags<RealValue> Divide(const RealValue &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ ValueWithRealFlags<RealValue> SQRT(
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ /// NEAREST(), IEEE_NEXT_AFTER(), IEEE_NEXT_UP(), and IEEE_NEXT_DOWN()
+ ValueWithRealFlags<RealValue> NEAREST(bool upward) const;
+
+ /// HYPOT(x,y)=SQRT(x**2 + y**2) computed so as to avoid spurious
+ /// intermediate overflows.
+ ValueWithRealFlags<RealValue> HYPOT(const RealValue &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ /// DIM(X,Y) = MAX(X-Y, 0)
+ ValueWithRealFlags<RealValue> DIM(const RealValue &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ /// MOD(x,y) = x - AINT(x/y)*y (in the standard)
+ ValueWithRealFlags<RealValue> MOD(const RealValue &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ /// MODULO(x,y) = x - FLOOR(x/y)*y (in the standard)
+ ValueWithRealFlags<RealValue> MODULO(const RealValue &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ ValueWithRealFlags<RealValue> KahanSummation(const RealValue &y,
+ RealValue &correction,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ IntegerValue EXPONENT() const;
+
+ static RealValue EPSILON(int kind);
+
+ static RealValue HUGE(int kind);
+
+ static RealValue TINY(int kind);
+
+ static int DIGITS(int kind);
+
+ static int PRECISION(int kind);
+
+ static int RANGE(int kind);
+
+ static int MAXEXPONENT(int kind);
+
+ static int MINEXPONENT(int kind);
+
+ RealValue RRSPACING() const;
+
+ RealValue SPACING() const;
+
+ RealValue SET_EXPONENT(std::int64_t e) const;
+
+ RealValue FRACTION() const;
+
+ /// SCALE(); also known as IEEE_SCALB and (in IEEE-754 '08) ScaleB.
+ ValueWithRealFlags<RealValue> SCALE(const IntegerValue &by,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ RealValue FlushSubnormalToZero() const;
+
+ // TODO: Configurable NotANumber representations
+ static RealValue NotANumber(int kind);
+
+ static ValueWithRealFlags<RealValue> FromInteger(int kind,
+ const IntegerValue &n, bool isUnsigned = false,
+ Rounding rounding = TargetCharacteristics::defaultRounding);
+
+ /// Conversion to integer in the same real format (AINT(), ANINT())
+ ValueWithRealFlags<RealValue> ToWholeNumber(
+ common::RoundingMode mode = common::RoundingMode::ToZero) const;
+
+ /// Conversion to an integer (INT(), NINT(), FLOOR(), CEILING())
+ ValueWithRealFlags<IntegerValue> ToInteger(
+ common::RoundingMode mode = common::RoundingMode::ToZero,
+ int toBits = 0) const;
+
+ static ValueWithRealFlags<RealValue> Convert(int kind, const RealValue &from,
+ Rounding rounding = TargetCharacteristics::defaultRounding);
+
+ Word RawBits() const;
+
+ /// Extracts "raw" biased exponent field.
+ int Exponent() const;
+
+ static ValueWithRealFlags<RealValue> Read(int kind, const char *&pp,
+ Rounding rounding = TargetCharacteristics::defaultRounding);
+
+ std::string DumpHexadecimal() const;
+
+ /// Emits a character representation for an equivalent Fortran constant
+ /// or parenthesized constant expression that produces this value.
+ llvm::raw_ostream &AsFortran(
+ llvm::raw_ostream &o, int kind, bool minimal = false) const;
+
+ static RealValue FromRawBytes(
+ int kind, const void *raw, std::size_t expectedSize);
+
+ void StoreRawBytes(void *dst, size_t size, bool *changed = nullptr) const;
+
+private:
+ static RealValue FromImpl(const RealValueImpl &x);
+ static RealValue FromImpl(RealValueImpl &&x);
+ static ValueWithRealFlags<RealValue> FromImpl(
+ const ValueWithRealFlags<RealValueImpl> &x);
+ static ValueWithRealFlags<RealValue> FromImpl(
+ ValueWithRealFlags<RealValueImpl> &&x);
+
+ RealValueImpl &impl() { return *reinterpret_cast<RealValueImpl *>(this); }
+ const RealValueImpl &impl() const {
+ return *reinterpret_cast<const RealValueImpl *>(this);
+ }
+
+ [[maybe_unused]] alignas(
+ detail::kRealObjectAlign) char opaque_[detail::kRealObjectSize];
+};
+
+} // namespace Fortran::evaluate::value
+#endif // FORTRAN_EVALUATE_REAL_VALUE_H_
diff --git a/flang/include/flang/Evaluate/rewrite.h b/flang/include/flang/Evaluate/rewrite.h
index b571a78b81bd6..92c058b29d792 100644
--- a/flang/include/flang/Evaluate/rewrite.h
+++ b/flang/include/flang/Evaluate/rewrite.h
@@ -126,7 +126,8 @@ template <typename Rewriter> struct Mutator {
template <typename D, size_t... Is>
D MutateOp(D &&op, std::index_sequence<Is...>) const {
- return D(Mutate(std::move(op.template operand<Is>()))...);
+ const int kind{op.kind()};
+ return D(kind, Mutate(std::move(op.template operand<Is>()))...);
}
template <typename T, size_t... Is>
@@ -135,17 +136,17 @@ template <typename Rewriter> struct Mutator {
op.ordering, Mutate(std::move(op.template operand<Is>()))...);
}
- template <int K, size_t... Is>
- ComplexComponent<K> MutateOp(
- ComplexComponent<K> &&op, std::index_sequence<Is...>) const {
- return ComplexComponent<K>(
+ template <size_t... Is>
+ ComplexComponent MutateOp(
+ ComplexComponent &&op, std::index_sequence<Is...>) const {
+ return ComplexComponent(
op.isImaginaryPart, Mutate(std::move(op.template operand<Is>()))...);
}
- template <int K, size_t... Is>
- LogicalOperation<K> MutateOp(
- LogicalOperation<K> &&op, std::index_sequence<Is...>) const {
- return LogicalOperation<K>(
+ template <size_t... Is>
+ LogicalOperation MutateOp(
+ LogicalOperation &&op, std::index_sequence<Is...>) const {
+ return LogicalOperation(
op.logicalOperator, Mutate(std::move(op.template operand<Is>()))...);
}
diff --git a/flang/include/flang/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h
index e82401dcfebd8..5bca399c50ef4 100644
--- a/flang/include/flang/Evaluate/shape.h
+++ b/flang/include/flang/Evaluate/shape.h
@@ -31,6 +31,26 @@ using ExtentExpr = Expr<ExtentType>;
using MaybeExtentExpr = std::optional<ExtentExpr>;
using Shape = std::vector<MaybeExtentExpr>;
+inline constexpr int ExtentIntKind = Fortran::evaluate::SubscriptIntegerKind;
+
+inline Constant<ExtentType> MakeExtentConstant(int64_t v) {
+ return Constant<ExtentType>{
+ ExtentIntKind, Scalar<ExtentType>{ExtentIntKind, v}};
+}
+
+inline Constant<ExtentType> MakeExtentConstant(const value::IntegerValue &v) {
+ return Constant<ExtentType>{
+ ExtentIntKind, Scalar<ExtentType>{ExtentIntKind, v}};
+}
+
+inline ExtentExpr MakeExtentExpr(int64_t v) {
+ return ExtentExpr{MakeExtentConstant(v)};
+}
+
+inline ExtentExpr MakeExtentExpr(const value::IntegerValue &v) {
+ return ExtentExpr{MakeExtentConstant(v)};
+}
+
bool IsImpliedShape(const Symbol &);
bool IsExplicitShape(const Symbol &);
@@ -258,7 +278,7 @@ class GetShapeHelper
template <typename T>
MaybeExtentExpr GetArrayConstructorExtent(
const ArrayConstructorValues<T> &values) const {
- ExtentExpr result{0};
+ ExtentExpr result{MakeExtentConstant(0)};
for (const auto &value : values) {
if (MaybeExtentExpr n{GetArrayConstructorValueExtent(value)}) {
AccumulateExtent(result, std::move(*n));
diff --git a/flang/include/flang/Evaluate/static-data.h b/flang/include/flang/Evaluate/static-data.h
index 833cc6cc6f3fa..f9cc60a4e574e 100644
--- a/flang/include/flang/Evaluate/static-data.h
+++ b/flang/include/flang/Evaluate/static-data.h
@@ -63,6 +63,7 @@ class StaticDataObject {
StaticDataObject &Push(const std::string &, bool /*ignored*/ = false);
StaticDataObject &Push(const std::u16string &, bool bigEndian = false);
StaticDataObject &Push(const std::u32string &, bool bigEndian = false);
+ StaticDataObject &Push(const value::CharacterValue &, bool bigEndian = false);
std::optional<std::string> AsString() const;
std::optional<std::u16string> AsU16String(bool bigEndian = false) const;
std::optional<std::u32string> AsU32String(bool bigEndian = false) const;
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index c877ec5f5705b..f50ddb53249fc 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -195,6 +195,27 @@ auto UnwrapExpr(B &x) -> common::Constify<A, B> * {
}
return nullptr;
}
+template <typename A, typename B>
+auto UnwrapExpr(int kind, B &x) -> common::Constify<A, B> * {
+ using Ty = std::decay_t<B>;
+ if (x.kind() != kind)
+ return nullptr;
+ if constexpr (std::is_same_v<A, Ty>) {
+ return &x;
+ } else if constexpr (std::is_same_v<Ty, ActualArgument>) {
+ if (auto *expr{x.UnwrapExpr()}) {
+ return UnwrapExpr<A>(*expr);
+ }
+ } else if constexpr (std::is_same_v<Ty, Expr<SomeType>>) {
+ return common::visit([](auto &x) { return UnwrapExpr<A>(x); }, x.u);
+ } else if constexpr (!common::HasMember<A, TypelessExpression>) {
+ if constexpr (std::is_same_v<Ty, Expr<ResultType<A>>> ||
+ std::is_same_v<Ty, Expr<SomeKind<ResultType<A>::category>>>) {
+ return common::visit([](auto &x) { return UnwrapExpr<A>(x); }, x.u);
+ }
+ }
+ return nullptr;
+}
template <typename A, typename B>
const A *UnwrapExpr(const std::optional<B> &x) {
@@ -204,6 +225,14 @@ const A *UnwrapExpr(const std::optional<B> &x) {
return nullptr;
}
}
+template <typename A, typename B>
+const A *UnwrapExpr(int kind, const std::optional<B> &x) {
+ if (x) {
+ return UnwrapExpr<A>(kind, *x);
+ } else {
+ return nullptr;
+ }
+}
template <typename A, typename B> A *UnwrapExpr(std::optional<B> &x) {
if (x) {
@@ -212,6 +241,13 @@ template <typename A, typename B> A *UnwrapExpr(std::optional<B> &x) {
return nullptr;
}
}
+template <typename A, typename B> A *UnwrapExpr(int kind, std::optional<B> &x) {
+ if (x) {
+ return UnwrapExpr<A>(kind, *x);
+ } else {
+ return nullptr;
+ }
+}
template <typename A, typename B> const A *UnwrapExpr(const B *x) {
if (x) {
@@ -221,6 +257,14 @@ template <typename A, typename B> const A *UnwrapExpr(const B *x) {
}
}
+template <typename A, typename B> const A *UnwrapExpr(int kind, const B *x) {
+ if (x) {
+ return UnwrapExpr<A>(kind, *x);
+ } else {
+ return nullptr;
+ }
+}
+
template <typename A, typename B> A *UnwrapExpr(B *x) {
if (x) {
return UnwrapExpr<A>(*x);
@@ -229,6 +273,14 @@ template <typename A, typename B> A *UnwrapExpr(B *x) {
}
}
+template <typename A, typename B> A *UnwrapExpr(int kind, B *x) {
+ if (x) {
+ return UnwrapExpr<A>(kind, *x);
+ } else {
+ return nullptr;
+ }
+}
+
// A variant of UnwrapExpr above that also skips through (parentheses)
// and conversions of kinds within a category. Useful for extracting LEN
// type parameter inquiries, at least.
@@ -545,50 +597,56 @@ const Symbol *GetLastPointerSymbol(const evaluate::DataRef &);
// one arbitrary expression to the type of another with ConvertTo(to, from).
template <typename TO, TypeCategory FROMCAT>
-Expr<TO> ConvertToType(Expr<SomeKind<FROMCAT>> &&x) {
+Expr<TO> ConvertToType(int toKind, Expr<SomeKind<FROMCAT>> &&x) {
static_assert(IsSpecificIntrinsicType<TO>);
if constexpr (FROMCAT == TO::category) {
- if (auto *already{std::get_if<Expr<TO>>(&x.u)}) {
+ auto *already{std::get_if<Expr<TO>>(&x.u)};
+ if (already && already->kind() == toKind) {
return std::move(*already);
} else {
- return Expr<TO>{Convert<TO, FROMCAT>{std::move(x)}};
+ return Expr<TO>{Convert<TO, FROMCAT>{toKind, std::move(x)}};
}
} else if constexpr (TO::category == TypeCategory::Complex) {
using Part = typename TO::Part;
- Scalar<Part> zero;
- return Expr<TO>{ComplexConstructor<TO::kind>{
- ConvertToType<Part>(std::move(x)), Expr<Part>{Constant<Part>{zero}}}};
+ return Expr<TO>{ComplexConstructor{
+ ConvertToType<Part>(toKind, std::move(x)), MakeZeroExpr<Part>(toKind)}};
} else if constexpr (FROMCAT == TypeCategory::Complex) {
// Extract and convert the real component of a complex value
return common::visit(
[&](auto &&z) {
using ZType = ResultType<decltype(z)>;
using Part = typename ZType::Part;
- return ConvertToType<TO, TypeCategory::Real>(Expr<SomeReal>{
- Expr<Part>{ComplexComponent<Part::kind>{false, std::move(z)}}});
+ return ConvertToType<TO, TypeCategory::Real>(toKind,
+ Expr<SomeReal>{
+ Expr<Part>{ComplexComponent{false, std::move(z)}}});
},
std::move(x.u));
} else {
- return Expr<TO>{Convert<TO, FROMCAT>{std::move(x)}};
+ return Expr<TO>{Convert<TO, FROMCAT>{toKind, std::move(x)}};
}
}
-template <typename TO, TypeCategory FROMCAT, int FROMKIND>
-Expr<TO> ConvertToType(Expr<Type<FROMCAT, FROMKIND>> &&x) {
- return ConvertToType<TO, FROMCAT>(Expr<SomeKind<FROMCAT>>{std::move(x)});
+template <typename TO, TypeCategory FROMCAT>
+Expr<TO> ConvertToType(int toKind, Expr<Type<FROMCAT>> &&x) {
+ return ConvertToType<TO, FROMCAT>(
+ toKind, Expr<SomeKind<FROMCAT>>{std::move(x)});
}
-template <typename TO> Expr<TO> ConvertToType(BOZLiteralConstant &&x) {
+template <typename TO>
+Expr<TO> ConvertToType(int toKind, BOZLiteralConstant &&x) {
static_assert(IsSpecificIntrinsicType<TO>);
if constexpr (TO::category == TypeCategory::Integer ||
TO::category == TypeCategory::Unsigned) {
- return Expr<TO>{
- Constant<TO>{Scalar<TO>::ConvertUnsigned(std::move(x)).value}};
+ return MakeConstantExpr<TO>(toKind,
+ Scalar<TO>::ConvertUnsigned(std::move(x), Scalar<TO>::bits(toKind))
+ .value);
} else {
static_assert(TO::category == TypeCategory::Real);
- using Word = typename Scalar<TO>::Word;
- return Expr<TO>{
- Constant<TO>{Scalar<TO>{Word::ConvertUnsigned(std::move(x)).value}}};
+ using Word = value::IntegerValue;
+ return MakeConstantExpr<TO>(toKind,
+ Scalar<TO>{toKind,
+ Word::ConvertUnsigned(std::move(x), Scalar<TO>::bits(toKind))
+ .value});
}
}
@@ -606,10 +664,10 @@ std::optional<Expr<SomeType>> ConvertToType(
const Symbol &, std::optional<Expr<SomeType>> &&);
// Conversions to the type of another expression
-template <TypeCategory TC, int TK, typename FROM>
-common::IfNoLvalue<Expr<Type<TC, TK>>, FROM> ConvertTo(
- const Expr<Type<TC, TK>> &, FROM &&x) {
- return ConvertToType<Type<TC, TK>>(std::move(x));
+template <TypeCategory TC, typename FROM>
+common::IfNoLvalue<Expr<Type<TC>>, FROM> ConvertTo(
+ int toKind, const Expr<Type<TC>> &to, FROM &&x) {
+ return ConvertToType<Type<TC>>(toKind, std::move(x));
}
template <TypeCategory TC, typename FROM>
@@ -618,46 +676,19 @@ common::IfNoLvalue<Expr<SomeKind<TC>>, FROM> ConvertTo(
return common::visit(
[&](const auto &toKindExpr) {
using KindExpr = std::decay_t<decltype(toKindExpr)>;
+ const int toKind{toKindExpr.kind()};
return AsCategoryExpr(
- ConvertToType<ResultType<KindExpr>>(std::move(from)));
- },
- to.u);
-}
-
-template <typename FROM>
-common::IfNoLvalue<Expr<SomeType>, FROM> ConvertTo(
- const Expr<SomeType> &to, FROM &&from) {
- return common::visit(
- [&](const auto &toCatExpr) {
- return AsGenericExpr(ConvertTo(toCatExpr, std::move(from)));
+ ConvertToType<ResultType<KindExpr>>(toKind, std::move(from)));
},
to.u);
}
// Convert an expression of some known category to a dynamically chosen
// kind of some category (usually but not necessarily distinct).
-template <TypeCategory TOCAT, typename VALUE> struct ConvertToKindHelper {
- using Result = std::optional<Expr<SomeKind<TOCAT>>>;
- using Types = CategoryTypes<TOCAT>;
- ConvertToKindHelper(int k, VALUE &&x) : kind{k}, value{std::move(x)} {}
- template <typename T> Result Test() {
- if (kind == T::kind) {
- return std::make_optional(
- AsCategoryExpr(ConvertToType<T>(std::move(value))));
- }
- return std::nullopt;
- }
- int kind;
- VALUE value;
-};
-
template <TypeCategory TOCAT, typename VALUE>
common::IfNoLvalue<Expr<SomeKind<TOCAT>>, VALUE> ConvertToKind(
int kind, VALUE &&x) {
- auto result{common::SearchTypes(
- ConvertToKindHelper<TOCAT, VALUE>{kind, std::move(x)})};
- CHECK(result.has_value());
- return *result;
+ return AsCategoryExpr(ConvertToType<Type<TOCAT>>(kind, std::move(x)));
}
// Given a type category CAT, SameKindExprs<CAT, N> is a variant that
@@ -678,25 +709,25 @@ using SameKindExprs =
template <TypeCategory CAT>
SameKindExprs<CAT, 2> AsSameKindExprs(
Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
- return common::visit(
- [&](auto &&kx, auto &&ky) -> SameKindExprs<CAT, 2> {
- using XTy = ResultType<decltype(kx)>;
- using YTy = ResultType<decltype(ky)>;
- if constexpr (std::is_same_v<XTy, YTy>) {
- return {SameExprs<XTy>{std::move(kx), std::move(ky)}};
- } else if constexpr (XTy::kind < YTy::kind) {
- return {SameExprs<YTy>{ConvertTo(ky, std::move(kx)), std::move(ky)}};
- } else {
- return {SameExprs<XTy>{std::move(kx), ConvertTo(kx, std::move(ky))}};
- }
+ Expr<Type<CAT>> kx{std::get<Expr<Type<CAT>>>(std::move(x.u))};
+ int xKind{kx.kind()};
+ Expr<Type<CAT>> ky{std::get<Expr<Type<CAT>>>(std::move(y.u))};
+ int yKind{ky.kind()};
+ if (xKind == yKind) {
+ return {SameExprs<Type<CAT>>{std::move(kx), std::move(ky)}};
+ } else if (xKind < yKind) {
+ return {SameExprs<Type<CAT>>{
+ ConvertTo(yKind, ky, std::move(kx)), std::move(ky)}};
+ } else {
+ return {SameExprs<Type<CAT>>{
+ std::move(kx), ConvertTo(xKind, kx, std::move(ky))}};
+ }
#if !__clang__ && 100 * __GNUC__ + __GNUC_MINOR__ == 801
// Silence a bogus warning about a missing return with G++ 8.1.0.
// Doesn't execute, but must be correctly typed.
CHECK(!"can't happen");
- return {SameExprs<XTy>{std::move(kx), std::move(kx)}};
+ return {SameExprs<Type<CAT>>{std::move(kx), std::move(kx)}};
#endif
- },
- std::move(x.u), std::move(y.u));
}
// Ensure that both operands of an intrinsic REAL operation (or CMPLX()
@@ -719,9 +750,10 @@ std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
template <typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) {
using Ty = TypeOf<A>;
+ const int kind{x.kind()};
static_assert(
std::is_same_v<Scalar<Ty>, std::decay_t<A>>, "TypeOf<> is broken");
- return Expr<TypeOf<A>>{Constant<Ty>{x}};
+ return MakeConstantExpr<Ty>(kind, x);
}
// Combine two expressions of the same specific numeric type with an operation
@@ -729,7 +761,8 @@ template <typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) {
template <template <typename> class OPR, typename SPECIFIC>
Expr<SPECIFIC> Combine(Expr<SPECIFIC> &&x, Expr<SPECIFIC> &&y) {
static_assert(IsSpecificIntrinsicType<SPECIFIC>);
- return AsExpr(OPR<SPECIFIC>{std::move(x), std::move(y)});
+ CHECK(x.kind() == y.kind());
+ return AsExpr(OPR<SPECIFIC>{x.kind(), std::move(x), std::move(y)});
}
// Given two expressions of arbitrary kind in the same intrinsic type
@@ -791,19 +824,18 @@ Expr<LogicalResult> PackageRelation(
Relational<SomeType>{Relational<T>{opr, std::move(x), std::move(y)}}};
}
-template <int K>
-Expr<Type<TypeCategory::Logical, K>> LogicalNegation(
- Expr<Type<TypeCategory::Logical, K>> &&x) {
- return AsExpr(Not<K>{std::move(x)});
+inline Expr<Type<TypeCategory::Logical>> LogicalNegation(
+ Expr<Type<TypeCategory::Logical>> &&x) {
+ const int kind{x.kind()};
+ return AsExpr(Not{kind, std::move(x)});
}
Expr<SomeLogical> LogicalNegation(Expr<SomeLogical> &&);
-template <int K>
-Expr<Type<TypeCategory::Logical, K>> BinaryLogicalOperation(LogicalOperator opr,
- Expr<Type<TypeCategory::Logical, K>> &&x,
- Expr<Type<TypeCategory::Logical, K>> &&y) {
- return AsExpr(LogicalOperation<K>{opr, std::move(x), std::move(y)});
+inline Expr<Type<TypeCategory::Logical>> BinaryLogicalOperation(
+ LogicalOperator opr, Expr<Type<TypeCategory::Logical>> &&x,
+ Expr<Type<TypeCategory::Logical>> &&y) {
+ return AsExpr(LogicalOperation{opr, std::move(x), std::move(y)});
}
Expr<SomeLogical> BinaryLogicalOperation(
@@ -814,29 +846,28 @@ Expr<SomeLogical> BinaryLogicalOperation(
// emit any message. Use the more general templates (above) in other
// situations.
-template <TypeCategory C, int K>
-Expr<Type<C, K>> operator-(Expr<Type<C, K>> &&x) {
- return AsExpr(Negate<Type<C, K>>{std::move(x)});
+template <TypeCategory C> Expr<Type<C>> operator-(Expr<Type<C>> &&x) {
+ return AsExpr(Negate<Type<C>>{std::move(x)});
}
-template <TypeCategory C, int K>
-Expr<Type<C, K>> operator+(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
- return AsExpr(Combine<Add, Type<C, K>>(std::move(x), std::move(y)));
+template <TypeCategory C>
+Expr<Type<C>> operator+(Expr<Type<C>> &&x, Expr<Type<C>> &&y) {
+ return AsExpr(Combine<Add, Type<C>>(std::move(x), std::move(y)));
}
-template <TypeCategory C, int K>
-Expr<Type<C, K>> operator-(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
- return AsExpr(Combine<Subtract, Type<C, K>>(std::move(x), std::move(y)));
+template <TypeCategory C>
+Expr<Type<C>> operator-(Expr<Type<C>> &&x, Expr<Type<C>> &&y) {
+ return AsExpr(Combine<Subtract, Type<C>>(std::move(x), std::move(y)));
}
-template <TypeCategory C, int K>
-Expr<Type<C, K>> operator*(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
- return AsExpr(Combine<Multiply, Type<C, K>>(std::move(x), std::move(y)));
+template <TypeCategory C>
+Expr<Type<C>> operator*(Expr<Type<C>> &&x, Expr<Type<C>> &&y) {
+ return AsExpr(Combine<Multiply, Type<C>>(std::move(x), std::move(y)));
}
-template <TypeCategory C, int K>
-Expr<Type<C, K>> operator/(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
- return AsExpr(Combine<Divide, Type<C, K>>(std::move(x), std::move(y)));
+template <TypeCategory C>
+Expr<Type<C>> operator/(Expr<Type<C>> &&x, Expr<Type<C>> &&y) {
+ return AsExpr(Combine<Divide, Type<C>>(std::move(x), std::move(y)));
}
template <TypeCategory C> Expr<SomeKind<C>> operator-(Expr<SomeKind<C>> &&x) {
@@ -879,9 +910,9 @@ struct TypeKindVisitor {
TypeKindVisitor(int k, VALUE &&x) : kind{k}, value{std::move(x)} {}
TypeKindVisitor(int k, const VALUE &x) : kind{k}, value{x} {}
- template <typename T> Result Test() {
- if (kind == T::kind) {
- return AsGenericExpr(TEMPLATE<T>{std::move(value)});
+ template <typename T> Result Test(int k) {
+ if (kind == k) {
+ return AsGenericExpr(TEMPLATE<T>{k, std::move(value)});
}
return std::nullopt;
}
@@ -897,7 +928,7 @@ template <TypeCategory CATEGORY, template <typename> typename WRAPPER,
typename WRAPPED>
common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> WrapperHelper(
int kind, WRAPPED &&x) {
- return common::SearchTypes(
+ return SearchTypes(
TypeKindVisitor<CATEGORY, WRAPPER, WRAPPED>{kind, std::move(x)});
}
@@ -925,7 +956,8 @@ common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> TypedWrapper(
return WrapperHelper<TypeCategory::Logical, WRAPPER, WRAPPED>(
dyType.kind(), std::move(x));
case TypeCategory::Derived:
- return AsGenericExpr(Expr<SomeDerived>{WRAPPER<SomeDerived>{std::move(x)}});
+ return AsGenericExpr(
+ Expr<SomeDerived>{WRAPPER<SomeDerived>{0, std::move(x)}});
}
}
@@ -1250,16 +1282,16 @@ class ScalarConstantExpander {
// If the type is Character or a derived type, take the length or type
// (resp.) from a another Constant.
template <typename T>
-Constant<T> PackageConstant(std::vector<Scalar<T>> &&elements,
+Constant<T> PackageConstant(int kind, std::vector<Scalar<T>> &&elements,
const Constant<T> &reference, const ConstantSubscripts &shape) {
if constexpr (T::category == TypeCategory::Character) {
return Constant<T>{
- reference.LEN(), std::move(elements), ConstantSubscripts{shape}};
+ kind, reference.LEN(), std::move(elements), ConstantSubscripts{shape}};
} else if constexpr (T::category == TypeCategory::Derived) {
return Constant<T>{reference.GetType().GetDerivedTypeSpec(),
std::move(elements), ConstantSubscripts{shape}};
} else {
- return Constant<T>{std::move(elements), ConstantSubscripts{shape}};
+ return Constant<T>{kind, std::move(elements), ConstantSubscripts{shape}};
}
}
@@ -1569,7 +1601,7 @@ using OperatorSet = common::EnumSet<Operator, 32>;
std::string ToString(Operator op);
-template <int Kind> Operator OperationCode(const LogicalOperation<Kind> &op) {
+inline Operator OperationCode(const LogicalOperation &op) {
switch (op.logicalOperator) {
case common::LogicalOperator::And:
return Operator::And;
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index 165784159b9ca..0974b87b01650 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -16,12 +16,13 @@
// are suitable for use as template parameters to instantiate other class
// templates, like expressions, over the supported types and kinds.
+#include "character-value.h"
#include "common.h"
-#include "complex.h"
+#include "complex-value.h"
#include "formatting.h"
-#include "integer.h"
-#include "logical.h"
-#include "real.h"
+#include "integer-value.h"
+#include "logical-value.h"
+#include "real-value.h"
#include "flang/Common/idioms.h"
#include "flang/Common/real.h"
#include "flang/Common/template.h"
@@ -52,15 +53,29 @@ using common::TypeCategory;
class TargetCharacteristics;
// Specific intrinsic types are represented by specializations of
-// this class template Type<CATEGORY, KIND>.
-template <TypeCategory CATEGORY, int KIND = 0> class Type;
+// this class template Type<CATEGORY>.
+// This used to be Type<CATEGORY,KIND>, but now KIND is passed at runtime.
+// TODO: Since they are functionally the same, replace all occurances of Type
+// with TypeCategory.
+template <TypeCategory CATEGORY> class Type;
-using SubscriptInteger = Type<TypeCategory::Integer, 8>;
-using CInteger = Type<TypeCategory::Integer, 4>;
-using LargestInt = Type<TypeCategory::Integer, 16>;
-using LogicalResult = Type<TypeCategory::Logical, 4>;
-using LargestReal = Type<TypeCategory::Real, 16>;
-using Ascii = Type<TypeCategory::Character, 1>;
+using SubscriptInteger = Type<TypeCategory::Integer>;
+inline constexpr int SubscriptIntegerKind{8};
+
+using CInteger = Type<TypeCategory::Integer>;
+inline constexpr int CIntegerKind{4};
+
+using LargestInt = Type<TypeCategory::Integer>;
+inline constexpr int LargestIntKind{16};
+
+using LogicalResult = Type<TypeCategory::Logical>;
+inline constexpr int LogicalResultKind{4};
+
+using LargestReal = Type<TypeCategory::Real>;
+inline constexpr int LargestRealKind{16};
+
+using Ascii = Type<TypeCategory::Character>;
+inline constexpr int AsciiKind{1};
// DynamicType is meant to be suitable for use as the result type for
// GetType() functions and member functions; consequently, it must be
@@ -252,26 +267,33 @@ const semantics::DerivedTypeSpec *GetDerivedTypeSpec(
const semantics::DerivedTypeSpec *GetParentTypeSpec(
const semantics::DerivedTypeSpec &);
-template <TypeCategory CATEGORY, int KIND = 0> struct TypeBase {
+template <TypeCategory CATEGORY> struct TypeBase {
+ constexpr int kind() const { return kind_; }
+
static constexpr TypeCategory category{CATEGORY};
- static constexpr int kind{KIND};
- constexpr bool operator==(const TypeBase &) const { return true; }
- static constexpr DynamicType GetType() { return {category, kind}; }
- static std::string AsFortran() { return GetType().AsFortran(); }
+ explicit constexpr TypeBase(int kind) : kind_{kind} {}
+ constexpr bool operator==(const TypeBase &that) const {
+ return kind_ == that.kind_;
+ }
+ constexpr DynamicType GetType() const { return {category, kind_}; }
+ std::string AsFortran() const { return GetType().AsFortran(); }
+
+private:
+ int kind_;
};
-template <int KIND>
-class Type<TypeCategory::Integer, KIND>
- : public TypeBase<TypeCategory::Integer, KIND> {
+template <>
+class Type<TypeCategory::Integer> : public TypeBase<TypeCategory::Integer> {
public:
- using Scalar = value::Integer<8 * KIND>;
+ using TypeBase::TypeBase;
+ using Scalar = value::IntegerValue;
};
-template <int KIND>
-class Type<TypeCategory::Unsigned, KIND>
- : public TypeBase<TypeCategory::Unsigned, KIND> {
+template <>
+class Type<TypeCategory::Unsigned> : public TypeBase<TypeCategory::Unsigned> {
public:
- using Scalar = value::Integer<8 * KIND>;
+ using TypeBase::TypeBase;
+ using Scalar = value::IntegerValue;
};
// Records when a default REAL literal constant is inexactly converted to binary
@@ -290,63 +312,40 @@ class TrackInexactLiteralConversion {
bool isFromInexactLiteralConversion_{false};
};
-template <int KIND>
-class Type<TypeCategory::Real, KIND>
- : public TypeBase<TypeCategory::Real, KIND>,
- public TrackInexactLiteralConversion {
+template <>
+class Type<TypeCategory::Real> : public TypeBase<TypeCategory::Real>,
+ public TrackInexactLiteralConversion {
public:
- static constexpr int precision{common::PrecisionOfRealKind(KIND)};
- static constexpr int bits{common::BitsForBinaryPrecision(precision)};
- using Scalar =
- value::Real<std::conditional_t<precision == 64,
- value::X87IntegerContainer, value::Integer<bits>>,
- precision>;
+ using TypeBase::TypeBase;
+ using Scalar = value::RealValue;
};
// The KIND type parameter on COMPLEX is the kind of each of its components.
-template <int KIND>
-class Type<TypeCategory::Complex, KIND>
- : public TypeBase<TypeCategory::Complex, KIND>,
- public TrackInexactLiteralConversion {
-public:
- using Part = Type<TypeCategory::Real, KIND>;
- using Scalar = value::Complex<typename Part::Scalar>;
-};
-
template <>
-class Type<TypeCategory::Character, 1>
- : public TypeBase<TypeCategory::Character, 1> {
+class Type<TypeCategory::Complex> : public TypeBase<TypeCategory::Complex>,
+ public TrackInexactLiteralConversion {
public:
- using Scalar = std::string;
+ using TypeBase::TypeBase;
+ using Part = Type<TypeCategory::Real>;
+ using Scalar = value::ComplexValue;
};
template <>
-class Type<TypeCategory::Character, 2>
- : public TypeBase<TypeCategory::Character, 2> {
+class Type<TypeCategory::Character> : public TypeBase<TypeCategory::Character> {
public:
- using Scalar = std::u16string;
+ using TypeBase::TypeBase;
+ using Scalar = value::CharacterValue;
};
template <>
-class Type<TypeCategory::Character, 4>
- : public TypeBase<TypeCategory::Character, 4> {
-public:
- using Scalar = std::u32string;
-};
-
-template <int KIND>
-class Type<TypeCategory::Logical, KIND>
- : public TypeBase<TypeCategory::Logical, KIND> {
+class Type<TypeCategory::Logical> : public TypeBase<TypeCategory::Logical> {
public:
- using Scalar = value::Logical<8 * KIND>;
+ using TypeBase::TypeBase;
+ using Scalar = value::LogicalValue;
};
// Type functions
-// Given a specific type, find the type of the same kind in another category.
-template <TypeCategory CATEGORY, typename T>
-using SameKind = Type<CATEGORY, std::decay_t<T>::kind>;
-
// Many expressions, including subscripts, CHARACTER lengths, array bounds,
// and effective type parameter values, are of a maximal kind of INTEGER.
using IndirectSubscriptIntegerExpr =
@@ -355,17 +354,8 @@ using IndirectSubscriptIntegerExpr =
// For each intrinsic type category CAT, CategoryTypes<CAT> is an instantiation
// of std::tuple<Type<CAT, K>> that comprises every kind value K in that
// category that could possibly be supported on any target.
-template <TypeCategory CATEGORY, int KIND>
-using CategoryKindTuple =
- std::conditional_t<common::IsValidKindOfIntrinsicType(CATEGORY, KIND),
- std::tuple<Type<CATEGORY, KIND>>, std::tuple<>>;
-
-template <TypeCategory CATEGORY, int... KINDS>
-using CategoryTypesHelper =
- common::CombineTuples<CategoryKindTuple<CATEGORY, KINDS>...>;
-
template <TypeCategory CATEGORY>
-using CategoryTypes = CategoryTypesHelper<CATEGORY, 1, 2, 3, 4, 8, 10, 16, 32>;
+using CategoryTypes = std::tuple<Type<CATEGORY>>;
using IntegerTypes = CategoryTypes<TypeCategory::Integer>;
using RealTypes = CategoryTypes<TypeCategory::Real>;
@@ -426,7 +416,9 @@ template <> class SomeKind<TypeCategory::Derived> {
static constexpr TypeCategory category{TypeCategory::Derived};
using Scalar = StructureConstructor;
- constexpr SomeKind() {} // CLASS(*)
+ // Argument provided for having the same signature as Types. Derived types
+ // don't have a kind, it is expected to be zero.
+ constexpr explicit SomeKind(int kind = 0) { CHECK(kind == 0); }
constexpr explicit SomeKind(const semantics::DerivedTypeSpec &dts)
: derivedTypeSpec_{&dts} {}
constexpr explicit SomeKind(const DynamicType &dt)
@@ -514,42 +506,41 @@ bool AreSameDerivedTypeIgnoringLengthParameters(
bool AreSameDerivedTypeIgnoringSequence(
const semantics::DerivedTypeSpec &, const semantics::DerivedTypeSpec &);
-// For generating "[extern] template class", &c. boilerplate
-#define EXPAND_FOR_EACH_INTEGER_KIND(M, P, S) \
- M(P, S, 1) M(P, S, 2) M(P, S, 4) M(P, S, 8) M(P, S, 16)
-#define EXPAND_FOR_EACH_REAL_KIND(M, P, S) \
- M(P, S, 2) M(P, S, 3) M(P, S, 4) M(P, S, 8) M(P, S, 10) M(P, S, 16)
-#define EXPAND_FOR_EACH_COMPLEX_KIND(M, P, S) EXPAND_FOR_EACH_REAL_KIND(M, P, S)
-#define EXPAND_FOR_EACH_CHARACTER_KIND(M, P, S) M(P, S, 1) M(P, S, 2) M(P, S, 4)
-#define EXPAND_FOR_EACH_LOGICAL_KIND(M, P, S) \
- M(P, S, 1) M(P, S, 2) M(P, S, 4) M(P, S, 8)
-#define EXPAND_FOR_EACH_UNSIGNED_KIND EXPAND_FOR_EACH_INTEGER_KIND
-
-#define FOR_EACH_INTEGER_KIND_HELP(PREFIX, SUFFIX, K) \
- PREFIX<Type<TypeCategory::Integer, K>> SUFFIX;
-#define FOR_EACH_REAL_KIND_HELP(PREFIX, SUFFIX, K) \
- PREFIX<Type<TypeCategory::Real, K>> SUFFIX;
-#define FOR_EACH_COMPLEX_KIND_HELP(PREFIX, SUFFIX, K) \
- PREFIX<Type<TypeCategory::Complex, K>> SUFFIX;
-#define FOR_EACH_CHARACTER_KIND_HELP(PREFIX, SUFFIX, K) \
- PREFIX<Type<TypeCategory::Character, K>> SUFFIX;
-#define FOR_EACH_LOGICAL_KIND_HELP(PREFIX, SUFFIX, K) \
- PREFIX<Type<TypeCategory::Logical, K>> SUFFIX;
-#define FOR_EACH_UNSIGNED_KIND_HELP(PREFIX, SUFFIX, K) \
- PREFIX<Type<TypeCategory::Unsigned, K>> SUFFIX;
+/// Check that KIND is consistent with thew type. That is, for a type category
+/// that has a kind as part of its type, it must be non-zero, and otherwise
+/// zero.
+#define CHECK_KIND(KIND, TY) \
+ { \
+ if constexpr (std::is_same_v<TY, SomeDerived> || \
+ std::is_same_v<TY, SomeKind<TypeCategory::Derived>> || \
+ std::is_same_v<TY, SomeType>) { \
+ CHECK((KIND) == 0 && "Type does not have a kind"); \
+ } else if constexpr (std::is_same_v<TY, Type<TypeCategory::Integer>> || \
+ std::is_same_v<TY, Type<TypeCategory::Unsigned>> || \
+ std::is_same_v<TY, Type<TypeCategory::Real>> || \
+ std::is_same_v<TY, Type<TypeCategory::Complex>> || \
+ std::is_same_v<TY, Type<TypeCategory::Logical>> || \
+ std::is_same_v<TY, Type<TypeCategory::Character>>) { \
+ CHECK((KIND) != 0 && "Type must come with a kind"); \
+ } else { \
+ static_assert(false, "Don't know whether TY should have a kind"); \
+ } \
+ }
+// TODO: The kind used to be part of Type<>, but since the FOR_EACH macros only
+// expand to a single entry, there is no use of them anymore.
#define FOR_EACH_INTEGER_KIND(PREFIX, SUFFIX) \
- EXPAND_FOR_EACH_INTEGER_KIND(FOR_EACH_INTEGER_KIND_HELP, PREFIX, SUFFIX)
+ PREFIX<Type<TypeCategory::Integer>> SUFFIX;
#define FOR_EACH_REAL_KIND(PREFIX, SUFFIX) \
- EXPAND_FOR_EACH_REAL_KIND(FOR_EACH_REAL_KIND_HELP, PREFIX, SUFFIX)
+ PREFIX<Type<TypeCategory::Real>> SUFFIX;
#define FOR_EACH_COMPLEX_KIND(PREFIX, SUFFIX) \
- EXPAND_FOR_EACH_COMPLEX_KIND(FOR_EACH_COMPLEX_KIND_HELP, PREFIX, SUFFIX)
+ PREFIX<Type<TypeCategory::Complex>> SUFFIX;
#define FOR_EACH_CHARACTER_KIND(PREFIX, SUFFIX) \
- EXPAND_FOR_EACH_CHARACTER_KIND(FOR_EACH_CHARACTER_KIND_HELP, PREFIX, SUFFIX)
+ PREFIX<Type<TypeCategory::Character>> SUFFIX;
#define FOR_EACH_LOGICAL_KIND(PREFIX, SUFFIX) \
- EXPAND_FOR_EACH_LOGICAL_KIND(FOR_EACH_LOGICAL_KIND_HELP, PREFIX, SUFFIX)
+ PREFIX<Type<TypeCategory::Logical>> SUFFIX;
#define FOR_EACH_UNSIGNED_KIND(PREFIX, SUFFIX) \
- EXPAND_FOR_EACH_UNSIGNED_KIND(FOR_EACH_UNSIGNED_KIND_HELP, PREFIX, SUFFIX)
+ PREFIX<Type<TypeCategory::Unsigned>> SUFFIX;
#define FOR_EACH_LENGTHLESS_INTRINSIC_KIND(PREFIX, SUFFIX) \
FOR_EACH_INTEGER_KIND(PREFIX, SUFFIX) \
@@ -576,5 +567,67 @@ bool AreSameDerivedTypeIgnoringSequence(
#define FOR_EACH_TYPE_AND_KIND(PREFIX, SUFFIX) \
FOR_EACH_INTRINSIC_KIND(PREFIX, SUFFIX) \
FOR_EACH_CATEGORY_TYPE(PREFIX, SUFFIX)
+
+/// Iterable lists of valid kinds for each TypeCategory for use by SearchTypes.
+template <TypeCategory CAT> struct KindsByType;
+template <> struct KindsByType<TypeCategory::Integer> {
+ static constexpr int kinds[] = FORTRAN_INTEGER_KINDS;
+};
+template <> struct KindsByType<TypeCategory::Unsigned> {
+ static constexpr int kinds[] = FORTRAN_UNSIGNED_KINDS;
+};
+template <> struct KindsByType<TypeCategory::Real> {
+ static constexpr int kinds[] = FORTRAN_REAL_KINDS;
+};
+template <> struct KindsByType<TypeCategory::Complex> {
+ static constexpr int kinds[] = FORTRAN_REAL_KINDS;
+};
+template <> struct KindsByType<TypeCategory::Logical> {
+ static constexpr int kinds[] = FORTRAN_LOGICAL_KINDS;
+};
+template <> struct KindsByType<TypeCategory::Character> {
+ static constexpr int kinds[] = FORTRAN_CHARACTER_KINDS;
+};
+template <> struct KindsByType<TypeCategory::Derived> {
+ static constexpr int kinds[] = {0};
+};
+
+// Given a VISITOR class of the general form
+// struct VISITOR {
+// using Result = ...;
+// using Types = std::tuple<...>;
+// template<typename T> Result Test(int kind) { ... }
+// };
+// SearchTypes will traverse the element types in the tuple in order,
+// and for each of them invoke VISITOR::Test<T>(kind) once per kind that
+// is supported by the type's category, until it returns a value that
+// casts to true. If no invocation of Test succeeds, SearchTypes will
+// return a default value.
+template <std::size_t J, typename VISITOR>
+common::IfNoLvalue<typename VISITOR::Result, VISITOR> SearchTypesHelper(
+ VISITOR &&visitor, typename VISITOR::Result &&defaultResult) {
+ using Tuple = typename VISITOR::Types;
+ if constexpr (J < std::tuple_size_v<Tuple>) {
+ using TYPE = std::tuple_element_t<J, Tuple>;
+ for (int kind : evaluate::KindsByType<TYPE::category>::kinds) {
+ if (auto result{visitor.template Test<TYPE>(kind)}) {
+ return result;
+ }
+ }
+ return SearchTypesHelper<J + 1, VISITOR>(
+ std::move(visitor), std::move(defaultResult));
+ } else {
+ return std::move(defaultResult);
+ }
+}
+
+template <typename VISITOR>
+common::IfNoLvalue<typename VISITOR::Result, VISITOR> SearchTypes(
+ VISITOR &&visitor,
+ typename VISITOR::Result defaultResult = typename VISITOR::Result{}) {
+ return SearchTypesHelper<0, VISITOR>(
+ std::move(visitor), std::move(defaultResult));
+}
+
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_TYPE_H_
diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h
index f510873ec2fe2..d4b861006ec36 100644
--- a/flang/include/flang/Evaluate/variable.h
+++ b/flang/include/flang/Evaluate/variable.h
@@ -136,6 +136,11 @@ class NamedEntity {
class TypeParamInquiry {
public:
using Result = SubscriptInteger;
+ static constexpr int ResultKind{SubscriptIntegerKind};
+ constexpr int kind() const { return SubscriptIntegerKind; }
+ static constexpr DynamicType GetType() {
+ return DynamicType{TypeCategory::Integer, SubscriptIntegerKind};
+ }
CLASS_BOILERPLATE(TypeParamInquiry)
TypeParamInquiry(NamedEntity &&x, const Symbol ¶m)
: base_{std::move(x)}, parameter_{param} {}
@@ -392,10 +397,39 @@ template <typename T> class Designator {
using Result = T;
static_assert(
IsSpecificIntrinsicType<Result> || std::is_same_v<Result, SomeDerived>);
- EVALUATE_UNION_CLASS_BOILERPLATE(Designator)
- Designator(const DataRef &that) : u{common::CopyVariant<Variant>(that.u)} {}
- Designator(DataRef &&that)
- : u{common::MoveVariant<Variant>(std::move(that.u))} {}
+
+ constexpr int kind() const { return kind_; }
+
+ CLASS_BOILERPLATE(Designator)
+ template <typename _A>
+ explicit Designator(int kind, const _A &x) : u{x}, kind_{kind} {
+ CHECK_KIND(kind, T);
+ }
+ template <typename _A, typename = common::NoLvalue<_A>>
+ explicit Designator(int kind, _A &&x) : u(std::move(x)), kind_{kind} {
+ CHECK_KIND(kind, T);
+ }
+ template <typename _A, typename U = T,
+ typename = std::enable_if_t<std::is_same_v<U, SomeDerived>>>
+ explicit Designator(const _A &x) : Designator(0, x) {}
+ template <typename _A, typename U = T, typename = common::NoLvalue<_A>,
+ typename = std::enable_if_t<std::is_same_v<U, SomeDerived>>>
+ explicit Designator(_A &&x) : Designator(0, std::move(x)) {}
+ bool operator==(const Designator &) const;
+ Designator(int kind, const DataRef &that)
+ : u{common::CopyVariant<Variant>(that.u)}, kind_{kind} {
+ CHECK_KIND(kind, T);
+ }
+ Designator(int kind, DataRef &&that)
+ : u{common::MoveVariant<Variant>(std::move(that.u))}, kind_{kind} {
+ CHECK_KIND(kind, T);
+ }
+ template <typename U = T,
+ typename = std::enable_if_t<std::is_same_v<U, SomeDerived>>>
+ Designator(const DataRef &that) : Designator(0, that) {}
+ template <typename U = T,
+ typename = std::enable_if_t<std::is_same_v<U, SomeDerived>>>
+ Designator(DataRef &&that) : Designator(0, std::move(that)) {}
std::optional<DynamicType> GetType() const;
int Rank() const;
@@ -406,6 +440,9 @@ template <typename T> class Designator {
llvm::raw_ostream &AsFortran(llvm::raw_ostream &o) const;
Variant u;
+
+private:
+ int kind_;
};
FOR_EACH_CHARACTER_KIND(extern template class Designator, )
@@ -413,6 +450,10 @@ FOR_EACH_CHARACTER_KIND(extern template class Designator, )
class DescriptorInquiry {
public:
using Result = SubscriptInteger;
+ static constexpr int kind() { return SubscriptIntegerKind; }
+ static constexpr DynamicType GetType() {
+ return DynamicType{TypeCategory::Integer, SubscriptIntegerKind};
+ }
ENUM_CLASS(Field, LowerBound, Extent, Stride, Rank, Len)
CLASS_BOILERPLATE(DescriptorInquiry)
@@ -442,6 +483,7 @@ class DescriptorInquiry {
class RankOneBoundElement {
public:
using Result = SubscriptInteger;
+ static constexpr int ResultKind{SubscriptIntegerKind};
CLASS_BOILERPLATE(RankOneBoundElement)
RankOneBoundElement(
common::CopyableIndirection<Expr<SubscriptInteger>> &&e, int dim)
@@ -453,6 +495,8 @@ class RankOneBoundElement {
Expr<SubscriptInteger> &base() { return base_.value(); }
int dimension() const { return dimension_; }
+ static constexpr int kind() { return ResultKind; }
+
static constexpr int Rank() { return 0; } // always scalar
static constexpr int Corank() { return 0; }
bool operator==(const RankOneBoundElement &) const;
diff --git a/flang/include/flang/Lower/DirectivesCommon.h b/flang/include/flang/Lower/DirectivesCommon.h
index 6f6089a4ffb6c..03f7783a53ec4 100644
--- a/flang/include/flang/Lower/DirectivesCommon.h
+++ b/flang/include/flang/Lower/DirectivesCommon.h
@@ -94,24 +94,21 @@ static T AsRvalueRef(const T &t) {
// (if present) is not needed. When it's present, though, it causes generated
// names to contain "int(..., kind=8)".
struct PeelConvert {
- template <Fortran::common::TypeCategory Category, int Kind>
+ template <Fortran::common::TypeCategory Category>
static Fortran::semantics::MaybeExpr visit_with_category(
- const Fortran::evaluate::Expr<Fortran::evaluate::Type<Category, Kind>>
- &expr) {
+ const Fortran::evaluate::Expr<Fortran::evaluate::Type<Category>> &expr) {
return Fortran::common::visit(
- [](auto &&s) { return visit_with_category<Category, Kind>(s); },
- expr.u);
+ [](auto &&s) { return visit_with_category<Category>(s); }, expr.u);
}
- template <Fortran::common::TypeCategory Category, int Kind>
+ template <
+ Fortran::common::TypeCategory Category,
+ typename = std::enable_if_t<Fortran::evaluate::IsSpecificIntrinsicType<
+ Fortran::evaluate::Type<Category>>>>
static Fortran::semantics::MaybeExpr visit_with_category(
- const Fortran::evaluate::Convert<Fortran::evaluate::Type<Category, Kind>,
+ const Fortran::evaluate::Convert<Fortran::evaluate::Type<Category>,
Category> &expr) {
return AsGenericExpr(AsRvalueRef(expr.left()));
}
- template <Fortran::common::TypeCategory Category, int Kind, typename T>
- static Fortran::semantics::MaybeExpr visit_with_category(const T &) {
- return std::nullopt; //
- }
template <Fortran::common::TypeCategory Category, typename T>
static Fortran::semantics::MaybeExpr visit_with_category(const T &) {
return std::nullopt; //
diff --git a/flang/include/flang/Lower/Mangler.h b/flang/include/flang/Lower/Mangler.h
index a75a08e64f033..a243b7824dfcd 100644
--- a/flang/include/flang/Lower/Mangler.h
+++ b/flang/include/flang/Lower/Mangler.h
@@ -65,22 +65,23 @@ mangleArrayLiteral(size_t size,
Fortran::common::ConstantSubscript charLen = -1,
llvm::StringRef derivedName = {});
-template <Fortran::common::TypeCategory TC, int KIND>
+template <Fortran::common::TypeCategory TC>
std::string mangleArrayLiteral(
mlir::Type,
- const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC, KIND>> &x) {
+ const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC>> &x) {
+ const int kind{x.kind()};
return mangleArrayLiteral(x.values().size() * sizeof(x.values()[0]),
- x.shape(), TC, KIND);
+ x.shape(), TC, kind);
}
-template <int KIND>
-std::string
-mangleArrayLiteral(mlir::Type,
- const Fortran::evaluate::Constant<Fortran::evaluate::Type<
- Fortran::common::TypeCategory::Character, KIND>> &x) {
+inline std::string mangleArrayLiteral(
+ mlir::Type,
+ const Fortran::evaluate::Constant<
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Character>> &x) {
+ const int kind{x.kind()};
return mangleArrayLiteral(x.values().size() * sizeof(x.values()[0]),
x.shape(), Fortran::common::TypeCategory::Character,
- KIND, x.LEN());
+ kind, x.LEN());
}
inline std::string mangleArrayLiteral(
diff --git a/flang/include/flang/Lower/Support/Utils.h b/flang/include/flang/Lower/Support/Utils.h
index 15d30905aadcd..555cdec21774e 100644
--- a/flang/include/flang/Lower/Support/Utils.h
+++ b/flang/include/flang/Lower/Support/Utils.h
@@ -62,10 +62,11 @@ static Fortran::lower::SomeExpr toEvExpr(const A &x) {
}
template <Fortran::common::TypeCategory FROM>
-static Fortran::lower::SomeExpr ignoreEvConvert(
- const Fortran::evaluate::Convert<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, 8>,
- FROM> &x) {
+static Fortran::lower::SomeExpr
+ignoreEvConvert(const Fortran::evaluate::Convert<
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer>,
+ FROM> &x) {
+ CHECK(x.kind() == 8);
return toEvExpr(x.left());
}
template <typename A>
@@ -76,9 +77,10 @@ static Fortran::lower::SomeExpr ignoreEvConvert(const A &x) {
/// A vector subscript expression may be wrapped with a cast to INTEGER*8.
/// Get rid of it here so the vector can be loaded. Add it back when
/// generating the elemental evaluation (inside the loop nest).
-inline Fortran::lower::SomeExpr
-ignoreEvConvert(const Fortran::evaluate::Expr<Fortran::evaluate::Type<
- Fortran::common::TypeCategory::Integer, 8>> &x) {
+inline Fortran::lower::SomeExpr ignoreEvConvert(
+ const Fortran::evaluate::Expr<
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer>> &x) {
+ CHECK(x.kind() == 8);
return Fortran::common::visit(
[](const auto &v) { return ignoreEvConvert(v); }, x.u);
}
diff --git a/flang/include/flang/Semantics/dump-expr.h b/flang/include/flang/Semantics/dump-expr.h
index 868b64c64e60a..fe983cb0a6e8d 100644
--- a/flang/include/flang/Semantics/dump-expr.h
+++ b/flang/include/flang/Semantics/dump-expr.h
@@ -233,14 +233,12 @@ class DumpEvaluateExpr {
LLVM_DUMP_METHOD void DumpEvExpr(const evaluate::Expr<evaluate::SomeType> &x);
LLVM_DUMP_METHOD void DumpEvExpr(
- const evaluate::Expr<evaluate::Type<common::TypeCategory::Integer, 4>> &x);
-LLVM_DUMP_METHOD void DumpEvExpr(
- const evaluate::Expr<evaluate::Type<common::TypeCategory::Integer, 8>> &x);
+ const evaluate::Expr<evaluate::Type<common::TypeCategory::Integer>> &x);
LLVM_DUMP_METHOD void DumpEvExpr(const evaluate::ArrayRef &x);
LLVM_DUMP_METHOD void DumpEvExpr(const evaluate::DataRef &x);
LLVM_DUMP_METHOD void DumpEvExpr(const evaluate::Substring &x);
LLVM_DUMP_METHOD void DumpEvExpr(
- const evaluate::Designator<evaluate::Type<common::TypeCategory::Integer, 4>>
+ const evaluate::Designator<evaluate::Type<common::TypeCategory::Integer>>
&x);
} // namespace Fortran::semantics
diff --git a/flang/include/flang/Semantics/scope.h b/flang/include/flang/Semantics/scope.h
index 7cab6e2122319..324c206a4d2d8 100644
--- a/flang/include/flang/Semantics/scope.h
+++ b/flang/include/flang/Semantics/scope.h
@@ -235,8 +235,7 @@ class Scope {
const DeclTypeSpec *FindType(const DeclTypeSpec &) const;
const DeclTypeSpec &MakeNumericType(TypeCategory, KindExpr &&kind);
const DeclTypeSpec &MakeLogicalType(KindExpr &&kind);
- const DeclTypeSpec &MakeCharacterType(
- ParamValue &&length, KindExpr &&kind = KindExpr{0});
+ const DeclTypeSpec &MakeCharacterType(ParamValue &&length, KindExpr &&kind);
DeclTypeSpec &MakeDerivedType(DeclTypeSpec::Category, DerivedTypeSpec &&);
const DeclTypeSpec &MakeTypeStarType();
const DeclTypeSpec &MakeClassStarType();
diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h
index b8f06dde4f562..2f216e3bc0cd6 100644
--- a/flang/include/flang/Semantics/type.h
+++ b/flang/include/flang/Semantics/type.h
@@ -53,6 +53,8 @@ using SubscriptIntExpr = evaluate::Expr<evaluate::SubscriptInteger>;
using MaybeSubscriptIntExpr = std::optional<SubscriptIntExpr>;
using KindExpr = SubscriptIntExpr;
+KindExpr MakeKindExpr(int v);
+
// An array spec bound: an explicit integer expression, assumed size
// or implied shape(*), or assumed or deferred shape(:). In the absence
// of explicit lower bounds it is not possible to distinguish assumed
diff --git a/flang/lib/Evaluate/CMakeLists.txt b/flang/lib/Evaluate/CMakeLists.txt
index 472ecb6d8d079..55e0a66fceb6d 100644
--- a/flang/lib/Evaluate/CMakeLists.txt
+++ b/flang/lib/Evaluate/CMakeLists.txt
@@ -30,10 +30,12 @@ endif ()
add_flang_library(FortranEvaluate
call.cpp
+ character-value.cpp
+ character-value-impl.cpp
characteristics.cpp
check-expression.cpp
common.cpp
- complex.cpp
+ complex-value.cpp
constant.cpp
expression.cpp
fold.cpp
@@ -48,10 +50,14 @@ add_flang_library(FortranEvaluate
host.cpp
initial-image.cpp
integer.cpp
+ integer-value.cpp
+ integer-value-impl.cpp
intrinsics.cpp
intrinsics-library.cpp
- logical.cpp
+ logical-value.cpp
real.cpp
+ real-value.cpp
+ real-value-impl.cpp
shape.cpp
static-data.cpp
target.cpp
@@ -74,9 +80,12 @@ add_flang_library(FortranEvaluate
[["flang/Evaluate/shape.h"]]
[["flang/Evaluate/characteristics.h"]]
[["flang/Evaluate/variable.h"]]
- [["flang/Evaluate/real.h"]]
+ [["flang/Evaluate/character-value.h"]]
+ [["flang/Evaluate/complex-value.h"]]
+ [["flang/Evaluate/integer-value.h"]]
+ [["flang/Evaluate/logical-value.h"]]
+ [["flang/Evaluate/real-value.h"]]
[["flang/Evaluate/type.h"]]
- [["flang/Evaluate/integer.h"]]
[["flang/Evaluate/expression.h"]]
[["flang/Evaluate/tools.h"]]
diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp
index 57afa80a03209..c72e347dffa59 100644
--- a/flang/lib/Evaluate/call.cpp
+++ b/flang/lib/Evaluate/call.cpp
@@ -269,7 +269,8 @@ std::optional<Expr<SubscriptInteger>> ProcedureRef::LEN() const {
UnwrapExpr<Expr<SomeInteger>>(arguments_[1].value())};
CHECK(stringArg && nCopiesArg);
if (auto stringLen{stringArg->LEN()}) {
- auto converted{ConvertTo(*stringLen, common::Clone(*nCopiesArg))};
+ auto converted{ConvertTo(
+ stringLen->kind(), *stringLen, common::Clone(*nCopiesArg))};
return *std::move(stringLen) * std::move(converted);
}
}
diff --git a/flang/lib/Evaluate/character-value-impl.cpp b/flang/lib/Evaluate/character-value-impl.cpp
new file mode 100644
index 0000000000000..dfac05b1b8aae
--- /dev/null
+++ b/flang/lib/Evaluate/character-value-impl.cpp
@@ -0,0 +1,577 @@
+//===-- lib/Evaluate/character-value-impl.cpp -----------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "character-value-impl.h"
+#include "flang/Common/idioms.h"
+#include "flang/Evaluate/common.h"
+#include "llvm/Support/ErrorHandling.h"
+#include <algorithm>
+#include <cstring>
+
+namespace Fortran::evaluate::value {
+
+CharacterValueImpl::CharacterValueImpl(int kind, std::size_t n, char32_t c) {
+ withCharProto(kind, [this, n, c](auto ct) {
+ using CharT = std::decay_t<decltype(ct)>;
+ storage_ = std::basic_string<CharT>(n, static_cast<CharT>(c));
+ });
+}
+
+CharacterValueImpl CharacterValueImpl::Zero(int kind) {
+ return withCharProto(kind, [kind](auto c) {
+ using Char = std::decay_t<decltype(c)>;
+ return CharacterValueImpl{kind, std::basic_string<Char>{}};
+ });
+}
+
+CharacterValueImpl CharacterValueImpl::FromRawBytes(
+ int kind, const void *raw, size_t byteSize) {
+ return withCharProto(kind, [kind, raw, byteSize](auto charProto) {
+ using CharT = decltype(charProto);
+ std::basic_string<CharT> s;
+ if (byteSize > 0) {
+ s.assign(static_cast<const CharT *>(raw), byteSize);
+ }
+ return CharacterValueImpl{kind, std::move(s)};
+ });
+}
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+LLVM_DUMP_METHOD void CharacterValueImpl::dump() const {
+ llvm::errs() << kind() << '_';
+ withStdString([](const auto &s) {
+ llvm::errs() << parser::QuoteCharacterLiteral(s, true) << '\n';
+ });
+}
+#endif
+
+std::size_t CharacterValueImpl::charSize() const {
+ return common::visit(
+ [](const auto &s) -> std::size_t {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ llvm_unreachable("operation not supported on uninitialized value");
+ } else {
+ return sizeof(typename std::decay_t<decltype(s)>::value_type);
+ }
+ },
+ storage_);
+}
+
+std::size_t CharacterValueImpl::size() const {
+ return common::visit(
+ [](const auto &s) -> std::size_t {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ return 0;
+ } else {
+ return s.size();
+ }
+ },
+ storage_);
+}
+
+void *CharacterValueImpl::charData() {
+ return common::visit(
+ [](auto &s) -> void * {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ // No data available in monostate
+ return nullptr;
+ } else {
+ return static_cast<void *>(s.data());
+ }
+ },
+ storage_);
+}
+
+const void *CharacterValueImpl::charData() const {
+ return common::visit(
+ [](const auto &s) -> const void * {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ // No data available in monostate
+ return nullptr;
+ } else {
+ return static_cast<const void *>(s.data());
+ }
+ },
+ storage_);
+}
+
+Ordering CharacterValueImpl::Compare(const CharacterValueImpl &y) const {
+ return common::visit(
+ [](const auto &xs, const auto &ys) -> Ordering {
+ using XS = std::decay_t<decltype(xs)>;
+ using YS = std::decay_t<decltype(ys)>;
+
+ // monostate represents an empty string of any type; here it is
+ // polymorhpic to what it is compared to
+ if constexpr (std::is_same_v<XS, YS>) {
+ return Fortran::evaluate::Compare(xs, ys);
+ } else if constexpr (std::is_same_v<XS, std::monostate> &&
+ !std::is_same_v<YS, std::monostate>) {
+ return Fortran::evaluate::Compare(YS{}, ys);
+ } else if constexpr (!std::is_same_v<XS, std::monostate> &&
+ std::is_same_v<YS, std::monostate>) {
+ return Fortran::evaluate::Compare(xs, XS{});
+ } else {
+ llvm_unreachable("character comparison across differing kinds");
+ }
+ },
+ this->storage_, y.storage_);
+}
+
+bool CharacterValueImpl::operator<(const CharacterValueImpl &y) const {
+ return common::visit(
+ [](const auto &xs, const auto &ys) -> bool {
+ using XS = std::decay_t<decltype(xs)>;
+ using YS = std::decay_t<decltype(ys)>;
+
+ // monostate represents an empty string of any type; here it is
+ // polymorphic to what it is compared to
+ if constexpr (std::is_same_v<XS, YS>) {
+ return xs < ys;
+ } else if constexpr (std::is_same_v<XS, std::monostate> &&
+ !std::is_same_v<YS, std::monostate>) {
+ return YS{} < ys;
+ } else if constexpr (!std::is_same_v<XS, std::monostate> &&
+ std::is_same_v<YS, std::monostate>) {
+ return xs < XS{};
+ } else {
+ llvm_unreachable("character comparison across differing kinds");
+ }
+ },
+ this->storage_, y.storage_);
+}
+
+bool CharacterValueImpl::operator==(const CharacterValueImpl &y) const {
+ return common::visit(
+ [](const auto &xs, const auto &ys) -> bool {
+ using XS = std::decay_t<decltype(xs)>;
+ using YS = std::decay_t<decltype(ys)>;
+
+ // monostate represents an empty string of any type; here it is
+ // polymorhpic to what it is compared to
+ if constexpr (std::is_same_v<XS, YS>) {
+ return xs == ys;
+ } else if constexpr (std::is_same_v<XS, std::monostate> &&
+ !std::is_same_v<YS, std::monostate>) {
+ return YS{} == ys;
+ } else if constexpr (!std::is_same_v<XS, std::monostate> &&
+ std::is_same_v<YS, std::monostate>) {
+ return xs == XS{};
+ } else {
+ llvm_unreachable("character comparison across differing kinds");
+ }
+ },
+ this->storage_, y.storage_);
+}
+
+void CharacterValueImpl::assign(int kind, std::size_t n, char32_t c) {
+ return withCharProto(kind, [this, n, c](auto ct) {
+ using CharT = decltype(ct);
+ storage_ = std::basic_string<CharT>(n, static_cast<CharT>(c));
+ });
+}
+
+void CharacterValueImpl::erase(std::size_t pos) {
+ common::visit(
+ [pos](auto &s) {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ llvm_unreachable("operation not supported on uninitialized value");
+ } else {
+ s.erase(pos);
+ }
+ },
+ storage_);
+}
+
+void CharacterValueImpl::append(std::size_t n, char32_t c) {
+ common::visit(
+ [n, c](auto &s) {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ llvm_unreachable("operation not supported on uninitialized value");
+ } else {
+ using CharT = typename std::decay_t<decltype(s)>::value_type;
+ s.append(n, static_cast<CharT>(c));
+ }
+ },
+ storage_);
+}
+
+CharacterValueImpl &CharacterValueImpl::replace(
+ std::size_t pos, std::size_t len, const CharacterValueImpl &other) {
+ common::visit(
+ [pos, len](auto &s, const auto &o) {
+ if constexpr (!std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate> &&
+ !std::is_same_v<std::decay_t<decltype(o)>, std::monostate> &&
+ std::is_same_v<std::decay_t<decltype(s)>,
+ std::decay_t<decltype(o)>>) {
+ s.replace(pos, len, o);
+ } else {
+ llvm_unreachable("operation not supported on uninitialized value or "
+ "values of different kinds");
+ }
+ },
+ storage_, other.storage_);
+ return *this;
+}
+
+CharacterValueImpl CharacterValueImpl::substr(std::size_t pos) const {
+ return common::visit(
+ [pos](const auto &s) -> CharacterValueImpl {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ llvm_unreachable("operation not supported on uninitialized value");
+ } else {
+ return CharacterValueImpl{s.substr(pos)};
+ }
+ },
+ storage_);
+}
+
+CharacterValueImpl CharacterValueImpl::substr(
+ std::size_t pos, std::size_t len) const {
+ return common::visit(
+ [pos, len](const auto &s) -> CharacterValueImpl {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ llvm_unreachable("operation not supported on uninitialized value");
+ } else {
+ return CharacterValueImpl{s.substr(pos, len)};
+ }
+ },
+ storage_);
+}
+
+std::optional<llvm::StringRef> CharacterValueImpl::AsStringRef() const {
+ if (IsMonostate()) {
+ return llvm::StringRef{};
+ }
+ if (const auto *s{std::get_if<std::string>(&storage_)}) {
+ return *s;
+ }
+ return std::nullopt;
+}
+
+/// Return the string as std::string if kind==1, or nullopt otherwise.
+std::optional<std::string> CharacterValueImpl::AsStdString() const {
+ if (IsMonostate()) {
+ return std::string{};
+ }
+
+ if (const auto *s{std::get_if<std::string>(&storage_)}) {
+ return *s;
+ } else {
+ return std::nullopt;
+ }
+}
+
+std::optional<std::u16string> CharacterValueImpl::AsU16String() const {
+ if (IsMonostate()) {
+ return std::u16string{};
+ }
+
+ if (const auto *s{std::get_if<std::u16string>(&storage_)}) {
+ return *s;
+ } else {
+ return std::nullopt;
+ }
+}
+
+std::optional<std::u32string> CharacterValueImpl::AsU32String() const {
+ if (IsMonostate()) {
+ return std::u32string{};
+ }
+
+ if (const auto *s{std::get_if<std::u32string>(&storage_)}) {
+ return *s;
+ } else {
+ return std::nullopt;
+ }
+}
+
+CharacterValueImpl CharacterValueImpl::ToAscii(int kind) const {
+ if (IsMonostate()) {
+ return Zero(kind);
+ }
+
+ return withStdString([kind](const auto &s) -> CharacterValueImpl {
+ return withCharProto(kind, [&s](auto ct) -> CharacterValueImpl {
+ using TO = std::basic_string<std::decay_t<decltype(ct)>>;
+ // Fortran character conversion is well defined between distinct kinds
+ // only when the actual characters are valid 7-bit ASCII.
+ TO str;
+ for (auto iter{s.cbegin()}; iter != s.cend(); ++iter) {
+ if (static_cast<std::uint64_t>(*iter) > 127) {
+ return Zero(sizeof(ct));
+ }
+ str.push_back(static_cast<typename TO::value_type>(*iter));
+ }
+ return CharacterValueImpl{str};
+ });
+ });
+}
+
+void CharacterValueImpl::reserve(std::size_t n) {
+ common::visit(
+ [n](auto &s) {
+ if constexpr (!std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ s.reserve(n);
+ }
+ },
+ storage_);
+}
+
+char32_t CharacterValueImpl::operator[](std::size_t i) const {
+ return common::visit(
+ [i](const auto &s) -> char32_t {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ llvm_unreachable("operation not supported on uninitialized value");
+ } else {
+ return static_cast<char32_t>(s[i]);
+ }
+ return 0;
+ },
+ storage_);
+}
+
+CharacterValueImpl CharacterValueImpl::operator+(
+ const CharacterValueImpl &y) const {
+ return common::visit(
+ [](const auto &a, const auto &b) -> CharacterValueImpl {
+ if constexpr (std::is_same_v<std::decay_t<decltype(a)>,
+ std::decay_t<decltype(b)>> &&
+ !std::is_same_v<std::decay_t<decltype(a)>, std::monostate>) {
+ return CharacterValueImpl{a + b};
+ } else {
+ llvm_unreachable("operation not supported on uninitialized value or "
+ "values of different kinds");
+ }
+ return CharacterValueImpl{};
+ },
+ storage_, y.storage_);
+}
+
+CharacterValueImpl &CharacterValueImpl::operator+=(
+ const CharacterValueImpl &y) {
+ common::visit(
+ [](auto &a, const auto &b) {
+ if constexpr (std::is_same_v<std::decay_t<decltype(a)>,
+ std::decay_t<decltype(b)>> &&
+ !std::is_same_v<std::decay_t<decltype(a)>, std::monostate>) {
+ a += b;
+ } else {
+ llvm_unreachable("operation not supported on uninitialized value or "
+ "values of different kinds");
+ }
+ },
+ storage_, y.storage_);
+ return *this;
+}
+
+CharacterValueImpl &CharacterValueImpl::operator+=(char c) {
+ common::visit(
+ [c](auto &s) {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ llvm_unreachable("operation not supported on uninitialized value");
+ } else {
+ using CharT = typename std::decay_t<decltype(s)>::value_type;
+ s.push_back(static_cast<CharT>(c));
+ }
+ },
+ storage_);
+ return *this;
+}
+
+std::size_t CharacterValueImpl::find_first_not_of(char32_t c) const {
+ return common::visit(
+ [c](const auto &s) -> std::size_t {
+ if constexpr (!std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ using CharT = typename std::decay_t<decltype(s)>::value_type;
+ return s.find_first_not_of(static_cast<CharT>(c));
+ } else {
+ llvm_unreachable("Unsupported combination of character kinds");
+ return std::string::npos;
+ }
+ },
+ storage_);
+}
+
+std::size_t CharacterValueImpl::find_last_not_of(char32_t c) const {
+ return common::visit(
+ [c](const auto &s) -> std::size_t {
+ if constexpr (!std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ using CharT = typename std::decay_t<decltype(s)>::value_type;
+ return s.find_last_not_of(static_cast<CharT>(c));
+ } else {
+ llvm_unreachable("Unsupported combination of character kinds");
+ return std::string::npos;
+ }
+ },
+ storage_);
+}
+
+std::size_t CharacterValueImpl::find_first_not_of(
+ const CharacterValueImpl &set) const {
+ return common::visit(
+ [](const auto &s, const auto &p) -> std::size_t {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ // Nothing to find in an empty string
+ return std::string::npos;
+ } else if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::decay_t<decltype(p)>> &&
+ !std::is_same_v<std::decay_t<decltype(s)>, std::monostate>) {
+ return s.find_first_not_of(p);
+ } else {
+ llvm_unreachable("Unsupported combination of character kinds");
+ return std::string::npos;
+ }
+ },
+ storage_, set.storage_);
+}
+
+std::size_t CharacterValueImpl::find_last_not_of(
+ const CharacterValueImpl &set) const {
+ return common::visit(
+ [](const auto &s, const auto &p) -> std::size_t {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ // Nothing to find in an empty string
+ return std::string::npos;
+ } else if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::decay_t<decltype(p)>> &&
+ !std::is_same_v<std::decay_t<decltype(s)>, std::monostate>) {
+ return s.find_last_not_of(p);
+ } else {
+ llvm_unreachable("Unsupported combination of character kinds");
+ return std::string::npos;
+ }
+ },
+ storage_, set.storage_);
+}
+
+std::size_t CharacterValueImpl::find(const CharacterValueImpl &pattern) const {
+ return common::visit(
+ [](const auto &s, const auto &p) -> std::size_t {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ // Nothing to find in an empty string
+ return std::string::npos;
+ } else if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::decay_t<decltype(p)>> &&
+ !std::is_same_v<std::decay_t<decltype(s)>, std::monostate>) {
+ return s.find(p);
+ } else {
+ llvm_unreachable("Unsupported combination of character kinds");
+ return std::string::npos;
+ }
+ },
+ storage_, pattern.storage_);
+}
+
+std::size_t CharacterValueImpl::rfind(const CharacterValueImpl &pattern) const {
+ return common::visit(
+ [](const auto &s, const auto &p) -> std::size_t {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ // Nothing to find in an empty string
+ return std::string::npos;
+ } else if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::decay_t<decltype(p)>> &&
+ !std::is_same_v<std::decay_t<decltype(s)>, std::monostate>) {
+ return s.rfind(p);
+ }
+ llvm_unreachable("Unsupported combination of character kinds");
+ return std::string::npos;
+ },
+ storage_, pattern.storage_);
+}
+
+std::size_t CharacterValueImpl::find_first_of(
+ const CharacterValueImpl &set) const {
+ return common::visit(
+ [](const auto &s, const auto &p) -> std::size_t {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ // Nothing to find in an empty string
+ return std::string::npos;
+ } else if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::decay_t<decltype(p)>> &&
+ !std::is_same_v<std::decay_t<decltype(s)>, std::monostate>) {
+ return s.find_first_of(p);
+ } else {
+ llvm_unreachable("Unsupported combination of character kinds");
+ return std::string::npos;
+ }
+ },
+ storage_, set.storage_);
+}
+
+std::size_t CharacterValueImpl::find_last_of(
+ const CharacterValueImpl &set) const {
+ return common::visit(
+ [](const auto &s, const auto &p) -> std::size_t {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ // Nothing to find in an empty string
+ return std::string::npos;
+ } else if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::decay_t<decltype(p)>> &&
+ !std::is_same_v<std::decay_t<decltype(s)>, std::monostate>) {
+ return s.find_last_of(p);
+ } else {
+ llvm_unreachable("Unsupported combination of character kinds");
+ return std::string::npos;
+ }
+ },
+ storage_, set.storage_);
+}
+
+void CharacterValueImpl::StoreRawBytes(
+ void *dst, size_t size, bool *changed) const {
+ common::visit(
+ [&](const auto &s) {
+ if constexpr (std::is_same_v<std::decay_t<decltype(s)>,
+ std::monostate>) {
+ CHECK(size == 0);
+ // Nothing to store
+ } else {
+ std::size_t payloadBytes{std::min(size,
+ s.size() *
+ sizeof(typename std::decay_t<decltype(s)>::value_type))};
+ if (std::memcmp(dst, s.data(), payloadBytes) != 0 ||
+ (payloadBytes < size &&
+ !std::all_of(
+ static_cast<const char *>(dst) + payloadBytes,
+ static_cast<const char *>(dst) + size,
+ [](char x) { return x == 0; }))) {
+ std::memcpy(dst, s.data(), payloadBytes);
+ if (payloadBytes < size) {
+ std::memset(static_cast<char *>(dst) + payloadBytes, 0,
+ size - payloadBytes);
+ }
+ if (changed)
+ *changed = true;
+ }
+ }
+ },
+ storage_);
+}
+
+} // namespace Fortran::evaluate::value
diff --git a/flang/lib/Evaluate/character-value-impl.h b/flang/lib/Evaluate/character-value-impl.h
new file mode 100644
index 0000000000000..f4d97fff95f87
--- /dev/null
+++ b/flang/lib/Evaluate/character-value-impl.h
@@ -0,0 +1,229 @@
+//===-- include/flang/Evaluate/character-value-impl.h -----------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_EVALUATE_CHARACTER_VALUE_IMPL_H_
+#define FORTRAN_EVALUATE_CHARACTER_VALUE_IMPL_H_
+
+#include "flang/Evaluate/common.h"
+#include "llvm/Support/ErrorHandling.h"
+#include <cstddef>
+#include <optional>
+#include <string>
+#include <utility>
+#include <variant>
+
+namespace Fortran::evaluate::value {
+
+class CharacterValueImpl {
+ using Storage =
+ std::variant<std::monostate, std::string, std::u16string, std::u32string>;
+
+public:
+ // rule-of-five
+ ~CharacterValueImpl() = default;
+ CharacterValueImpl(const CharacterValueImpl &) = default;
+ CharacterValueImpl(CharacterValueImpl &&) = default;
+ CharacterValueImpl &operator=(const CharacterValueImpl &) = default;
+ CharacterValueImpl &operator=(CharacterValueImpl &&) = default;
+
+ CharacterValueImpl() = default;
+ explicit CharacterValueImpl(std::string s) : storage_{std::move(s)} {}
+ explicit CharacterValueImpl(std::u16string s) : storage_{std::move(s)} {}
+ explicit CharacterValueImpl(std::u32string s) : storage_{std::move(s)} {}
+
+ CharacterValueImpl(int kind, std::string s)
+ : CharacterValueImpl{std::move(s)} {
+ CHECK(kind == 1);
+ }
+
+ CharacterValueImpl(int kind, std::u16string s)
+ : CharacterValueImpl{std::move(s)} {
+ CHECK(kind == 2);
+ }
+
+ CharacterValueImpl(int kind, std::u32string s)
+ : CharacterValueImpl{std::move(s)} {
+ CHECK(kind == 4);
+ }
+
+ /// Fill constructors: create a string of n copies of the given character.
+ CharacterValueImpl(int kind, std::size_t n, char32_t c);
+
+ static CharacterValueImpl Zero(int kind);
+
+ static CharacterValueImpl FromRawBytes(
+ int kind, const void *raw, size_t byteSize);
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+ LLVM_DUMP_METHOD void dump() const;
+#endif
+
+ std::optional<llvm::StringRef> AsStringRef() const;
+
+ /// Return the string as std::string if kind==1, or nullopt otherwise.
+ std::optional<std::string> AsStdString() const;
+ std::optional<std::u16string> AsU16String() const;
+ std::optional<std::u32string> AsU32String() const;
+
+ bool IsMonostate() const { return storage_.index() == 0; }
+ int kind() const {
+ return withCharProto([](auto ct) { return sizeof(ct); });
+ }
+
+ /// Byte size of one character unit (1, 2, or 4).
+ std::size_t charSize() const;
+
+ /// Number of characters in this string.
+ std::size_t size() const;
+
+ /// String length (synonym for size()).
+ std::size_t length() const { return size(); }
+
+ /// True when the string is empty.
+ bool empty() const { return size() == 0; }
+
+ /// Raw byte pointer to the underlying character data.
+ void *data() { return charData(); }
+ const void *data() const { return charData(); }
+ void *charData();
+ const void *charData() const;
+
+ // Comparison operators
+ Ordering Compare(const CharacterValueImpl &y) const;
+ bool operator<(const CharacterValueImpl &y) const;
+ bool operator<=(const CharacterValueImpl &y) const { return !(y < *this); }
+ bool operator==(const CharacterValueImpl &y) const;
+ bool operator!=(const CharacterValueImpl &y) const { return !(*this == y); }
+ bool operator>=(const CharacterValueImpl &y) const { return !(*this < y); }
+ bool operator>(const CharacterValueImpl &y) const { return y < *this; }
+
+ /// Assign n copies of the given character.
+ void assign(int kind, std::size_t n, char32_t c);
+
+ /// Assign from a raw character pointer and length.
+ void assign(const char *p, std::size_t n) { storage_ = std::string(p, n); }
+ void assign(const char16_t *p, std::size_t n) {
+ storage_ = std::u16string(p, n);
+ }
+ void assign(const char32_t *p, std::size_t n) {
+ storage_ = std::u32string(p, n);
+ }
+
+ /// Erase from position pos to end.
+ void erase(std::size_t pos);
+
+ /// Append n copies of the given character.
+ void append(std::size_t n, char32_t c);
+
+ /// Replace the substring [pos, pos+len) with characters from other.
+ CharacterValueImpl &replace(
+ std::size_t pos, std::size_t len, const CharacterValueImpl &other);
+
+ /// Return a suffix starting at pos.
+ CharacterValueImpl substr(std::size_t pos) const;
+
+ /// Return a substring of len characters starting at pos.
+ CharacterValueImpl substr(std::size_t pos, std::size_t len) const;
+
+ CharacterValueImpl ToAscii(int kind) const;
+
+ /// Reserve storage for at least n characters.
+ void reserve(std::size_t n);
+
+ /// Return the character at position i as char32_t (safe for all kinds).
+ char32_t operator[](std::size_t i) const;
+
+ /// Concatenate two same-kind strings.
+ CharacterValueImpl operator+(const CharacterValueImpl &y) const;
+
+ /// Append another same-kind string.
+ CharacterValueImpl &operator+=(const CharacterValueImpl &y);
+
+ /// Append a character, converting it to the string's element type.
+ CharacterValueImpl &operator+=(char c);
+
+ /// Sentinel value for "not found" positions (same as std::string::npos).
+ static constexpr std::size_t npos{std::string::npos};
+
+ // Find-family methods; return npos when not found.
+ std::size_t find_first_not_of(char c) const {
+ return find_first_not_of(static_cast<char32_t>(c));
+ }
+ std::size_t find_first_not_of(char16_t c) const {
+ return find_first_not_of(static_cast<char32_t>(c));
+ }
+ std::size_t find_first_not_of(char32_t c) const;
+ std::size_t find_last_not_of(char c) const {
+ return find_last_not_of(static_cast<char32_t>(c));
+ }
+ std::size_t find_last_not_of(char16_t c) const {
+ return find_last_not_of(static_cast<char32_t>(c));
+ }
+ std::size_t find_last_not_of(char32_t c) const;
+ std::size_t find_first_not_of(const CharacterValueImpl &set) const;
+ std::size_t find_last_not_of(const CharacterValueImpl &set) const;
+ std::size_t find(const CharacterValueImpl &pattern) const;
+ std::size_t rfind(const CharacterValueImpl &pattern) const;
+ std::size_t find_first_of(const CharacterValueImpl &set) const;
+ std::size_t find_last_of(const CharacterValueImpl &set) const;
+
+ void StoreRawBytes(void *dst, size_t size, bool *changed) const;
+
+ // Compile-time dispatchers to current/specified kind
+
+ template <typename F>
+ auto withCharProto(F &&f) const
+ -> decltype(std::declval<F>()(std::declval<char>())) {
+ switch (storage_.index()) {
+ case 1:
+ return f(char{});
+ case 2:
+ return f(char16_t{});
+ case 3:
+ return f(char32_t{});
+ default:
+ llvm_unreachable("unsupported character kind/monostate");
+ }
+ }
+
+ template <typename F>
+ static auto withCharProto(int kind, F &&f)
+ -> decltype(std::declval<F>()(std::declval<char>())) {
+ switch (kind) {
+ case 1:
+ return f(char{});
+ case 2:
+ return f(char16_t{});
+ case 4:
+ return f(char32_t{});
+ default:
+ llvm_unreachable("unsupported character kind/monostate");
+ }
+ }
+
+ template <typename F>
+ auto withStdString(F &&f) const
+ -> decltype(std::declval<F>()(std::declval<const std::string &>())) {
+ switch (storage_.index()) {
+ case 1:
+ return f(std::get<std::string>(storage_));
+ case 2:
+ return f(std::get<std::u16string>(storage_));
+ case 3:
+ return f(std::get<std::u32string>(storage_));
+ default:
+ llvm_unreachable("operation on uninitialized CharacterValue");
+ }
+ }
+
+private:
+ Storage storage_;
+};
+
+} // namespace Fortran::evaluate::value
+#endif // FORTRAN_EVALUATE_CHARACTER_VALUE_IMPL_H_
diff --git a/flang/lib/Evaluate/character-value.cpp b/flang/lib/Evaluate/character-value.cpp
new file mode 100644
index 0000000000000..4348be0b4478c
--- /dev/null
+++ b/flang/lib/Evaluate/character-value.cpp
@@ -0,0 +1,215 @@
+//===-- lib/Evaluate/character-value.cpp ----------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Evaluate/character-value.h"
+#include "character-value-impl.h"
+#include "flang/Evaluate/common.h"
+#include "llvm/Support/ErrorHandling.h"
+#include <new>
+#include <string>
+
+namespace Fortran::evaluate::value {
+static_assert(sizeof(CharacterValueImpl) == detail::kCharacterObjectSize);
+static_assert(alignof(CharacterValueImpl) == detail::kCharacterObjectAlign);
+static_assert(sizeof(CharacterValue) == sizeof(CharacterValueImpl));
+static_assert(alignof(CharacterValue) == alignof(CharacterValueImpl));
+
+CharacterValue::CharacterValue() { new (this) CharacterValueImpl(); }
+
+CharacterValue::~CharacterValue() { impl().~CharacterValueImpl(); }
+
+CharacterValue::CharacterValue(const CharacterValue &x) {
+ new (this) CharacterValueImpl(x.impl());
+}
+
+CharacterValue::CharacterValue(CharacterValue &&x) {
+ new (this) CharacterValueImpl(std::move(x.impl()));
+}
+
+CharacterValue &CharacterValue::operator=(const CharacterValue &x) {
+ impl() = x.impl();
+ return *this;
+}
+
+CharacterValue &CharacterValue::operator=(CharacterValue &&x) {
+ impl() = std::move(x.impl());
+ return *this;
+}
+
+CharacterValue::CharacterValue(int kind, std::string s) {
+ CHECK(kind == 1);
+ new (this) CharacterValueImpl(std::move(s));
+}
+
+CharacterValue::CharacterValue(int kind, std::u16string s) {
+ CHECK(kind == 2);
+ new (this) CharacterValueImpl(std::move(s));
+}
+
+CharacterValue::CharacterValue(int kind, std::u32string s) {
+ CHECK(kind == 4);
+ new (this) CharacterValueImpl(std::move(s));
+}
+
+CharacterValue::CharacterValue(int kind, std::size_t n, char32_t c) {
+ new (this) CharacterValueImpl(kind, n, c);
+}
+
+CharacterValue CharacterValue::Zero(int kind) {
+ return FromImpl(CharacterValueImpl::Zero(kind));
+}
+
+CharacterValue CharacterValue::FromRawBytes(
+ int kind, const void *raw, size_t byteSize) {
+ return FromImpl(CharacterValueImpl::FromRawBytes(kind, raw, byteSize));
+}
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+LLVM_DUMP_METHOD void CharacterValue::dump() const { impl().dump(); }
+#endif
+
+bool CharacterValue::IsMonostate() const { return impl().IsMonostate(); }
+
+bool CharacterValue::empty() const { return impl().empty(); }
+
+std::size_t CharacterValue::size() const { return impl().size(); }
+
+int CharacterValue::kind() const { return impl().kind(); }
+
+std::optional<llvm::StringRef> CharacterValue::AsStringRef() const {
+ return impl().AsStringRef();
+}
+
+std::optional<std::u16string> CharacterValue::AsU16String() const {
+ return impl().AsU16String();
+}
+
+std::optional<std::u32string> CharacterValue::AsU32String() const {
+ return impl().AsU32String();
+}
+
+Ordering CharacterValue::Compare(const CharacterValue &y) const {
+ return impl().Compare(y.impl());
+}
+
+bool CharacterValue::operator<(const CharacterValue &y) const {
+ return impl() < y.impl();
+}
+
+bool CharacterValue::operator==(const CharacterValue &y) const {
+ return impl() == y.impl();
+}
+
+CharacterValue CharacterValue::ToAscii(int kind) const {
+ return FromImpl(impl().ToAscii(kind));
+}
+
+void CharacterValue::assign(int kind, std::size_t n, char32_t c) {
+ impl().assign(kind, n, c);
+}
+
+void CharacterValue::assign(const char *p, std::size_t n) {
+ impl().assign(p, n);
+}
+
+void CharacterValue::assign(const char16_t *p, std::size_t n) {
+ impl().assign(p, n);
+}
+
+void CharacterValue::assign(const char32_t *p, std::size_t n) {
+ impl().assign(p, n);
+}
+
+void CharacterValue::erase(std::size_t pos) { impl().erase(pos); }
+
+void CharacterValue::append(std::size_t n, char32_t c) { impl().append(n, c); }
+
+CharacterValue &CharacterValue::replace(
+ std::size_t pos, std::size_t len, const CharacterValue &other) {
+ impl().replace(pos, len, other.impl());
+ return *this;
+}
+
+CharacterValue CharacterValue::substr(std::size_t pos) const {
+ return FromImpl(impl().substr(pos));
+}
+
+CharacterValue CharacterValue::substr(std::size_t pos, std::size_t len) const {
+ return FromImpl(impl().substr(pos, len));
+}
+
+void CharacterValue::reserve(std::size_t n) { impl().reserve(n); }
+char32_t CharacterValue::operator[](std::size_t i) const { return impl()[i]; }
+
+CharacterValue CharacterValue::operator+(const CharacterValue &y) const {
+ return FromImpl(impl() + y.impl());
+}
+
+CharacterValue &CharacterValue::operator+=(const CharacterValue &y) {
+ impl() += y.impl();
+ return *this;
+}
+
+CharacterValue &CharacterValue::operator+=(char c) {
+ impl() += c;
+ return *this;
+}
+
+std::size_t CharacterValue::find(const CharacterValue &pattern) const {
+ return impl().find(pattern.impl());
+}
+
+std::size_t CharacterValue::rfind(const CharacterValue &pattern) const {
+ return impl().rfind(pattern.impl());
+}
+
+std::size_t CharacterValue::find_first_of(const CharacterValue &set) const {
+ return impl().find_first_of(set.impl());
+}
+
+std::size_t CharacterValue::find_last_of(const CharacterValue &set) const {
+ return impl().find_last_of(set.impl());
+}
+
+std::size_t CharacterValue::find_first_not_of(char32_t c) const {
+ return impl().find_first_not_of(c);
+}
+
+std::size_t CharacterValue::find_last_not_of(char32_t c) const {
+ return impl().find_last_not_of(c);
+}
+
+std::size_t CharacterValue::find_first_not_of(const CharacterValue &set) const {
+ return impl().find_first_not_of(set.impl());
+}
+
+std::size_t CharacterValue::find_last_not_of(const CharacterValue &set) const {
+ return impl().find_last_not_of(set.impl());
+}
+
+void *CharacterValue::data() { return impl().data(); }
+const void *CharacterValue::data() const { return impl().data(); }
+
+void CharacterValue::StoreRawBytes(
+ void *dst, size_t size, bool *changed) const {
+ impl().StoreRawBytes(dst, size, changed);
+}
+
+CharacterValue CharacterValue::FromImpl(const CharacterValueImpl &y) {
+ CharacterValue result;
+ result.impl() = y;
+ return result;
+}
+
+CharacterValue CharacterValue::FromImpl(CharacterValueImpl &&y) {
+ CharacterValue result;
+ result.impl() = std::move(y);
+ return result;
+}
+
+} // namespace Fortran::evaluate::value
diff --git a/flang/lib/Evaluate/character.h b/flang/lib/Evaluate/character.h
index 2d6747741161b..c1a34257e5682 100644
--- a/flang/lib/Evaluate/character.h
+++ b/flang/lib/Evaluate/character.h
@@ -9,7 +9,9 @@
#ifndef FORTRAN_EVALUATE_CHARACTER_H_
#define FORTRAN_EVALUATE_CHARACTER_H_
+#include "flang/Evaluate/character-value.h"
#include "flang/Evaluate/type.h"
+#include <cstdint>
#include <string>
// Provides implementations of intrinsic functions operating on character
@@ -17,41 +19,53 @@
namespace Fortran::evaluate {
-template <int KIND> class CharacterUtils {
- using Character = Scalar<Type<TypeCategory::Character, KIND>>;
- using CharT = typename Character::value_type;
+class CharacterUtils {
+ using Character = Scalar<Type<TypeCategory::Character>>;
+ using CharT = char32_t;
public:
// CHAR also implements ACHAR under assumption that character encodings
// contain ASCII
- static Character CHAR(std::uint64_t code) {
- return Character{{static_cast<CharT>(code)}};
+ static Character CHAR(int kind, std::uint64_t code) {
+ return Character{kind, 1, static_cast<CharT>(code)};
}
// ICHAR also implements IACHAR under assumption that character encodings
// contain ASCII
static std::int64_t ICHAR(const Character &c) {
CHECK(c.length() == 1);
- // Convert first to an unsigned integer type to avoid sign extension
- return static_cast<common::HostUnsignedIntType<(8 * KIND)>>(c[0]);
+ // Mask to the character kind width to avoid sign extension
+ auto ch{static_cast<std::uint64_t>(c[0])};
+ switch (c.kind()) {
+ case 1:
+ return static_cast<std::int64_t>(ch & 0xffu);
+ case 2:
+ return static_cast<std::int64_t>(ch & 0xffffu);
+ case 4:
+ return static_cast<std::int64_t>(ch & 0xffffffffu);
+ }
+ llvm_unreachable("unsupported character kind");
}
- static Character NEW_LINE() { return Character{{NewLine()}}; }
+ static Character NEW_LINE(int kind) { return Character{kind, 1, NewLine()}; }
static Character ADJUSTL(const Character &str) {
+ const int kind{str.kind()};
auto pos{str.find_first_not_of(Space())};
if (pos != Character::npos && pos != 0) {
- return Character{str.substr(pos) + Character(pos, Space())};
+ return Character{str.substr(pos) + Character{kind, pos, Space()}};
}
// else empty or only spaces, or no leading spaces
return str;
}
static Character ADJUSTR(const Character &str) {
+ const int kind{str.kind()};
auto pos{str.find_last_not_of(Space())};
if (pos != Character::npos && pos != str.length() - 1) {
auto delta{str.length() - 1 - pos};
- return Character{Character(delta, Space()) + str.substr(0, pos + 1)};
+ return Character{
+ Character{kind, delta, Space()} + str.substr(0, pos + 1)};
}
// else empty or only spaces, or no trailing spaces
return str;
@@ -78,9 +92,10 @@ template <int KIND> class CharacterUtils {
// Resize adds spaces on the right if the new size is bigger than the
// original, or by trimming the rightmost characters otherwise.
static Character Resize(const Character &str, std::size_t newLength) {
+ const int kind{str.kind()};
auto oldLength{str.length()};
if (newLength > oldLength) {
- return str + Character(newLength - oldLength, Space());
+ return str + Character{kind, newLength - oldLength, Space()};
} else {
return str.substr(0, newLength);
}
@@ -97,7 +112,8 @@ template <int KIND> class CharacterUtils {
}
static Character REPEAT(const Character &str, ConstantSubscript ncopies) {
- Character result;
+ const int kind{str.kind()};
+ Character result{Character::Zero(kind)};
if (!str.empty() && ncopies > 0) {
result.reserve(ncopies * str.size());
while (ncopies-- > 0) {
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 4b05a25fd8f58..4f1c6831e3aeb 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -9,6 +9,7 @@
#include "flang/Evaluate/characteristics.h"
#include "flang/Common/indirection.h"
#include "flang/Evaluate/check-expression.h"
+#include "flang/Evaluate/expression.h"
#include "flang/Evaluate/fold.h"
#include "flang/Evaluate/intrinsics.h"
#include "flang/Evaluate/tools.h"
@@ -194,10 +195,9 @@ std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureElementSizeInBytes(
if (LEN_) {
CHECK(type_.category() == TypeCategory::Character);
return Fold(foldingContext,
- Expr<SubscriptInteger>{
- foldingContext.targetCharacteristics().GetByteSize(
- type_.category(), type_.kind())} *
- Expr<SubscriptInteger>{*LEN_});
+ MakeSubscriptIntExpr(foldingContext.targetCharacteristics().GetByteSize(
+ type_.category(), type_.kind())) *
+ common::Clone(*LEN_));
}
if (auto elementBytes{type_.MeasureSizeInBytes(foldingContext, align)}) {
return Fold(foldingContext, std::move(*elementBytes));
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 737502a504d61..d3722c46632f3 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -71,10 +71,8 @@ class IsConstantExprHelper
return (*this)(component.base());
}
// Prevent integer division by known zeroes in constant expressions.
- template <int KIND>
- bool operator()(
- const Divide<Type<TypeCategory::Integer, KIND>> &division) const {
- using T = Type<TypeCategory::Integer, KIND>;
+ bool operator()(const Divide<Type<TypeCategory::Integer>> &division) const {
+ using T = Type<TypeCategory::Integer>;
if ((*this)(division.left()) && (*this)(division.right())) {
const auto divisor{GetScalarConstantValue<T>(division.right())};
return !divisor || !divisor->IsZero();
@@ -481,9 +479,9 @@ class SuspiciousRealLiteralFinder
SuspiciousRealLiteralFinder(int kind, FoldingContext &c)
: Base{*this}, kind_{kind}, context_{c} {}
using Base::operator();
- template <int KIND>
- bool operator()(const Constant<Type<TypeCategory::Real, KIND>> &x) const {
- if (kind_ > KIND && x.result().isFromInexactLiteralConversion()) {
+ bool operator()(const Constant<Type<TypeCategory::Real>> &x) const {
+ const int kind{x.kind()};
+ if (kind_ > kind && x.result().isFromInexactLiteralConversion()) {
context_.Warn(common::UsageWarning::RealConstantWidening,
"Default real literal in REAL(%d) context might need a kind suffix, as its rounded value %s is inexact"_warn_en_US,
kind_, x.AsFortran());
@@ -492,9 +490,9 @@ class SuspiciousRealLiteralFinder
return false;
}
}
- template <int KIND>
- bool operator()(const Constant<Type<TypeCategory::Complex, KIND>> &x) const {
- if (kind_ > KIND && x.result().isFromInexactLiteralConversion()) {
+ bool operator()(const Constant<Type<TypeCategory::Complex>> &x) const {
+ const int kind{x.kind()};
+ if (kind_ > kind && x.result().isFromInexactLiteralConversion()) {
context_.Warn(common::UsageWarning::RealConstantWidening,
"Default real literal in COMPLEX(%d) context might need a kind suffix, as its rounded value %s is inexact"_warn_en_US,
kind_, x.AsFortran());
@@ -503,13 +501,14 @@ class SuspiciousRealLiteralFinder
return false;
}
}
- template <TypeCategory TOCAT, int TOKIND, TypeCategory FROMCAT>
- bool operator()(const Convert<Type<TOCAT, TOKIND>, FROMCAT> &x) const {
+ template <TypeCategory TOCAT, TypeCategory FROMCAT>
+ bool operator()(const Convert<Type<TOCAT>, FROMCAT> &x) const {
+ const int toKind{x.kind()};
if constexpr ((TOCAT == TypeCategory::Real ||
TOCAT == TypeCategory::Complex) &&
(FROMCAT == TypeCategory::Real || FROMCAT == TypeCategory::Complex)) {
auto fromType{x.left().GetType()};
- if (!fromType || fromType->kind() < TOKIND) {
+ if (!fromType || fromType->kind() < toKind) {
return false;
}
}
@@ -548,9 +547,8 @@ class InexactLiteralConversionFlagClearer
using Base = AnyTraverse<InexactLiteralConversionFlagClearer>;
InexactLiteralConversionFlagClearer() : Base(*this) {}
using Base::operator();
- template <int KIND>
- bool operator()(const Constant<Type<TypeCategory::Real, KIND>> &x) const {
- auto &mut{const_cast<Type<TypeCategory::Real, KIND> &>(x.result())};
+ bool operator()(const Constant<Type<TypeCategory::Real>> &x) const {
+ auto &mut{const_cast<Type<TypeCategory::Real> &>(x.result())};
mut.set_isFromInexactLiteralConversion(false);
return false;
}
diff --git a/flang/lib/Evaluate/common.cpp b/flang/lib/Evaluate/common.cpp
index 119ea3c5612a5..49874c4b5a744 100644
--- a/flang/lib/Evaluate/common.cpp
+++ b/flang/lib/Evaluate/common.cpp
@@ -8,11 +8,17 @@
#include "flang/Evaluate/common.h"
#include "flang/Common/idioms.h"
+#include "flang/Evaluate/character-value.h"
using namespace Fortran::parser::literals;
namespace Fortran::evaluate {
+Ordering Compare(
+ const value::CharacterValue &x, const value::CharacterValue &y) {
+ return x.Compare(y);
+}
+
void FoldingContext::RealFlagWarnings(
const RealFlags &flags, const char *operation) {
static constexpr auto warning{common::UsageWarning::FoldingException};
diff --git a/flang/lib/Evaluate/complex-value.cpp b/flang/lib/Evaluate/complex-value.cpp
new file mode 100644
index 0000000000000..9697a0bdb18e7
--- /dev/null
+++ b/flang/lib/Evaluate/complex-value.cpp
@@ -0,0 +1,182 @@
+//===-- lib/Evaluate/complex-value.cpp ------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Evaluate/complex-value.h"
+#include "flang/Common/idioms.h"
+#include "llvm/Support/raw_ostream.h"
+#include <string>
+
+namespace Fortran::evaluate::value {
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+LLVM_DUMP_METHOD void ComplexValue::dump() const {
+ AsFortran(llvm::errs(), kind()) << '\n';
+}
+#endif
+
+ValueWithRealFlags<ComplexValue> ComplexValue::FromInteger(
+ int kind, const IntegerValue &n, bool isUnsigned, Rounding rounding) {
+ CHECK(!n.IsMonostate());
+
+ ValueWithRealFlags<ComplexValue> result;
+ result.value.re_ = RealValue::FromInteger(kind, n, isUnsigned, rounding)
+ .AccumulateFlags(result.flags);
+ result.value.im_ = RealValue::Zero(kind);
+ return result;
+}
+
+ValueWithRealFlags<ComplexValue> ComplexValue::Add(
+ const ComplexValue &y, Rounding rounding) const {
+ CHECK(!IsMonostate());
+
+ RealFlags flags;
+ RealValue reSum{re_.Add(y.re_, rounding).AccumulateFlags(flags)};
+ RealValue imSum{im_.Add(y.im_, rounding).AccumulateFlags(flags)};
+ return {ComplexValue{reSum, imSum}, flags};
+}
+
+ValueWithRealFlags<ComplexValue> ComplexValue::Subtract(
+ const ComplexValue &y, Rounding rounding) const {
+ CHECK(!IsMonostate());
+
+ RealFlags flags;
+ RealValue reDiff{re_.Subtract(y.re_, rounding).AccumulateFlags(flags)};
+ RealValue imDiff{im_.Subtract(y.im_, rounding).AccumulateFlags(flags)};
+ return {ComplexValue{reDiff, imDiff}, flags};
+}
+
+ValueWithRealFlags<ComplexValue> ComplexValue::Multiply(
+ const ComplexValue &y, Rounding rounding) const {
+ CHECK(!IsMonostate());
+
+ // (a + ib)*(c + id) -> ac - bd + i(ad + bc)
+ RealFlags flags;
+ RealValue ac{re_.Multiply(y.re_, rounding).AccumulateFlags(flags)};
+ RealValue bd{im_.Multiply(y.im_, rounding).AccumulateFlags(flags)};
+ RealValue ad{re_.Multiply(y.im_, rounding).AccumulateFlags(flags)};
+ RealValue bc{im_.Multiply(y.re_, rounding).AccumulateFlags(flags)};
+ RealValue acbd{ac.Subtract(bd, rounding).AccumulateFlags(flags)};
+ RealValue adbc{ad.Add(bc, rounding).AccumulateFlags(flags)};
+ return {ComplexValue{acbd, adbc}, flags};
+}
+
+ValueWithRealFlags<ComplexValue> ComplexValue::Divide(
+ const ComplexValue &that, Rounding rounding) const {
+ CHECK(!IsMonostate());
+
+ // (a + ib)/(c + id) -> [(a+ib)*(c-id)] / [(c+id)*(c-id)]
+ // -> [ac+bd+i(bc-ad)] / (cc+dd) -- note (cc+dd) is real
+ // -> ((ac+bd)/(cc+dd)) + i((bc-ad)/(cc+dd))
+ RealFlags flags;
+ RealValue cc{that.re_.Multiply(that.re_, rounding).AccumulateFlags(flags)};
+ RealValue dd{that.im_.Multiply(that.im_, rounding).AccumulateFlags(flags)};
+ RealValue ccPdd{cc.Add(dd, rounding).AccumulateFlags(flags)};
+ if (!flags.test(RealFlag::Overflow) && !flags.test(RealFlag::Underflow)) {
+ // den = (cc+dd) did not overflow or underflow; try the naive
+ // sequence without scaling to avoid extra roundings.
+ RealValue ac{re_.Multiply(that.re_, rounding).AccumulateFlags(flags)};
+ RealValue ad{re_.Multiply(that.im_, rounding).AccumulateFlags(flags)};
+ RealValue bc{im_.Multiply(that.re_, rounding).AccumulateFlags(flags)};
+ RealValue bd{im_.Multiply(that.im_, rounding).AccumulateFlags(flags)};
+ RealValue acPbd{ac.Add(bd, rounding).AccumulateFlags(flags)};
+ RealValue bcSad{bc.Subtract(ad, rounding).AccumulateFlags(flags)};
+ RealValue re{acPbd.Divide(ccPdd, rounding).AccumulateFlags(flags)};
+ RealValue im{bcSad.Divide(ccPdd, rounding).AccumulateFlags(flags)};
+ if (!flags.test(RealFlag::Overflow) && !flags.test(RealFlag::Underflow)) {
+ return {ComplexValue{re, im}, flags};
+ }
+ }
+ // Scale numerator and denominator by d/c (if c>=d) or c/d (if c<d)
+ flags.clear();
+ RealValue scale; // will be <= 1.0 in magnitude
+ bool cGEd{that.re_.ABS().Compare(that.im_.ABS()) != Relation::Less};
+ if (cGEd) {
+ scale = that.im_.Divide(that.re_, rounding).AccumulateFlags(flags);
+ } else {
+ scale = that.re_.Divide(that.im_, rounding).AccumulateFlags(flags);
+ }
+ RealValue den;
+ if (cGEd) {
+ RealValue dS{scale.Multiply(that.im_, rounding).AccumulateFlags(flags)};
+ den = dS.Add(that.re_, rounding).AccumulateFlags(flags);
+ } else {
+ RealValue cS{scale.Multiply(that.re_, rounding).AccumulateFlags(flags)};
+ den = cS.Add(that.im_, rounding).AccumulateFlags(flags);
+ }
+ RealValue aS{scale.Multiply(re_, rounding).AccumulateFlags(flags)};
+ RealValue bS{scale.Multiply(im_, rounding).AccumulateFlags(flags)};
+ RealValue re1, im1;
+ if (cGEd) {
+ re1 = re_.Add(bS, rounding).AccumulateFlags(flags);
+ im1 = im_.Subtract(aS, rounding).AccumulateFlags(flags);
+ } else {
+ re1 = aS.Add(im_, rounding).AccumulateFlags(flags);
+ im1 = bS.Subtract(re_, rounding).AccumulateFlags(flags);
+ }
+ RealValue re{re1.Divide(den, rounding).AccumulateFlags(flags)};
+ RealValue im{im1.Divide(den, rounding).AccumulateFlags(flags)};
+ return {ComplexValue{re, im}, flags};
+}
+
+ValueWithRealFlags<ComplexValue> ComplexValue::KahanSummation(
+ const ComplexValue &y, ComplexValue &correction, Rounding rounding) const {
+ CHECK(!y.IsMonostate());
+ CHECK(!correction.IsMonostate());
+
+ RealFlags flags;
+ RealValue reSum{re_.KahanSummation(y.re_, correction.re_, rounding)
+ .AccumulateFlags(flags)};
+ RealValue imSum{im_.KahanSummation(y.im_, correction.im_, rounding)
+ .AccumulateFlags(flags)};
+ return {ComplexValue{reSum, imSum}, flags};
+}
+
+std::string ComplexValue::DumpHexadecimal() const {
+ CHECK(!IsMonostate());
+
+ std::string result{'('};
+ result += re_.DumpHexadecimal();
+ result += ',';
+ result += im_.DumpHexadecimal();
+ result += ')';
+ return result;
+}
+
+llvm::raw_ostream &ComplexValue::AsFortran(
+ llvm::raw_ostream &o, int kind) const {
+ CHECK(!IsMonostate());
+
+ re_.AsFortran(o << '(', kind);
+ im_.AsFortran(o << ',', kind);
+ return o << ')';
+}
+
+void ComplexValue::StoreRawBytes(
+ void *dst, [[maybe_unused]] size_t expectedSize, bool *changed) const {
+ CHECK(!IsMonostate());
+ CHECK(re_.bits() == im_.bits());
+ CHECK(expectedSize == re_.bytesStored() + im_.bytesStored());
+
+ re_.StoreRawBytes(dst, re_.bytesStored(), changed);
+ im_.StoreRawBytes(
+ static_cast<char *>(dst) + re_.bytesStored(), im_.bytesStored(), changed);
+}
+
+ComplexValue ComplexValue::FromRawBytes(
+ int kind, const void *raw, std::size_t expectedSize) {
+ CHECK(expectedSize == static_cast<size_t>(-1) ||
+ expectedSize == bytesStored(kind));
+ std::size_t partBytes{RealValue::bytesStored(kind)};
+ const char *data{static_cast<const char *>(raw)};
+ RealValue realPart{RealValue::FromRawBytes(kind, data, partBytes)};
+ RealValue imagPart{
+ RealValue::FromRawBytes(kind, data + partBytes, partBytes)};
+ return {realPart, imagPart};
+}
+
+} // namespace Fortran::evaluate::value
diff --git a/flang/lib/Evaluate/complex.cpp b/flang/lib/Evaluate/complex.cpp
deleted file mode 100644
index a245fb38c82b9..0000000000000
--- a/flang/lib/Evaluate/complex.cpp
+++ /dev/null
@@ -1,136 +0,0 @@
-//===-- lib/Evaluate/complex.cpp ------------------------------------------===//
-//
-// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
-// See https://llvm.org/LICENSE.txt for license information.
-// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-//
-//===----------------------------------------------------------------------===//
-
-#include "flang/Evaluate/complex.h"
-#include "llvm/Support/raw_ostream.h"
-
-namespace Fortran::evaluate::value {
-
-template <typename R>
-ValueWithRealFlags<Complex<R>> Complex<R>::Add(
- const Complex &that, Rounding rounding) const {
- RealFlags flags;
- Part reSum{re_.Add(that.re_, rounding).AccumulateFlags(flags)};
- Part imSum{im_.Add(that.im_, rounding).AccumulateFlags(flags)};
- return {Complex{reSum, imSum}, flags};
-}
-
-template <typename R>
-ValueWithRealFlags<Complex<R>> Complex<R>::Subtract(
- const Complex &that, Rounding rounding) const {
- RealFlags flags;
- Part reDiff{re_.Subtract(that.re_, rounding).AccumulateFlags(flags)};
- Part imDiff{im_.Subtract(that.im_, rounding).AccumulateFlags(flags)};
- return {Complex{reDiff, imDiff}, flags};
-}
-
-template <typename R>
-ValueWithRealFlags<Complex<R>> Complex<R>::Multiply(
- const Complex &that, Rounding rounding) const {
- // (a + ib)*(c + id) -> ac - bd + i(ad + bc)
- RealFlags flags;
- Part ac{re_.Multiply(that.re_, rounding).AccumulateFlags(flags)};
- Part bd{im_.Multiply(that.im_, rounding).AccumulateFlags(flags)};
- Part ad{re_.Multiply(that.im_, rounding).AccumulateFlags(flags)};
- Part bc{im_.Multiply(that.re_, rounding).AccumulateFlags(flags)};
- Part acbd{ac.Subtract(bd, rounding).AccumulateFlags(flags)};
- Part adbc{ad.Add(bc, rounding).AccumulateFlags(flags)};
- return {Complex{acbd, adbc}, flags};
-}
-
-template <typename R>
-ValueWithRealFlags<Complex<R>> Complex<R>::Divide(
- const Complex &that, Rounding rounding) const {
- // (a + ib)/(c + id) -> [(a+ib)*(c-id)] / [(c+id)*(c-id)]
- // -> [ac+bd+i(bc-ad)] / (cc+dd) -- note (cc+dd) is real
- // -> ((ac+bd)/(cc+dd)) + i((bc-ad)/(cc+dd))
- RealFlags flags;
- Part cc{that.re_.Multiply(that.re_, rounding).AccumulateFlags(flags)};
- Part dd{that.im_.Multiply(that.im_, rounding).AccumulateFlags(flags)};
- Part ccPdd{cc.Add(dd, rounding).AccumulateFlags(flags)};
- if (!flags.test(RealFlag::Overflow) && !flags.test(RealFlag::Underflow)) {
- // den = (cc+dd) did not overflow or underflow; try the naive
- // sequence without scaling to avoid extra roundings.
- Part ac{re_.Multiply(that.re_, rounding).AccumulateFlags(flags)};
- Part ad{re_.Multiply(that.im_, rounding).AccumulateFlags(flags)};
- Part bc{im_.Multiply(that.re_, rounding).AccumulateFlags(flags)};
- Part bd{im_.Multiply(that.im_, rounding).AccumulateFlags(flags)};
- Part acPbd{ac.Add(bd, rounding).AccumulateFlags(flags)};
- Part bcSad{bc.Subtract(ad, rounding).AccumulateFlags(flags)};
- Part re{acPbd.Divide(ccPdd, rounding).AccumulateFlags(flags)};
- Part im{bcSad.Divide(ccPdd, rounding).AccumulateFlags(flags)};
- if (!flags.test(RealFlag::Overflow) && !flags.test(RealFlag::Underflow)) {
- return {Complex{re, im}, flags};
- }
- }
- // Scale numerator and denominator by d/c (if c>=d) or c/d (if c<d)
- flags.clear();
- Part scale; // will be <= 1.0 in magnitude
- bool cGEd{that.re_.ABS().Compare(that.im_.ABS()) != Relation::Less};
- if (cGEd) {
- scale = that.im_.Divide(that.re_, rounding).AccumulateFlags(flags);
- } else {
- scale = that.re_.Divide(that.im_, rounding).AccumulateFlags(flags);
- }
- Part den;
- if (cGEd) {
- Part dS{scale.Multiply(that.im_, rounding).AccumulateFlags(flags)};
- den = dS.Add(that.re_, rounding).AccumulateFlags(flags);
- } else {
- Part cS{scale.Multiply(that.re_, rounding).AccumulateFlags(flags)};
- den = cS.Add(that.im_, rounding).AccumulateFlags(flags);
- }
- Part aS{scale.Multiply(re_, rounding).AccumulateFlags(flags)};
- Part bS{scale.Multiply(im_, rounding).AccumulateFlags(flags)};
- Part re1, im1;
- if (cGEd) {
- re1 = re_.Add(bS, rounding).AccumulateFlags(flags);
- im1 = im_.Subtract(aS, rounding).AccumulateFlags(flags);
- } else {
- re1 = aS.Add(im_, rounding).AccumulateFlags(flags);
- im1 = bS.Subtract(re_, rounding).AccumulateFlags(flags);
- }
- Part re{re1.Divide(den, rounding).AccumulateFlags(flags)};
- Part im{im1.Divide(den, rounding).AccumulateFlags(flags)};
- return {Complex{re, im}, flags};
-}
-
-template <typename R>
-ValueWithRealFlags<Complex<R>> Complex<R>::KahanSummation(
- const Complex &that, Complex &correction, Rounding rounding) const {
- RealFlags flags;
- Part reSum{re_.KahanSummation(that.re_, correction.re_, rounding)
- .AccumulateFlags(flags)};
- Part imSum{im_.KahanSummation(that.im_, correction.im_, rounding)
- .AccumulateFlags(flags)};
- return {Complex{reSum, imSum}, flags};
-}
-
-template <typename R> std::string Complex<R>::DumpHexadecimal() const {
- std::string result{'('};
- result += re_.DumpHexadecimal();
- result += ',';
- result += im_.DumpHexadecimal();
- result += ')';
- return result;
-}
-
-template <typename R>
-llvm::raw_ostream &Complex<R>::AsFortran(llvm::raw_ostream &o, int kind) const {
- re_.AsFortran(o << '(', kind);
- im_.AsFortran(o << ',', kind);
- return o << ')';
-}
-
-template class Complex<Real<Integer<16>, 11>>;
-template class Complex<Real<Integer<16>, 8>>;
-template class Complex<Real<Integer<32>, 24>>;
-template class Complex<Real<Integer<64>, 53>>;
-template class Complex<Real<X87IntegerContainer, 64>>;
-template class Complex<Real<Integer<128>, 113>>;
-} // namespace Fortran::evaluate::value
diff --git a/flang/lib/Evaluate/constant.cpp b/flang/lib/Evaluate/constant.cpp
index 7fe000892ac1a..7a78c1ade352a 100644
--- a/flang/lib/Evaluate/constant.cpp
+++ b/flang/lib/Evaluate/constant.cpp
@@ -144,8 +144,10 @@ bool HasNegativeExtent(const ConstantSubscripts &shape) {
template <typename RESULT, typename ELEMENT>
ConstantBase<RESULT, ELEMENT>::ConstantBase(
- std::vector<Element> &&x, ConstantSubscripts &&sh, Result res)
- : ConstantBounds(std::move(sh)), result_{res}, values_(std::move(x)) {
+ int kind, std::vector<Element> &&x, ConstantSubscripts &&sh, Result res)
+ : ConstantBounds(std::move(sh)), kind_{kind}, result_{res},
+ values_(std::move(x)) {
+ CHECK_KIND(kind, RESULT);
CHECK(TotalElementCount(shape()) && size() == *TotalElementCount(shape()));
}
@@ -154,7 +156,8 @@ ConstantBase<RESULT, ELEMENT>::~ConstantBase() {}
template <typename RESULT, typename ELEMENT>
bool ConstantBase<RESULT, ELEMENT>::operator==(const ConstantBase &that) const {
- return shape() == that.shape() && values_ == that.values_;
+ return kind() == that.kind() && shape() == that.shape() &&
+ values_ == that.values_;
}
template <typename RESULT, typename ELEMENT>
@@ -198,7 +201,8 @@ auto Constant<T>::At(const ConstantSubscripts &index) const -> Element {
template <typename T>
auto Constant<T>::Reshape(ConstantSubscripts &&dims) const -> Constant {
- return {Base::Reshape(dims), std::move(dims)};
+ const int kind{Base::kind()};
+ return {kind, Base::Reshape(dims), std::move(dims)};
}
template <typename T>
@@ -207,25 +211,28 @@ std::size_t Constant<T>::CopyFrom(const Constant<T> &source, std::size_t count,
return Base::CopyFrom(source, count, resultSubscripts, dimOrder);
}
-// Constant<Type<TypeCategory::Character, KIND> specializations
-template <int KIND>
-Constant<Type<TypeCategory::Character, KIND>>::Constant(
- const Scalar<Result> &str)
- : values_{str}, length_{static_cast<ConstantSubscript>(values_.size())} {}
+// Constant<Type<TypeCategory::Character>> specialization
+Constant<Type<TypeCategory::Character>>::Constant(
+ int kind, const Scalar<Result> &str)
+ : kind_{kind}, values_{str},
+ length_{static_cast<ConstantSubscript>(values_.size())} {
+ CHECK(str.kind() == kind);
+}
-template <int KIND>
-Constant<Type<TypeCategory::Character, KIND>>::Constant(Scalar<Result> &&str)
- : values_{std::move(str)}, length_{static_cast<ConstantSubscript>(
- values_.size())} {}
+Constant<Type<TypeCategory::Character>>::Constant(
+ int kind, Scalar<Result> &&str)
+ : kind_{kind}, values_{std::move(str)},
+ length_{static_cast<ConstantSubscript>(values_.size())} {
+ CHECK(str.kind() == kind);
+}
-template <int KIND>
-Constant<Type<TypeCategory::Character, KIND>>::Constant(ConstantSubscript len,
- std::vector<Scalar<Result>> &&strings, ConstantSubscripts &&sh)
- : ConstantBounds(std::move(sh)), length_{len} {
+Constant<Type<TypeCategory::Character>>::Constant(int kind,
+ ConstantSubscript len, std::vector<Scalar<Result>> &&strings,
+ ConstantSubscripts &&sh)
+ : ConstantBounds(std::move(sh)), kind_{kind}, length_{len} {
CHECK(TotalElementCount(shape()) &&
strings.size() == *TotalElementCount(shape()));
- values_.assign(strings.size() * length_,
- static_cast<typename Scalar<Result>::value_type>(' '));
+ values_.assign(kind, strings.size() * length_, ' ');
ConstantSubscript at{0};
for (const auto &str : strings) {
auto strLen{static_cast<ConstantSubscript>(str.size())};
@@ -239,16 +246,13 @@ Constant<Type<TypeCategory::Character, KIND>>::Constant(ConstantSubscript len,
CHECK(at == static_cast<ConstantSubscript>(values_.size()));
}
-template <int KIND>
-Constant<Type<TypeCategory::Character, KIND>>::~Constant() {}
+Constant<Type<TypeCategory::Character>>::~Constant() {}
-template <int KIND>
-bool Constant<Type<TypeCategory::Character, KIND>>::empty() const {
+bool Constant<Type<TypeCategory::Character>>::empty() const {
return size() == 0;
}
-template <int KIND>
-std::size_t Constant<Type<TypeCategory::Character, KIND>>::size() const {
+std::size_t Constant<Type<TypeCategory::Character>>::size() const {
if (length_ == 0) {
std::optional<uint64_t> n{TotalElementCount(shape())};
CHECK(n);
@@ -258,23 +262,20 @@ std::size_t Constant<Type<TypeCategory::Character, KIND>>::size() const {
}
}
-template <int KIND>
-auto Constant<Type<TypeCategory::Character, KIND>>::At(
+auto Constant<Type<TypeCategory::Character>>::At(
const ConstantSubscripts &index) const -> Scalar<Result> {
auto offset{SubscriptsToOffset(index)};
return values_.substr(offset * length_, length_);
}
-template <int KIND>
-auto Constant<Type<TypeCategory::Character, KIND>>::Substring(
- ConstantSubscript lo, ConstantSubscript hi) const
- -> std::optional<Constant> {
+auto Constant<Type<TypeCategory::Character>>::Substring(ConstantSubscript lo,
+ ConstantSubscript hi) const -> std::optional<Constant> {
std::vector<Element> elements;
ConstantSubscript n{GetSize(shape())};
ConstantSubscript newLength{0};
if (lo > hi) { // zero-length results
while (n-- > 0) {
- elements.emplace_back(); // ""
+ elements.emplace_back(Scalar<Result>::Zero(kind())); // ""
}
} else if (lo < 1 || hi > length_) {
return std::nullopt;
@@ -284,11 +285,11 @@ auto Constant<Type<TypeCategory::Character, KIND>>::Substring(
elements.emplace_back(At(at).substr(lo - 1, newLength));
}
}
- return Constant{newLength, std::move(elements), ConstantSubscripts{shape()}};
+ return Constant{
+ kind(), newLength, std::move(elements), ConstantSubscripts{shape()}};
}
-template <int KIND>
-auto Constant<Type<TypeCategory::Character, KIND>>::Reshape(
+auto Constant<Type<TypeCategory::Character>>::Reshape(
ConstantSubscripts &&dims) const -> Constant<Result> {
std::optional<uint64_t> optN{TotalElementCount(dims)};
CHECK(optN);
@@ -304,14 +305,12 @@ auto Constant<Type<TypeCategory::Character, KIND>>::Reshape(
at = 0;
}
}
- return {length_, std::move(elements), std::move(dims)};
+ return {kind(), length_, std::move(elements), std::move(dims)};
}
-template <int KIND>
-std::size_t Constant<Type<TypeCategory::Character, KIND>>::CopyFrom(
- const Constant<Type<TypeCategory::Character, KIND>> &source,
- std::size_t count, ConstantSubscripts &resultSubscripts,
- const std::vector<int> *dimOrder) {
+std::size_t Constant<Type<TypeCategory::Character>>::CopyFrom(
+ const Constant<Type<TypeCategory::Character>> &source, std::size_t count,
+ ConstantSubscripts &resultSubscripts, const std::vector<int> *dimOrder) {
CHECK(length_ == source.length_);
if (length_ == 0) {
// It's possible that the array of strings consists of all empty strings.
@@ -320,11 +319,11 @@ std::size_t Constant<Type<TypeCategory::Character, KIND>>::CopyFrom(
return count;
} else {
std::size_t copied{0};
- std::size_t elementBytes{length_ * sizeof(decltype(values_[0]))};
+ std::size_t elementBytes{static_cast<std::size_t>(length_) * kind()};
ConstantSubscripts sourceSubscripts{source.lbounds()};
while (copied < count) {
- auto *dest{&values_.at(SubscriptsToOffset(resultSubscripts) * length_)};
- const auto *src{&source.values_.at(
+ auto *dest{values_.at(SubscriptsToOffset(resultSubscripts) * length_)};
+ const auto *src{source.values_.at(
source.SubscriptsToOffset(sourceSubscripts) * length_)};
std::memcpy(dest, src, elementBytes);
copied++;
@@ -337,14 +336,14 @@ std::size_t Constant<Type<TypeCategory::Character, KIND>>::CopyFrom(
// Constant<SomeDerived> specialization
Constant<SomeDerived>::Constant(const StructureConstructor &x)
- : Base{x.values(), Result{x.derivedTypeSpec()}} {}
+ : Base{/*kind=*/0, x.values(), Result{x.derivedTypeSpec()}} {}
Constant<SomeDerived>::Constant(StructureConstructor &&x)
- : Base{std::move(x.values()), Result{x.derivedTypeSpec()}} {}
+ : Base{/*kind=*/0, std::move(x.values()), Result{x.derivedTypeSpec()}} {}
Constant<SomeDerived>::Constant(const semantics::DerivedTypeSpec &spec,
std::vector<StructureConstructorValues> &&x, ConstantSubscripts &&s)
- : Base{std::move(x), std::move(s), Result{spec}} {}
+ : Base{/*kind=*/0, std::move(x), std::move(s), Result{spec}} {}
static std::vector<StructureConstructorValues> AcquireValues(
std::vector<StructureConstructor> &&x) {
@@ -357,7 +356,8 @@ static std::vector<StructureConstructorValues> AcquireValues(
Constant<SomeDerived>::Constant(const semantics::DerivedTypeSpec &spec,
std::vector<StructureConstructor> &&x, ConstantSubscripts &&shape)
- : Base{AcquireValues(std::move(x)), std::move(shape), Result{spec}} {}
+ : Base{/*kind=*/0, AcquireValues(std::move(x)), std::move(shape),
+ Result{spec}} {}
std::optional<StructureConstructor>
Constant<SomeDerived>::GetScalarValue() const {
diff --git a/flang/lib/Evaluate/expression.cpp b/flang/lib/Evaluate/expression.cpp
index fe8565fbe42a8..d341320658e24 100644
--- a/flang/lib/Evaluate/expression.cpp
+++ b/flang/lib/Evaluate/expression.cpp
@@ -23,14 +23,13 @@ using namespace Fortran::parser::literals;
namespace Fortran::evaluate {
-template <int KIND>
std::optional<Expr<SubscriptInteger>>
-Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
+Expr<Type<TypeCategory::Character>>::LEN() const {
using T = std::optional<Expr<SubscriptInteger>>;
return common::visit(
common::visitors{
[](const Constant<Result> &c) -> T {
- return AsExpr(Constant<SubscriptInteger>{c.LEN()});
+ return MakeSubscriptIntExpr(c.LEN());
},
[](const ArrayConstructor<Result> &a) -> T {
if (const auto *len{a.LEN()}) {
@@ -44,7 +43,7 @@ Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
return common::visit(
[&](const auto &kx) { return kx.LEN(); }, x.left().u);
},
- [](const Concat<KIND> &c) -> T {
+ [](const Concat &c) -> T {
if (auto llen{c.left().LEN()}) {
if (auto rlen{c.right().LEN()}) {
return *std::move(llen) + *std::move(rlen);
@@ -73,7 +72,7 @@ Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
},
[](const Designator<Result> &dr) { return dr.LEN(); },
[](const FunctionRef<Result> &fr) { return fr.LEN(); },
- [](const SetLength<KIND> &x) -> T { return x.right(); },
+ [](const SetLength &x) -> T { return x.right(); },
},
u);
}
@@ -92,10 +91,16 @@ const typename ExpressionBase<A>::Derived &ExpressionBase<A>::derived() const {
}
#endif
+template <typename A> int ExpressionBase<A>::kind() const {
+ // Storing/deriving the kind handled by the subclasses
+ return common::visit(
+ [&](const auto &x) -> int { return x.kind(); }, derived().u);
+}
+
template <typename A>
std::optional<DynamicType> ExpressionBase<A>::GetType() const {
if constexpr (IsLengthlessIntrinsicType<Result>) {
- return Result::GetType();
+ return DynamicType{Result::category, kind()};
} else {
return common::visit(
[&](const auto &x) -> std::optional<DynamicType> {
@@ -154,8 +159,7 @@ bool ConditionalExpr<A>::operator==(const ConditionalExpr &that) const {
elseValue_ == that.elseValue_;
}
-template <int KIND>
-bool LogicalOperation<KIND>::operator==(const LogicalOperation &that) const {
+bool LogicalOperation::operator==(const LogicalOperation &that) const {
return logicalOperator == that.logicalOperator && Base::operator==(that);
}
@@ -191,15 +195,13 @@ bool ArrayConstructorValues<R>::operator==(
return values_ == that.values_;
}
-template <int KIND>
-auto ArrayConstructor<Type<TypeCategory::Character, KIND>>::set_LEN(
+auto ArrayConstructor<Type<TypeCategory::Character>>::set_LEN(
Expr<SubscriptInteger> &&len) -> ArrayConstructor & {
length_.emplace(std::move(len));
return *this;
}
-template <int KIND>
-bool ArrayConstructor<Type<TypeCategory::Character, KIND>>::operator==(
+bool ArrayConstructor<Type<TypeCategory::Character>>::operator==(
const ArrayConstructor &that) const {
return length_ == that.length_ &&
static_cast<const Base &>(*this) == static_cast<const Base &>(that);
@@ -224,39 +226,33 @@ bool StructureConstructor::operator==(const StructureConstructor &that) const {
return result_ == that.result_ && values_ == that.values_;
}
-template <int KIND>
-bool Expr<Type<TypeCategory::Integer, KIND>>::operator==(
- const Expr<Type<TypeCategory::Integer, KIND>> &that) const {
+bool Expr<Type<TypeCategory::Integer>>::operator==(
+ const Expr<Type<TypeCategory::Integer>> &that) const {
return u == that.u;
}
-template <int KIND>
-bool Expr<Type<TypeCategory::Real, KIND>>::operator==(
- const Expr<Type<TypeCategory::Real, KIND>> &that) const {
+bool Expr<Type<TypeCategory::Real>>::operator==(
+ const Expr<Type<TypeCategory::Real>> &that) const {
return u == that.u;
}
-template <int KIND>
-bool Expr<Type<TypeCategory::Complex, KIND>>::operator==(
- const Expr<Type<TypeCategory::Complex, KIND>> &that) const {
+bool Expr<Type<TypeCategory::Complex>>::operator==(
+ const Expr<Type<TypeCategory::Complex>> &that) const {
return u == that.u;
}
-template <int KIND>
-bool Expr<Type<TypeCategory::Logical, KIND>>::operator==(
- const Expr<Type<TypeCategory::Logical, KIND>> &that) const {
+bool Expr<Type<TypeCategory::Logical>>::operator==(
+ const Expr<Type<TypeCategory::Logical>> &that) const {
return u == that.u;
}
-template <int KIND>
-bool Expr<Type<TypeCategory::Character, KIND>>::operator==(
- const Expr<Type<TypeCategory::Character, KIND>> &that) const {
+bool Expr<Type<TypeCategory::Character>>::operator==(
+ const Expr<Type<TypeCategory::Character>> &that) const {
return u == that.u;
}
-template <int KIND>
-bool Expr<Type<TypeCategory::Unsigned, KIND>>::operator==(
- const Expr<Type<TypeCategory::Unsigned, KIND>> &that) const {
+bool Expr<Type<TypeCategory::Unsigned>>::operator==(
+ const Expr<Type<TypeCategory::Unsigned>> &that) const {
return u == that.u;
}
@@ -366,20 +362,51 @@ void GenericAssignmentWrapper::Deleter(GenericAssignmentWrapper *p) {
delete p;
}
-template <TypeCategory CAT> int Expr<SomeKind<CAT>>::GetKind() const {
- return common::visit(
- [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; },
- u);
+std::optional<Expr<SubscriptInteger>> Expr<SomeCharacter>::LEN() const {
+ return common::visit([](const auto &kx) { return kx.LEN(); }, u);
}
-int Expr<SomeCharacter>::GetKind() const {
- return common::visit(
- [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; },
- u);
+Parentheses<SomeDerived>::Parentheses(const Expr<SomeDerived> &x)
+ : Base{x.kind(), x} {}
+Parentheses<SomeDerived>::Parentheses(Expr<SomeDerived> &&x)
+ : Base{x.kind(), std::move(x)} {}
+
+ComplexComponent::ComplexComponent(bool isImaginary, const Expr<Operand> &x)
+ : Base{x.kind(), x}, isImaginaryPart{isImaginary} {}
+ComplexComponent::ComplexComponent(bool isImaginary, Expr<Operand> &&x)
+ : Base{x.kind(), std::move(x)}, isImaginaryPart{isImaginary} {}
+
+ComplexConstructor::ComplexConstructor(const Expr<Type<TypeCategory::Real>> &re,
+ const Expr<Type<TypeCategory::Real>> &im)
+ : Base{re.kind(), re, im} {
+ CHECK(re.kind() == im.kind());
+}
+ComplexConstructor::ComplexConstructor(
+ Expr<Type<TypeCategory::Real>> &&re, Expr<Type<TypeCategory::Real>> &&im)
+ : Base{re.kind(), std::move(re), std::move(im)} {
+ CHECK(left().kind() == right().kind());
}
-std::optional<Expr<SubscriptInteger>> Expr<SomeCharacter>::LEN() const {
- return common::visit([](const auto &kx) { return kx.LEN(); }, u);
+LogicalOperation::LogicalOperation(
+ LogicalOperator opr, const Expr<Operand> &x, const Expr<Operand> &y)
+ : Base{x.kind(), x, y}, logicalOperator{opr} {
+ CHECK(x.kind() == y.kind());
+}
+LogicalOperation::LogicalOperation(
+ LogicalOperator opr, Expr<Operand> &&x, Expr<Operand> &&y)
+ : Base{x.kind(), std::move(x), std::move(y)}, logicalOperator{opr} {
+ CHECK(x.kind() == y.kind());
+}
+
+Concat::Concat(const Expr<Type<TypeCategory::Character>> &x,
+ const Expr<Type<TypeCategory::Character>> &y)
+ : Base{x.kind(), x, y} {
+ CHECK(x.kind() == y.kind());
+}
+Concat::Concat(Expr<Type<TypeCategory::Character>> &&x,
+ Expr<Type<TypeCategory::Character>> &&y)
+ : Base{x.kind(), std::move(x), std::move(y)} {
+ CHECK(left().kind() == right().kind());
}
#ifdef _MSC_VER // disable bogus warning about missing definitions
diff --git a/flang/lib/Evaluate/fold-character.cpp b/flang/lib/Evaluate/fold-character.cpp
index a43742ae8dc68..0a23c91df0654 100644
--- a/flang/lib/Evaluate/fold-character.cpp
+++ b/flang/lib/Evaluate/fold-character.cpp
@@ -36,65 +36,66 @@ template <typename T>
static std::optional<Scalar<T>> Identity(
Scalar<T> str, std::optional<ConstantSubscript> len) {
if (len) {
- return CharacterUtils<T::kind>::REPEAT(
- str, std::max<ConstantSubscript>(*len, 0));
+ return CharacterUtils::REPEAT(str, std::max<ConstantSubscript>(*len, 0));
} else {
return std::nullopt;
}
}
-template <int KIND>
-Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction(
+Expr<Type<TypeCategory::Character>> FoldIntrinsicFunction(
FoldingContext &context,
- FunctionRef<Type<TypeCategory::Character, KIND>> &&funcRef) {
- using T = Type<TypeCategory::Character, KIND>;
- using StringType = Scalar<T>; // std::string or larger
- using SingleCharType = typename StringType::value_type; // char &c.
+ FunctionRef<Type<TypeCategory::Character>> &&funcRef) {
+ using T = Type<TypeCategory::Character>;
+ using StringType = Scalar<T>; // CharacterValue
+ const int kind{funcRef.kind()};
auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
CHECK(intrinsic);
std::string name{intrinsic->name};
if (name == "achar" || name == "char") {
using IntT = SubscriptInteger;
- return FoldElementalIntrinsic<T, IntT>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, IntT>(kind, {SubscriptIntegerKind},
+ context, std::move(funcRef),
ScalarFunc<T, IntT>([&](const Scalar<IntT> &i) {
- if (i.IsNegative() || i.BGE(Scalar<IntT>{0}.IBSET(8 * KIND))) {
+ if (i.IsNegative() ||
+ i.BGE(Scalar<IntT>{SubscriptIntegerKind, 0}.IBSET(8 * kind))) {
context.Warn(common::UsageWarning::FoldingValueChecks,
"%s(I=%jd) is out of range for CHARACTER(KIND=%d)"_warn_en_US,
parser::ToUpperCaseLetters(name),
- static_cast<std::intmax_t>(i.ToInt64()), KIND);
+ static_cast<std::intmax_t>(i.ToInt64()), kind);
}
- return CharacterUtils<KIND>::CHAR(i.ToUInt64());
+ return CharacterUtils::CHAR(kind, i.ToUInt64());
}));
} else if (name == "adjustl") {
return FoldElementalIntrinsic<T, T>(
- context, std::move(funcRef), CharacterUtils<KIND>::ADJUSTL);
+ kind, {kind}, context, std::move(funcRef), CharacterUtils::ADJUSTL);
} else if (name == "adjustr") {
return FoldElementalIntrinsic<T, T>(
- context, std::move(funcRef), CharacterUtils<KIND>::ADJUSTR);
+ kind, {kind}, context, std::move(funcRef), CharacterUtils::ADJUSTR);
} else if (name == "max") {
return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
} else if (name == "maxval") {
- SingleCharType least{0};
- if (auto identity{Identity<T>(
- StringType{least}, GetConstantLength(context, funcRef, 0))}) {
+ StringType least{kind, 1, '\0'};
+ if (auto identity{
+ Identity<T>(least, GetConstantLength(context, funcRef, 0))}) {
return FoldMaxvalMinval<T>(
- context, std::move(funcRef), RelationalOperator::GT, *identity);
+ kind, context, std::move(funcRef), RelationalOperator::GT, *identity);
}
} else if (name == "min") {
return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
} else if (name == "minval") {
// Collating sequences correspond to positive integers (3.31)
- auto most{static_cast<SingleCharType>(0xffffffff >> (8 * (4 - KIND)))};
- if (auto identity{Identity<T>(
- StringType{most}, GetConstantLength(context, funcRef, 0))}) {
+ StringType most{kind, 1, 0xffffffff >> (8 * (4 - kind))};
+ if (auto identity{
+ Identity<T>(most, GetConstantLength(context, funcRef, 0))}) {
return FoldMaxvalMinval<T>(
- context, std::move(funcRef), RelationalOperator::LT, *identity);
+ kind, context, std::move(funcRef), RelationalOperator::LT, *identity);
}
} else if (name == "new_line") {
- return Expr<T>{Constant<T>{CharacterUtils<KIND>::NEW_LINE()}};
+ return MakeConstantExpr<T>(kind, CharacterUtils::NEW_LINE(kind));
} else if (name == "repeat") { // not elemental
if (auto scalars{GetScalarConstantArguments<T, SubscriptInteger>(
- context, funcRef.arguments(), /*hasOptionalArgument=*/false)}) {
+ {kind, SubscriptIntegerKind}, context, funcRef.arguments(),
+ /*hasOptionalArgument=*/false)}) {
auto str{std::get<Scalar<T>>(*scalars)};
auto n{std::get<Scalar<SubscriptInteger>>(*scalars).ToInt64()};
if (n < 0) {
@@ -107,45 +108,45 @@ Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction(
"Result of REPEAT() is too large to compute at compilation time (%g characters)"_port_en_US,
static_cast<double>(n) * str.size());
} else {
- return Expr<T>{Constant<T>{CharacterUtils<KIND>::REPEAT(str, n)}};
+ return MakeConstantExpr<T>(kind, CharacterUtils::REPEAT(str, n));
}
}
} else if (name == "trim") { // not elemental
- if (auto scalar{GetScalarConstantArguments<T>(
- context, funcRef.arguments(), /*hasOptionalArgument=*/false)}) {
- return Expr<T>{Constant<T>{
- CharacterUtils<KIND>::TRIM(std::get<Scalar<T>>(*scalar))}};
+ if (auto scalar{GetScalarConstantArguments<T>({kind}, context,
+ funcRef.arguments(), /*hasOptionalArgument=*/false)}) {
+ return MakeConstantExpr<T>(
+ kind, CharacterUtils::TRIM(std::get<Scalar<T>>(*scalar)));
}
} else if (name == "__builtin_compiler_options") {
auto &o = context.targetCharacteristics().compilerOptionsString();
- return Expr<T>{Constant<T>{StringType(o.begin(), o.end())}};
+ return MakeConstantExpr<T>(kind, o);
} else if (name == "__builtin_compiler_version") {
auto &v = context.targetCharacteristics().compilerVersionString();
- return Expr<T>{Constant<T>{StringType(v.begin(), v.end())}};
+ return MakeConstantExpr<T>(kind, v);
}
return Expr<T>{std::move(funcRef)};
}
-template <int KIND>
-Expr<Type<TypeCategory::Character, KIND>> FoldOperation(
- FoldingContext &context, Concat<KIND> &&x) {
+Expr<Type<TypeCategory::Character>> FoldOperation(
+ FoldingContext &context, Concat &&x) {
+ const int kind{x.kind()};
if (auto array{ApplyElementwise(context, x)}) {
return *array;
}
- using Result = Type<TypeCategory::Character, KIND>;
+ using Result = Type<TypeCategory::Character>;
if (auto folded{OperandsAreConstants(x)}) {
- return Expr<Result>{Constant<Result>{folded->first + folded->second}};
+ return MakeConstantExpr<Result>(kind, folded->first + folded->second);
}
return Expr<Result>{std::move(x)};
}
-template <int KIND>
-Expr<Type<TypeCategory::Character, KIND>> FoldOperation(
- FoldingContext &context, SetLength<KIND> &&x) {
+Expr<Type<TypeCategory::Character>> FoldOperation(
+ FoldingContext &context, SetLength &&x) {
+ const int kind{x.kind()};
if (auto array{ApplyElementwise(context, x)}) {
return *array;
}
- using Result = Type<TypeCategory::Character, KIND>;
+ using Result = Type<TypeCategory::Character>;
if (auto folded{OperandsAreConstants(x)}) {
auto oldLength{static_cast<ConstantSubscript>(folded->first.size())};
auto newLength{folded->second.ToInt64()};
@@ -155,7 +156,7 @@ Expr<Type<TypeCategory::Character, KIND>> FoldOperation(
folded->first.append(newLength - oldLength, ' ');
}
CHECK(static_cast<ConstantSubscript>(folded->first.size()) == newLength);
- return Expr<Result>{Constant<Result>{std::move(folded->first)}};
+ return MakeConstantExpr<Result>(kind, std::move(folded->first));
}
return Expr<Result>{std::move(x)};
}
diff --git a/flang/lib/Evaluate/fold-complex.cpp b/flang/lib/Evaluate/fold-complex.cpp
index 84066ee5be71b..fda86906d7fb4 100644
--- a/flang/lib/Evaluate/fold-complex.cpp
+++ b/flang/lib/Evaluate/fold-complex.cpp
@@ -12,11 +12,10 @@
namespace Fortran::evaluate {
-template <int KIND>
-Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction(
- FoldingContext &context,
- FunctionRef<Type<TypeCategory::Complex, KIND>> &&funcRef) {
- using T = Type<TypeCategory::Complex, KIND>;
+Expr<Type<TypeCategory::Complex>> FoldIntrinsicFunction(FoldingContext &context,
+ FunctionRef<Type<TypeCategory::Complex>> &&funcRef) {
+ const int kind{funcRef.kind()};
+ using T = Type<TypeCategory::Complex>;
using Part = typename T::Part;
ActualArguments &args{funcRef.arguments()};
auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
@@ -26,22 +25,22 @@ Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction(
name == "atan" || name == "atanh" || name == "cos" || name == "cosh" ||
name == "exp" || name == "log" || name == "sin" || name == "sinh" ||
name == "sqrt" || name == "tan" || name == "tanh") {
- if (auto callable{GetHostRuntimeWrapper<T, T>(name)}) {
+ if (auto callable{GetHostRuntimeWrapper<T, T>(kind, {kind}, name)}) {
return FoldElementalIntrinsic<T, T>(
- context, std::move(funcRef), *callable);
+ kind, {kind}, context, std::move(funcRef), *callable);
} else {
context.Warn(common::UsageWarning::FoldingFailure,
"%s(complex(kind=%d)) cannot be folded on host"_warn_en_US, name,
- KIND);
+ kind);
}
} else if (name == "conjg") {
return FoldElementalIntrinsic<T, T>(
- context, std::move(funcRef), &Scalar<T>::CONJG);
+ kind, {kind}, context, std::move(funcRef), &Scalar<T>::CONJG);
} else if (name == "cmplx") {
if (args.size() > 0 && args[0].has_value()) {
if (auto *x{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
// CMPLX(X [, KIND]) with complex X
- return Fold(context, ConvertToType<T>(std::move(*x)));
+ return Fold(context, ConvertToType<T>(kind, std::move(*x)));
} else {
if (args.size() >= 2 && args[1].has_value()) {
// Do not fold CMPLX with an Y argument that may be absent at runtime
@@ -56,11 +55,11 @@ Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction(
Expr<SomeType> re{std::move(*args[0].value().UnwrapExpr())};
Expr<SomeType> im{args.size() >= 2 && args[1].has_value()
? std::move(*args[1]->UnwrapExpr())
- : AsGenericExpr(Constant<Part>{Scalar<Part>{}})};
+ : AsGenericExpr(MakeZeroExpr<Part>(kind))};
return Fold(context,
Expr<T>{
- ComplexConstructor<KIND>{ToReal<KIND>(context, std::move(re)),
- ToReal<KIND>(context, std::move(im))}});
+ ComplexConstructor{kind, ToReal(kind, context, std::move(re)),
+ ToReal(kind, context, std::move(im))}});
}
}
} else if (name == "dot_product") {
@@ -68,7 +67,7 @@ Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction(
} else if (name == "matmul") {
return FoldMatmul(context, std::move(funcRef));
} else if (name == "product") {
- auto one{Scalar<Part>::FromInteger(value::Integer<8>{1}).value};
+ auto one{Scalar<Part>::FromInteger(kind, value::IntegerValue{1, 1}).value};
return FoldProduct<T>(context, std::move(funcRef), Scalar<T>{one});
} else if (name == "sum") {
return FoldSum<T>(context, std::move(funcRef));
@@ -76,17 +75,17 @@ Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction(
return Expr<T>{std::move(funcRef)};
}
-template <int KIND>
-Expr<Type<TypeCategory::Complex, KIND>> FoldOperation(
- FoldingContext &context, ComplexConstructor<KIND> &&x) {
+Expr<Type<TypeCategory::Complex>> FoldOperation(
+ FoldingContext &context, ComplexConstructor &&x) {
+ const int kind{x.kind()};
if (auto array{ApplyElementwise(context, x)}) {
return *array;
}
- using ComplexType = Type<TypeCategory::Complex, KIND>;
+ using ComplexType = Type<TypeCategory::Complex>;
if (auto folded{OperandsAreConstants(x)}) {
using RealType = typename ComplexType::Part;
Constant<ComplexType> result{
- Scalar<ComplexType>{folded->first, folded->second}};
+ kind, Scalar<ComplexType>{folded->first, folded->second}};
if (const auto *re{UnwrapConstantValue<RealType>(x.left())};
re && re->result().isFromInexactLiteralConversion()) {
result.result().set_isFromInexactLiteralConversion();
diff --git a/flang/lib/Evaluate/fold-designator.cpp b/flang/lib/Evaluate/fold-designator.cpp
index d7751ec389917..4e0cc1b841194 100644
--- a/flang/lib/Evaluate/fold-designator.cpp
+++ b/flang/lib/Evaluate/fold-designator.cpp
@@ -98,9 +98,11 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
},
[&](const Triplet &triplet) {
auto start{ToInt64(Fold(context_,
- triplet.lower().value_or(ExtentExpr{lower})))};
+ triplet.lower().value_or(
+ MakeExtentExpr(lower))))};
auto end{ToInt64(Fold(context_,
- triplet.upper().value_or(ExtentExpr{upper})))};
+ triplet.upper().value_or(
+ MakeExtentExpr(upper))))};
auto step{ToInt64(Fold(context_, triplet.stride()))};
if (start && end && step) {
if (*step != 0) {
@@ -237,11 +239,11 @@ static std::optional<ArrayRef> OffsetToArrayRef(FoldingContext &context,
}
auto quotient{at / extent};
auto remainder{at - quotient * extent};
- subscripts.emplace_back(ExtentExpr{(*lower)[dim] + remainder});
+ subscripts.emplace_back(MakeExtentExpr((*lower)[dim] + remainder));
at = quotient;
}
// This final subscript might be out of range for use in error reporting.
- subscripts.emplace_back(ExtentExpr{(*lower)[rank - 1] + at});
+ subscripts.emplace_back(MakeExtentExpr((*lower)[rank - 1] + at));
offset -= element * static_cast<std::size_t>(*elementBytes);
return ArrayRef{std::move(entity), std::move(subscripts)};
}
@@ -338,8 +340,10 @@ std::optional<Expr<SomeType>> OffsetToDesignator(FoldingContext &context,
return common::visit(
[&](const auto &z) -> std::optional<Expr<SomeType>> {
using PartType = typename ResultType<decltype(z)>::Part;
- return AsGenericExpr(Designator<PartType>{ComplexPart{
- ExtractDataRef(std::move(*zExpr)).value(), part}});
+ const int kind{z.kind()};
+ return AsGenericExpr(Designator<PartType>{kind,
+ ComplexPart{
+ ExtractDataRef(std::move(*zExpr)).value(), part}});
},
zExpr->u);
}
@@ -350,12 +354,12 @@ std::optional<Expr<SomeType>> OffsetToDesignator(FoldingContext &context,
return common::visit(
[&](const auto &x) -> std::optional<Expr<SomeType>> {
using T = typename std::decay_t<decltype(x)>::Result;
- return AsGenericExpr(Designator<T>{
+ const int kind{x.kind()};
+ return AsGenericExpr(Designator<T>{kind,
Substring{ExtractDataRef(std::move(*cExpr)).value(),
- std::optional<Expr<SubscriptInteger>>{
- 1 + (offset / T::kind)},
- std::optional<Expr<SubscriptInteger>>{
- 1 + ((offset + size - 1) / T::kind)}}});
+ MakeSubscriptIntExpr(1 + (offset / kind)),
+ MakeSubscriptIntExpr(
+ 1 + ((offset + size - 1) / kind))}});
},
cExpr->u);
}
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index 467bc6f0f7005..f694a826a2496 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -31,6 +31,7 @@
#include "flang/Semantics/symbol.h"
#include "flang/Semantics/tools.h"
#include <algorithm>
+#include <array>
#include <cmath>
#include <cstdio>
#include <optional>
@@ -52,8 +53,13 @@ static constexpr bool useKahanSummation{false};
// Utilities
template <typename T> class Folder {
public:
+ explicit Folder(int kind, FoldingContext &c, bool forOptionalArgument = false)
+ : kind_{kind}, context_{c}, forOptionalArgument_{forOptionalArgument} {}
+ template <typename U = T,
+ typename = std::enable_if_t<std::is_same_v<U, SomeDerived>>>
explicit Folder(FoldingContext &c, bool forOptionalArgument = false)
- : context_{c}, forOptionalArgument_{forOptionalArgument} {}
+ : Folder(0, c, forOptionalArgument) {}
+
std::optional<Constant<T>> GetNamedConstant(const Symbol &);
std::optional<Constant<T>> ApplySubscripts(const Constant<T> &array,
const std::vector<Constant<SubscriptInteger>> &subscripts);
@@ -79,6 +85,7 @@ template <typename T> class Folder {
Expr<T> TRANSFER(FunctionRef<T> &&);
private:
+ int kind_;
FoldingContext &context_;
bool forOptionalArgument_{false};
};
@@ -86,16 +93,18 @@ template <typename T> class Folder {
std::optional<Constant<SubscriptInteger>> GetConstantSubscript(
FoldingContext &, Subscript &, const NamedEntity &, int dim);
-// Helper to use host runtime on scalars for folding.
-template <typename TR, typename... TA>
-std::optional<std::function<Scalar<TR>(FoldingContext &, Scalar<TA>...)>>
-GetHostRuntimeWrapper(const std::string &name) {
- std::vector<DynamicType> argTypes{TA{}.GetType()...};
- if (auto hostWrapper{GetHostRuntimeWrapper(name, TR{}.GetType(), argTypes)}) {
- return [hostWrapper](
+template <typename TR, typename... TA, std::size_t... I>
+static std::optional<std::function<Scalar<TR>(FoldingContext &, Scalar<TA>...)>>
+GetHostRuntimeWrapperHelper(int resultKind,
+ std::array<int, sizeof...(TA)> argKinds, const std::string &name,
+ std::index_sequence<I...>) {
+ std::vector<DynamicType> argTypes{DynamicType{TA::category, argKinds[I]}...};
+ if (auto hostWrapper{GetHostRuntimeWrapper(
+ name, DynamicType{TR::category, resultKind}, argTypes)}) {
+ return [hostWrapper, argKinds](
FoldingContext &context, Scalar<TA>... args) -> Scalar<TR> {
std::vector<Expr<SomeType>> genericArgs{
- AsGenericExpr(Constant<TA>{args})...};
+ AsGenericExpr(Constant<TA>{argKinds[I], args})...};
return GetScalarConstantValue<TR>(
(*hostWrapper)(context, std::move(genericArgs)))
.value();
@@ -104,6 +113,15 @@ GetHostRuntimeWrapper(const std::string &name) {
return std::nullopt;
}
+// Helper to use host runtime on scalars for folding.
+template <typename TR, typename... TA>
+static std::optional<std::function<Scalar<TR>(FoldingContext &, Scalar<TA>...)>>
+GetHostRuntimeWrapper(int resultKind, std::array<int, sizeof...(TA)> argKinds,
+ const std::string &name) {
+ return GetHostRuntimeWrapperHelper<TR, TA...>(
+ resultKind, argKinds, name, std::index_sequence_for<TA...>{});
+}
+
// FoldOperation() rewrites expression tree nodes.
// If there is any possibility that the rewritten node will
// not have the same representation type, the result of
@@ -119,6 +137,11 @@ common::IfNoLvalue<Expr<ResultType<A>>, A> FoldOperation(
return Expr<ResultType<A>>{std::move(x)};
}
+// Forward declarations needed to ensure overload lookup considers all possible
+// implementations.
+ComplexPart FoldOperation(FoldingContext &, ComplexPart &&);
+Expr<Type<TypeCategory::Complex>> FoldOperation(
+ FoldingContext &, ComplexConstructor &&);
Component FoldOperation(FoldingContext &, Component &&);
NamedEntity FoldOperation(FoldingContext &, NamedEntity &&);
Triplet FoldOperation(FoldingContext &, Triplet &&);
@@ -127,12 +150,12 @@ ArrayRef FoldOperation(FoldingContext &, ArrayRef &&);
CoarrayRef FoldOperation(FoldingContext &, CoarrayRef &&);
DataRef FoldOperation(FoldingContext &, DataRef &&);
Substring FoldOperation(FoldingContext &, Substring &&);
-ComplexPart FoldOperation(FoldingContext &, ComplexPart &&);
template <typename T>
Expr<T> FoldOperation(FoldingContext &, FunctionRef<T> &&);
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, Designator<T> &&designator) {
- return Folder<T>{context}.Folding(std::move(designator));
+ const int kind{designator.kind()};
+ return Folder<T>{kind, context}.Folding(std::move(designator));
}
Expr<TypeParamInquiry::Result> FoldOperation(
FoldingContext &, TypeParamInquiry &&);
@@ -203,6 +226,7 @@ std::optional<Constant<T>> Folder<T>::Folding(DataRef &ref) {
template <typename T>
std::optional<Constant<T>> Folder<T>::ApplySubscripts(const Constant<T> &array,
const std::vector<Constant<SubscriptInteger>> &subscripts) {
+ const int kind{array.kind()};
const auto &shape{array.shape()};
const auto &lbounds{array.lbounds()};
int rank{GetRank(shape)};
@@ -252,12 +276,14 @@ std::optional<Constant<T>> Folder<T>::ApplySubscripts(const Constant<T> &array,
CHECK(k == GetRank(resultShape));
}
if constexpr (T::category == TypeCategory::Character) {
- return Constant<T>{array.LEN(), std::move(values), std::move(resultShape)};
+ return Constant<T>{
+ kind, array.LEN(), std::move(values), std::move(resultShape)};
} else if constexpr (std::is_same_v<T, SomeDerived>) {
+ CHECK(kind == 0);
return Constant<T>{array.result().derivedTypeSpec(), std::move(values),
std::move(resultShape)};
} else {
- return Constant<T>{std::move(values), std::move(resultShape)};
+ return Constant<T>{kind, std::move(values), std::move(resultShape)};
}
}
@@ -291,9 +317,9 @@ std::optional<Constant<T>> Folder<T>::ApplyComponent(
// information is propagated to the array constructor.
auto *typedExpr{UnwrapExpr<Expr<T>>(expr.value())};
CHECK(typedExpr);
- array = std::make_unique<ArrayConstructor<T>>(*typedExpr);
+ array = std::make_unique<ArrayConstructor<T>>(kind_, *typedExpr);
if constexpr (T::category == TypeCategory::Character) {
- array->set_LEN(Expr<SubscriptInteger>{value->LEN()});
+ array->set_LEN(MakeSubscriptIntExpr(value->LEN()));
}
}
if (subscripts) {
@@ -349,6 +375,7 @@ std::optional<Constant<T>> Folder<T>::GetConstantComponent(Component &component,
}
template <typename T> Expr<T> Folder<T>::Folding(Designator<T> &&designator) {
+ const int kind{designator.kind()};
if constexpr (T::category == TypeCategory::Character) {
if (auto *substring{common::Unwrap<Substring>(designator.u)}) {
if (std::optional<Expr<SomeCharacter>> folded{
@@ -364,14 +391,14 @@ template <typename T> Expr<T> Folder<T>::Folding(Designator<T> &&designator) {
} else if constexpr (T::category == TypeCategory::Real) {
if (auto *zPart{std::get_if<ComplexPart>(&designator.u)}) {
*zPart = FoldOperation(context_, std::move(*zPart));
- using ComplexT = Type<TypeCategory::Complex, T::kind>;
- if (auto zConst{Folder<ComplexT>{context_}.Folding(zPart->complex())}) {
+ using ComplexT = Type<TypeCategory::Complex>;
+ if (auto zConst{
+ Folder<ComplexT>{kind, context_}.Folding(zPart->complex())}) {
return Fold(context_,
- Expr<T>{ComplexComponent<T::kind>{
- zPart->part() == ComplexPart::Part::IM,
+ Expr<T>{ComplexComponent{zPart->part() == ComplexPart::Part::IM,
Expr<ComplexT>{std::move(*zConst)}}});
} else {
- return Expr<T>{Designator<T>{std::move(*zPart)}};
+ return Expr<T>{Designator<T>{kind, std::move(*zPart)}};
}
}
}
@@ -383,25 +410,25 @@ template <typename T> Expr<T> Folder<T>::Folding(Designator<T> &&designator) {
}
return Expr<T>{std::move(designator)};
},
- [&](ArrayRef &&aRef) {
+ [&, kind](ArrayRef &&aRef) {
aRef = FoldOperation(context_, std::move(aRef));
if (auto c{Folding(aRef)}) {
return Expr<T>{std::move(*c)};
} else {
- return Expr<T>{Designator<T>{std::move(aRef)}};
+ return Expr<T>{Designator<T>{kind, std::move(aRef)}};
}
},
- [&](Component &&component) {
+ [&, kind](Component &&component) {
component = FoldOperation(context_, std::move(component));
if (auto c{GetConstantComponent(component)}) {
return Expr<T>{std::move(*c)};
} else {
- return Expr<T>{Designator<T>{std::move(component)}};
+ return Expr<T>{Designator<T>{kind, std::move(component)}};
}
},
- [&](auto &&x) {
+ [&, kind](auto &&x) {
return Expr<T>{
- Designator<T>{FoldOperation(context_, std::move(x))}};
+ Designator<T>{kind, FoldOperation(context_, std::move(x))}};
},
},
std::move(designator.u));
@@ -414,15 +441,15 @@ Constant<T> *Folder<T>::Folding(std::optional<ActualArgument> &arg) {
if (auto *expr{UnwrapExpr<Expr<SomeType>>(arg)}) {
*expr = Fold(context_, std::move(*expr));
if constexpr (T::category != TypeCategory::Derived) {
- if (!UnwrapExpr<Expr<T>>(*expr)) {
+ if (!UnwrapExpr<Expr<T>>(kind_, *expr)) {
if (const Symbol *
var{forOptionalArgument_
? UnwrapWholeSymbolOrComponentDataRef(*expr)
: nullptr};
var && (IsOptional(*var) || IsAllocatableOrObjectPointer(var))) {
// can't safely convert item that may not be present
- } else if (auto converted{
- ConvertToType(T::GetType(), std::move(*expr))}) {
+ } else if (auto converted{ConvertToType(
+ DynamicType{T::category, kind_}, std::move(*expr))}) {
*expr = Fold(context_, std::move(*converted));
}
}
@@ -434,11 +461,13 @@ Constant<T> *Folder<T>::Folding(std::optional<ActualArgument> &arg) {
template <typename... A, std::size_t... I>
std::optional<std::tuple<const Constant<A> *...>> GetConstantArgumentsHelper(
- FoldingContext &context, ActualArguments &arguments,
- bool hasOptionalArgument, std::index_sequence<I...>) {
+ const std::array<int, sizeof...(A)> &kinds, FoldingContext &context,
+ ActualArguments &arguments, bool hasOptionalArgument,
+ std::index_sequence<I...>) {
static_assert(sizeof...(A) > 0);
std::tuple<const Constant<A> *...> args{
- Folder<A>{context, hasOptionalArgument}.Folding(arguments.at(I))...};
+ Folder<A>{kinds[I], context, hasOptionalArgument}.Folding(
+ arguments.at(I))...};
if ((... && (std::get<I>(args)))) {
return args;
} else {
@@ -448,17 +477,19 @@ std::optional<std::tuple<const Constant<A> *...>> GetConstantArgumentsHelper(
template <typename... A>
std::optional<std::tuple<const Constant<A> *...>> GetConstantArguments(
- FoldingContext &context, ActualArguments &args, bool hasOptionalArgument) {
- return GetConstantArgumentsHelper<A...>(
- context, args, hasOptionalArgument, std::index_sequence_for<A...>{});
+ const std::array<int, sizeof...(A)> &kinds, FoldingContext &context,
+ ActualArguments &args, bool hasOptionalArgument) {
+ return GetConstantArgumentsHelper<A...>(kinds, context, args,
+ hasOptionalArgument, std::index_sequence_for<A...>{});
}
template <typename... A, std::size_t... I>
std::optional<std::tuple<Scalar<A>...>> GetScalarConstantArgumentsHelper(
- FoldingContext &context, ActualArguments &args, bool hasOptionalArgument,
+ const std::array<int, sizeof...(A)> &kinds, FoldingContext &context,
+ ActualArguments &args, bool hasOptionalArgument,
std::index_sequence<I...>) {
- if (auto constArgs{
- GetConstantArguments<A...>(context, args, hasOptionalArgument)}) {
+ if (auto constArgs{GetConstantArguments<A...>(
+ kinds, context, args, hasOptionalArgument)}) {
return std::tuple<Scalar<A>...>{
std::get<I>(*constArgs)->GetScalarValue().value()...};
} else {
@@ -468,9 +499,10 @@ std::optional<std::tuple<Scalar<A>...>> GetScalarConstantArgumentsHelper(
template <typename... A>
std::optional<std::tuple<Scalar<A>...>> GetScalarConstantArguments(
- FoldingContext &context, ActualArguments &args, bool hasOptionalArgument) {
- return GetScalarConstantArgumentsHelper<A...>(
- context, args, hasOptionalArgument, std::index_sequence_for<A...>{});
+ const std::array<int, sizeof...(A)> &kinds, FoldingContext &context,
+ ActualArguments &args, bool hasOptionalArgument) {
+ return GetScalarConstantArgumentsHelper<A...>(kinds, context, args,
+ hasOptionalArgument, std::index_sequence_for<A...>{});
}
// helpers to fold intrinsic function references
@@ -485,12 +517,15 @@ using ScalarFuncWithContext =
template <template <typename, typename...> typename WrapperType, typename TR,
typename... TA, std::size_t... I>
-Expr<TR> FoldElementalIntrinsicHelper(FoldingContext &context,
+Expr<TR> FoldElementalIntrinsicHelper(int resultKind,
+ const std::array<int, sizeof...(TA)> &argKinds, FoldingContext &context,
FunctionRef<TR> &&funcRef, WrapperType<TR, TA...> func,
bool hasOptionalArgument, std::index_sequence<I...>) {
+ CHECK(funcRef.kind() == resultKind);
+ std::array<int, sizeof...(TA)> kinds{argKinds[I]...};
if (std::optional<std::tuple<const Constant<TA> *...>> args{
GetConstantArguments<TA...>(
- context, funcRef.arguments(), hasOptionalArgument)}) {
+ kinds, context, funcRef.arguments(), hasOptionalArgument)}) {
// Compute the shape of the result based on shapes of arguments
ConstantSubscripts shape;
int rank{0};
@@ -543,7 +578,8 @@ Expr<TR> FoldElementalIntrinsicHelper(FoldingContext &context,
if constexpr (TR::category == TypeCategory::Character) {
auto len{static_cast<ConstantSubscript>(
results.empty() ? 0 : results[0].length())};
- return Expr<TR>{Constant<TR>{len, std::move(results), std::move(shape)}};
+ return Expr<TR>{
+ Constant<TR>{resultKind, len, std::move(results), std::move(shape)}};
} else if constexpr (TR::category == TypeCategory::Derived) {
if (!results.empty()) {
return Expr<TR>{rank == 0
@@ -552,27 +588,30 @@ Expr<TR> FoldElementalIntrinsicHelper(FoldingContext &context,
std::move(results), std::move(shape)}};
}
} else {
- return Expr<TR>{Constant<TR>{std::move(results), std::move(shape)}};
+ return Expr<TR>{
+ Constant<TR>{resultKind, std::move(results), std::move(shape)}};
}
}
return Expr<TR>{std::move(funcRef)};
}
template <typename TR, typename... TA>
-Expr<TR> FoldElementalIntrinsic(FoldingContext &context,
+Expr<TR> FoldElementalIntrinsic(int resultKind,
+ const std::array<int, sizeof...(TA)> &argKinds, FoldingContext &context,
FunctionRef<TR> &&funcRef, ScalarFunc<TR, TA...> func,
bool hasOptionalArgument = false) {
- return FoldElementalIntrinsicHelper<ScalarFunc, TR, TA...>(context,
- std::move(funcRef), func, hasOptionalArgument,
+ return FoldElementalIntrinsicHelper<ScalarFunc, TR, TA...>(resultKind,
+ argKinds, context, std::move(funcRef), func, hasOptionalArgument,
std::index_sequence_for<TA...>{});
}
template <typename TR, typename... TA>
-Expr<TR> FoldElementalIntrinsic(FoldingContext &context,
+Expr<TR> FoldElementalIntrinsic(int resultKind,
+ const std::array<int, sizeof...(TA)> &argKinds, FoldingContext &context,
FunctionRef<TR> &&funcRef, ScalarFuncWithContext<TR, TA...> func,
bool hasOptionalArgument = false) {
- return FoldElementalIntrinsicHelper<ScalarFuncWithContext, TR, TA...>(context,
- std::move(funcRef), func, hasOptionalArgument,
- std::index_sequence_for<TA...>{});
+ return FoldElementalIntrinsicHelper<ScalarFuncWithContext, TR, TA...>(
+ resultKind, argKinds, context, std::move(funcRef), func,
+ hasOptionalArgument, std::index_sequence_for<TA...>{});
}
std::optional<std::int64_t> GetInt64ArgOr(
@@ -606,13 +645,15 @@ std::optional<std::vector<A>> GetIntegerVector(const B &x) {
// This to prevent generating warnings over and over if the expression
// gets re-folded.
template <typename T> Expr<T> MakeInvalidIntrinsic(FunctionRef<T> &&funcRef) {
+ const int kind{funcRef.kind()};
SpecificIntrinsic invalid{std::get<SpecificIntrinsic>(funcRef.proc().u)};
invalid.name = IntrinsicProcTable::InvalidName;
- return Expr<T>{FunctionRef<T>{ProcedureDesignator{std::move(invalid)},
+ return Expr<T>{FunctionRef<T>{kind, ProcedureDesignator{std::move(invalid)},
ActualArguments{std::move(funcRef.arguments())}}};
}
template <typename T> Expr<T> Folder<T>::CSHIFT(FunctionRef<T> &&funcRef) {
+ const int kind{funcRef.kind()};
auto args{funcRef.arguments()};
CHECK(args.size() == 3);
const auto *array{UnwrapConstantValue<T>(args[0])};
@@ -622,7 +663,8 @@ template <typename T> Expr<T> Folder<T>::CSHIFT(FunctionRef<T> &&funcRef) {
return Expr<T>{std::move(funcRef)};
}
auto convertedShift{Fold(context_,
- ConvertToType<SubscriptInteger>(Expr<SomeInteger>{*shiftExpr}))};
+ ConvertToType<SubscriptInteger>(
+ SubscriptIntegerKind, Expr<SomeInteger>{*shiftExpr}))};
const auto *shift{UnwrapConstantValue<SubscriptInteger>(convertedShift)};
if (!shift) {
return Expr<T>{std::move(funcRef)};
@@ -683,7 +725,7 @@ template <typename T> Expr<T> Folder<T>::CSHIFT(FunctionRef<T> &&funcRef) {
array->IncrementSubscripts(arrayAt);
}
return Expr<T>{PackageConstant<T>(
- std::move(resultElements), *array, array->shape())};
+ kind, std::move(resultElements), *array, array->shape())};
}
}
// Invalid, prevent re-folding
@@ -691,6 +733,7 @@ template <typename T> Expr<T> Folder<T>::CSHIFT(FunctionRef<T> &&funcRef) {
}
template <typename T> Expr<T> Folder<T>::EOSHIFT(FunctionRef<T> &&funcRef) {
+ const int kind{funcRef.kind()};
auto args{funcRef.arguments()};
CHECK(args.size() == 4);
const auto *array{UnwrapConstantValue<T>(args[0])};
@@ -701,7 +744,8 @@ template <typename T> Expr<T> Folder<T>::EOSHIFT(FunctionRef<T> &&funcRef) {
}
// Apply type conversions to the shift= and boundary= arguments.
auto convertedShift{Fold(context_,
- ConvertToType<SubscriptInteger>(Expr<SomeInteger>{*shiftExpr}))};
+ ConvertToType<SubscriptInteger>(
+ SubscriptIntegerKind, Expr<SomeInteger>{*shiftExpr}))};
const auto *shift{UnwrapConstantValue<SubscriptInteger>(convertedShift)};
if (!shift) {
return Expr<T>{std::move(funcRef)};
@@ -804,11 +848,10 @@ template <typename T> Expr<T> Folder<T>::EOSHIFT(FunctionRef<T> &&funcRef) {
T::category == TypeCategory::Real ||
T::category == TypeCategory::Complex ||
T::category == TypeCategory::Logical) {
- resultElements.emplace_back();
+ resultElements.emplace_back(Scalar<T>::Zero(kind));
} else if constexpr (T::category == TypeCategory::Character) {
auto len{static_cast<std::size_t>(array->LEN())};
- typename Scalar<T>::value_type space{' '};
- resultElements.emplace_back(len, space);
+ resultElements.emplace_back(kind, len, ' ');
} else {
DIE("no derived type boundary");
}
@@ -816,7 +859,7 @@ template <typename T> Expr<T> Folder<T>::EOSHIFT(FunctionRef<T> &&funcRef) {
array->IncrementSubscripts(arrayAt);
}
return Expr<T>{PackageConstant<T>(
- std::move(resultElements), *array, array->shape())};
+ kind, std::move(resultElements), *array, array->shape())};
}
}
// Invalid, prevent re-folding
@@ -824,8 +867,9 @@ template <typename T> Expr<T> Folder<T>::EOSHIFT(FunctionRef<T> &&funcRef) {
}
template <typename T> Expr<T> Folder<T>::MERGE(FunctionRef<T> &&funcRef) {
- return FoldElementalIntrinsic<T, T, T, LogicalResult>(context_,
- std::move(funcRef),
+ const int kind{funcRef.kind()};
+ return FoldElementalIntrinsic<T, T, T, LogicalResult>(kind,
+ {kind, kind, LogicalResultKind}, context_, std::move(funcRef),
ScalarFunc<T, T, T, LogicalResult>(
[](const Scalar<T> &ifTrue, const Scalar<T> &ifFalse,
const Scalar<LogicalResult> &predicate) -> Scalar<T> {
@@ -834,12 +878,13 @@ template <typename T> Expr<T> Folder<T>::MERGE(FunctionRef<T> &&funcRef) {
}
template <typename T> Expr<T> Folder<T>::PACK(FunctionRef<T> &&funcRef) {
+ const int kind{funcRef.kind()};
auto args{funcRef.arguments()};
CHECK(args.size() == 3);
const auto *array{UnwrapConstantValue<T>(args[0])};
const auto *vector{UnwrapConstantValue<T>(args[2])};
auto convertedMask{Fold(context_,
- ConvertToType<LogicalResult>(
+ ConvertToType<LogicalResult>(LogicalResultKind,
Expr<SomeLogical>{DEREF(UnwrapExpr<Expr<SomeLogical>>(args[1]))}))};
const auto *mask{UnwrapConstantValue<LogicalResult>(convertedMask)};
if (!array || !mask || (args[2] && !vector)) {
@@ -893,7 +938,7 @@ template <typename T> Expr<T> Folder<T>::PACK(FunctionRef<T> &&funcRef) {
++vectorAt[0];
}
}
- return Expr<T>{PackageConstant<T>(std::move(resultElements), *array,
+ return Expr<T>{PackageConstant<T>(kind, std::move(resultElements), *array,
ConstantSubscripts{static_cast<ConstantSubscript>(resultSize)})};
}
@@ -1022,6 +1067,7 @@ template <typename T> Expr<T> Folder<T>::SPREAD(FunctionRef<T> &&funcRef) {
}
template <typename T> Expr<T> Folder<T>::TRANSPOSE(FunctionRef<T> &&funcRef) {
+ const int kind{funcRef.kind()};
auto args{funcRef.arguments()};
CHECK(args.size() == 1);
const auto *matrix{UnwrapConstantValue<T>(args[0])};
@@ -1040,15 +1086,17 @@ template <typename T> Expr<T> Folder<T>::TRANSPOSE(FunctionRef<T> &&funcRef) {
}
at = matrix->shape();
std::swap(at[0], at[1]);
- return Expr<T>{PackageConstant<T>(std::move(resultElements), *matrix, at)};
+ return Expr<T>{
+ PackageConstant<T>(kind, std::move(resultElements), *matrix, at)};
}
template <typename T> Expr<T> Folder<T>::UNPACK(FunctionRef<T> &&funcRef) {
+ const int kind{funcRef.kind()};
auto args{funcRef.arguments()};
CHECK(args.size() == 3);
const auto *vector{UnwrapConstantValue<T>(args[0])};
auto convertedMask{Fold(context_,
- ConvertToType<LogicalResult>(
+ ConvertToType<LogicalResult>(LogicalResultKind,
Expr<SomeLogical>{DEREF(UnwrapExpr<Expr<SomeLogical>>(args[1]))}))};
const auto *mask{UnwrapConstantValue<LogicalResult>(convertedMask)};
const auto *field{UnwrapConstantValue<T>(args[2])};
@@ -1089,8 +1137,8 @@ template <typename T> Expr<T> Folder<T>::UNPACK(FunctionRef<T> &&funcRef) {
mask->IncrementSubscripts(maskAt);
field->IncrementSubscripts(fieldAt);
}
- return Expr<T>{
- PackageConstant<T>(std::move(resultElements), *vector, mask->shape())};
+ return Expr<T>{PackageConstant<T>(
+ kind, std::move(resultElements), *vector, mask->shape())};
}
std::optional<Expr<SomeType>> FoldTransfer(
@@ -1109,6 +1157,7 @@ template <typename T> Expr<T> Folder<T>::TRANSFER(FunctionRef<T> &&funcRef) {
template <typename T>
Expr<T> FoldMINorMAX(
FoldingContext &context, FunctionRef<T> &&funcRef, Ordering order) {
+ const int kind{funcRef.kind()};
static_assert(T::category == TypeCategory::Integer ||
T::category == TypeCategory::Unsigned ||
T::category == TypeCategory::Real ||
@@ -1123,8 +1172,8 @@ Expr<T> FoldMINorMAX(
// optional arguments that may show up in 3rd + argument.
// - The code below only accepts more than 2 arguments if all the
// arguments are constant (and hence known to be present).
- // - ConvertExprToHLFIR can't currently handle Extremum<Character>
- // - Semantics doesn't currently generate Extremum<Character>
+ // - ConvertExprToHLFIR can't currently handle Extremum<CharacterValue>
+ // - Semantics doesn't currently generate Extremum<CharacterValue>
// The original code did the folding of arguments and the overall extremum
// operation in a single pass. This was shorter code-wise, but took me
// a while to tease out all the logic and was doing redundant work.
@@ -1141,7 +1190,7 @@ Expr<T> FoldMINorMAX(
bool extremumAnyway{nargs == 2 && T::category != TypeCategory::Character};
// 1a)Fold the first two arguments.
{
- Folder<T> folder{context, /*forOptionalArgument=*/false};
+ Folder<T> folder{kind, context, /*forOptionalArgument=*/false};
if (!folder.Folding(args[0])) {
allArgsConstant = false;
}
@@ -1151,7 +1200,7 @@ Expr<T> FoldMINorMAX(
}
// 1b) Fold any optional arguments.
if (nargs > 2) {
- Folder<T> folder{context, /*forOptionalArgument=*/true};
+ Folder<T> folder{kind, context, /*forOptionalArgument=*/true};
for (std::size_t i{2}; i < nargs; ++i) {
if (args[i]) {
if (!folder.Folding(args[i])) {
@@ -1224,9 +1273,11 @@ Expr<T> RewriteSpecificMINorMAX(
intrinsic.characteristics.value().functionResult.value().SetType(*resultType);
auto insertConversion{[&](const auto &x) -> Expr<T> {
using TR = ResultType<decltype(x)>;
+ const int kind{x.kind()};
FunctionRef<TR> maxRef{
- ProcedureDesignator{funcRef.proc()}, ActualArguments{args}};
- return Fold(context, ConvertToType<T>(AsCategoryExpr(std::move(maxRef))));
+ kind, ProcedureDesignator{funcRef.proc()}, ActualArguments{args}};
+ return Fold(
+ context, ConvertToType<T>(kind, AsCategoryExpr(std::move(maxRef))));
}};
if (auto *sx{UnwrapExpr<Expr<SomeReal>>(*resultTypeArg)}) {
return common::visit(insertConversion, sx->u);
@@ -1238,25 +1289,20 @@ Expr<T> RewriteSpecificMINorMAX(
}
// FoldIntrinsicFunction()
-template <int KIND>
-Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
- FoldingContext &context, FunctionRef<Type<TypeCategory::Integer, KIND>> &&);
-template <int KIND>
-Expr<Type<TypeCategory::Unsigned, KIND>> FoldIntrinsicFunction(
- FoldingContext &context,
- FunctionRef<Type<TypeCategory::Unsigned, KIND>> &&);
-template <int KIND>
-Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
- FoldingContext &context, FunctionRef<Type<TypeCategory::Real, KIND>> &&);
-template <int KIND>
-Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction(
- FoldingContext &context, FunctionRef<Type<TypeCategory::Complex, KIND>> &&);
-template <int KIND>
-Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
- FoldingContext &context, FunctionRef<Type<TypeCategory::Logical, KIND>> &&);
+Expr<Type<TypeCategory::Integer>> FoldIntrinsicFunction(
+ FoldingContext &context, FunctionRef<Type<TypeCategory::Integer>> &&);
+Expr<Type<TypeCategory::Unsigned>> FoldIntrinsicFunction(
+ FoldingContext &context, FunctionRef<Type<TypeCategory::Unsigned>> &&);
+Expr<Type<TypeCategory::Real>> FoldIntrinsicFunction(
+ FoldingContext &context, FunctionRef<Type<TypeCategory::Real>> &&);
+Expr<Type<TypeCategory::Complex>> FoldIntrinsicFunction(
+ FoldingContext &context, FunctionRef<Type<TypeCategory::Complex>> &&);
+Expr<Type<TypeCategory::Logical>> FoldIntrinsicFunction(
+ FoldingContext &context, FunctionRef<Type<TypeCategory::Logical>> &&);
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) {
+ const int kind{funcRef.kind()};
ActualArguments &args{funcRef.arguments()};
const auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
if (!intrinsic || intrinsic->name != "kind") {
@@ -1313,23 +1359,23 @@ Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) {
}
const std::string name{intrinsic->name};
if (name == "cshift") {
- return Folder<T>{context}.CSHIFT(std::move(funcRef));
+ return Folder<T>{kind, context}.CSHIFT(std::move(funcRef));
} else if (name == "eoshift") {
- return Folder<T>{context}.EOSHIFT(std::move(funcRef));
+ return Folder<T>{kind, context}.EOSHIFT(std::move(funcRef));
} else if (name == "merge") {
- return Folder<T>{context}.MERGE(std::move(funcRef));
+ return Folder<T>{kind, context}.MERGE(std::move(funcRef));
} else if (name == "pack") {
- return Folder<T>{context}.PACK(std::move(funcRef));
+ return Folder<T>{kind, context}.PACK(std::move(funcRef));
} else if (name == "reshape") {
- return Folder<T>{context}.RESHAPE(std::move(funcRef));
+ return Folder<T>{kind, context}.RESHAPE(std::move(funcRef));
} else if (name == "spread") {
- return Folder<T>{context}.SPREAD(std::move(funcRef));
+ return Folder<T>{kind, context}.SPREAD(std::move(funcRef));
} else if (name == "transfer") {
- return Folder<T>{context}.TRANSFER(std::move(funcRef));
+ return Folder<T>{kind, context}.TRANSFER(std::move(funcRef));
} else if (name == "transpose") {
- return Folder<T>{context}.TRANSPOSE(std::move(funcRef));
+ return Folder<T>{kind, context}.TRANSPOSE(std::move(funcRef));
} else if (name == "unpack") {
- return Folder<T>{context}.UNPACK(std::move(funcRef));
+ return Folder<T>{kind, context}.UNPACK(std::move(funcRef));
}
// TODO: extends_type_of, same_type_as
if constexpr (!std::is_same_v<T, SomeDerived>) {
@@ -1342,9 +1388,11 @@ Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) {
// Array constructor folding
template <typename T> class ArrayConstructorFolder {
public:
- explicit ArrayConstructorFolder(FoldingContext &c) : context_{c} {}
+ explicit ArrayConstructorFolder(int kind, FoldingContext &c)
+ : context_{c}, resultInfo_{kind} {}
Expr<T> FoldArray(ArrayConstructor<T> &&array) {
+ const int kind{array.kind()};
if constexpr (T::category == TypeCategory::Character) {
if (const auto *len{array.LEN()}) {
charLength_ = ToInt64(Fold(context_, common::Clone(*len)));
@@ -1355,16 +1403,23 @@ template <typename T> class ArrayConstructorFolder {
if (FoldArray(array)) {
auto n{static_cast<ConstantSubscript>(elements_.size())};
if constexpr (std::is_same_v<T, SomeDerived>) {
+ CHECK(kind == 0);
return Expr<T>{Constant<T>{array.GetType().GetDerivedTypeSpec(),
std::move(elements_), ConstantSubscripts{n}}};
} else if constexpr (T::category == TypeCategory::Character) {
if (charLength_) {
return Expr<T>{Constant<T>{
- *charLength_, std::move(elements_), ConstantSubscripts{n}}};
+ kind, *charLength_, std::move(elements_), ConstantSubscripts{n}}};
}
} else {
+ // resultInfo_ is default-constructed (kind 0) and only ever has its
+ // isFromInexactLiteralConversion flag set above; give it the actual
+ // runtime kind here so that the Constant's result_ carries a valid
+ // kind (kind_ is a public field of Type<CAT>, not a category with
+ // its own constructor call, so this preserves that flag).
+ assert(resultInfo_.kind() == kind);
return Expr<T>{Constant<T>{
- std::move(elements_), ConstantSubscripts{n}, resultInfo_}};
+ kind, std::move(elements_), ConstantSubscripts{n}, resultInfo_}};
}
}
return Expr<T>{std::move(array)};
@@ -1447,7 +1502,8 @@ template <typename T> class ArrayConstructorFolder {
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, ArrayConstructor<T> &&array) {
- return ArrayConstructorFolder<T>{context}.FoldArray(std::move(array));
+ const int kind{array.kind()};
+ return ArrayConstructorFolder<T>{kind, context}.FoldArray(std::move(array));
}
// Array operation elemental application: When all operands to an operation
@@ -1470,12 +1526,13 @@ bool ArrayConstructorIsFlat(const ArrayConstructorValues<T> &values) {
template <typename T>
std::optional<Expr<T>> AsFlatArrayConstructor(const Expr<T> &expr) {
+ const int kind{expr.kind()};
if (const auto *c{UnwrapConstantValue<T>(expr)}) {
- ArrayConstructor<T> result{expr};
+ ArrayConstructor<T> result{kind, expr};
if (!c->empty()) {
ConstantSubscripts at{c->lbounds()};
do {
- result.Push(Expr<T>{Constant<T>{c->At(at)}});
+ result.Push(MakeConstantExpr<T>(kind, c->At(at)));
} while (c->IncrementSubscripts(at));
}
return std::make_optional<Expr<T>>(std::move(result));
@@ -1543,11 +1600,11 @@ std::optional<Expr<T>> FromArrayConstructor(
// Unary case
template <typename RESULT, typename OPERAND>
-std::optional<Expr<RESULT>> MapOperation(FoldingContext &context,
+std::optional<Expr<RESULT>> MapOperation(int kind, FoldingContext &context,
std::function<Expr<RESULT>(Expr<OPERAND> &&)> &&f, const Shape &shape,
[[maybe_unused]] std::optional<Expr<SubscriptInteger>> &&length,
Expr<OPERAND> &&values) {
- ArrayConstructor<RESULT> result{values};
+ ArrayConstructor<RESULT> result{kind, values};
if constexpr (common::HasMember<OPERAND, AllIntrinsicCategoryTypes>) {
common::visit(
[&](auto &&kindExpr) {
@@ -1575,9 +1632,9 @@ std::optional<Expr<RESULT>> MapOperation(FoldingContext &context,
}
template <typename RESULT, typename A>
-ArrayConstructor<RESULT> ArrayConstructorFromMold(
- const A &prototype, std::optional<Expr<SubscriptInteger>> &&length) {
- ArrayConstructor<RESULT> result{prototype};
+ArrayConstructor<RESULT> ArrayConstructorFromMold(int kind, const A &prototype,
+ std::optional<Expr<SubscriptInteger>> &&length) {
+ ArrayConstructor<RESULT> result{kind, prototype};
if constexpr (RESULT::category == TypeCategory::Character) {
if (length) {
result.set_LEN(std::move(*length));
@@ -1610,12 +1667,13 @@ bool ShapesMatch(FoldingContext &context,
// array * array case
template <typename RESULT, typename LEFT, typename RIGHT>
-auto MapOperation(FoldingContext &context,
+auto MapOperation(int kind, FoldingContext &context,
std::function<Expr<RESULT>(Expr<LEFT> &&, Expr<RIGHT> &&)> &&f,
const Shape &shape, std::optional<Expr<SubscriptInteger>> &&length,
Expr<LEFT> &&leftValues, Expr<RIGHT> &&rightValues)
-> std::optional<Expr<RESULT>> {
- auto result{ArrayConstructorFromMold<RESULT>(leftValues, std::move(length))};
+ auto result{
+ ArrayConstructorFromMold<RESULT>(kind, leftValues, std::move(length))};
auto &leftArrConst{std::get<ArrayConstructor<LEFT>>(leftValues.u)};
if constexpr (common::HasMember<RIGHT, AllIntrinsicCategoryTypes>) {
bool mapped{common::visit(
@@ -1661,12 +1719,13 @@ auto MapOperation(FoldingContext &context,
// array * scalar case
template <typename RESULT, typename LEFT, typename RIGHT>
-auto MapOperation(FoldingContext &context,
+auto MapOperation(int kind, FoldingContext &context,
std::function<Expr<RESULT>(Expr<LEFT> &&, Expr<RIGHT> &&)> &&f,
const Shape &shape, std::optional<Expr<SubscriptInteger>> &&length,
Expr<LEFT> &&leftValues, const Expr<RIGHT> &rightScalar)
-> std::optional<Expr<RESULT>> {
- auto result{ArrayConstructorFromMold<RESULT>(leftValues, std::move(length))};
+ auto result{
+ ArrayConstructorFromMold<RESULT>(kind, leftValues, std::move(length))};
auto &leftArrConst{std::get<ArrayConstructor<LEFT>>(leftValues.u)};
for (auto &leftValue : leftArrConst) {
auto &leftScalar{std::get<Expr<LEFT>>(leftValue.u)};
@@ -1678,12 +1737,13 @@ auto MapOperation(FoldingContext &context,
// scalar * array case
template <typename RESULT, typename LEFT, typename RIGHT>
-auto MapOperation(FoldingContext &context,
+auto MapOperation(int kind, FoldingContext &context,
std::function<Expr<RESULT>(Expr<LEFT> &&, Expr<RIGHT> &&)> &&f,
const Shape &shape, std::optional<Expr<SubscriptInteger>> &&length,
const Expr<LEFT> &leftScalar, Expr<RIGHT> &&rightValues)
-> std::optional<Expr<RESULT>> {
- auto result{ArrayConstructorFromMold<RESULT>(leftScalar, std::move(length))};
+ auto result{
+ ArrayConstructorFromMold<RESULT>(kind, leftScalar, std::move(length))};
if constexpr (common::HasMember<RIGHT, AllIntrinsicCategoryTypes>) {
common::visit(
[&](auto &&kindExpr) {
@@ -1726,12 +1786,13 @@ auto ApplyElementwise(FoldingContext &context,
Operation<DERIVED, RESULT, OPERAND> &operation,
std::function<Expr<RESULT>(Expr<OPERAND> &&)> &&f)
-> std::optional<Expr<RESULT>> {
+ const int kind{operation.kind()};
auto &expr{operation.left()};
expr = Fold(context, std::move(expr));
if (expr.Rank() > 0) {
if (std::optional<Shape> shape{GetShape(context, expr)}) {
if (auto values{AsFlatArrayConstructor(expr)}) {
- return MapOperation(context, std::move(f), *shape,
+ return MapOperation(kind, context, std::move(f), *shape,
ComputeResultLength(operation), std::move(*values));
}
}
@@ -1743,10 +1804,11 @@ template <typename DERIVED, typename RESULT, typename OPERAND>
auto ApplyElementwise(
FoldingContext &context, Operation<DERIVED, RESULT, OPERAND> &operation)
-> std::optional<Expr<RESULT>> {
+ const int kind{operation.kind()};
return ApplyElementwise(context, operation,
std::function<Expr<RESULT>(Expr<OPERAND> &&)>{
- [](Expr<OPERAND> &&operand) {
- return Expr<RESULT>{DERIVED{std::move(operand)}};
+ [kind](Expr<OPERAND> &&operand) {
+ return Expr<RESULT>{DERIVED{kind, std::move(operand)}};
}});
}
@@ -1755,6 +1817,7 @@ auto ApplyElementwise(FoldingContext &context,
Operation<DERIVED, RESULT, LEFT, RIGHT> &operation,
std::function<Expr<RESULT>(Expr<LEFT> &&, Expr<RIGHT> &&)> &&f)
-> std::optional<Expr<RESULT>> {
+ const int kind{operation.kind()};
auto resultLength{ComputeResultLength(operation)};
auto &leftExpr{operation.left()};
auto &rightExpr{operation.right()};
@@ -1773,18 +1836,18 @@ auto ApplyElementwise(FoldingContext &context,
if (CheckConformance(context.messages(), *leftShape, *rightShape,
CheckConformanceFlags::EitherScalarExpandable)
.value_or(false /*fail if not known now to conform*/)) {
- return MapOperation(context, std::move(f), *leftShape,
+ return MapOperation(kind, context, std::move(f), *leftShape,
std::move(resultLength), std::move(*left),
std::move(*right));
} else {
return std::nullopt;
}
- return MapOperation(context, std::move(f), *leftShape,
+ return MapOperation(kind, context, std::move(f), *leftShape,
std::move(resultLength), std::move(*left), std::move(*right));
}
}
} else if (IsExpandableScalar(rightExpr, context, *leftShape)) {
- return MapOperation(context, std::move(f), *leftShape,
+ return MapOperation(kind, context, std::move(f), *leftShape,
std::move(resultLength), std::move(*left), rightExpr);
}
}
@@ -1793,7 +1856,7 @@ auto ApplyElementwise(FoldingContext &context,
if (std::optional<Shape> rightShape{GetShape(context, rightExpr)}) {
if (IsExpandableScalar(leftExpr, context, *rightShape)) {
if (auto right{AsFlatArrayConstructor(rightExpr)}) {
- return MapOperation(context, std::move(f), *rightShape,
+ return MapOperation(kind, context, std::move(f), *rightShape,
std::move(resultLength), leftExpr, std::move(*right));
}
}
@@ -1806,46 +1869,46 @@ template <typename DERIVED, typename RESULT, typename LEFT, typename RIGHT>
auto ApplyElementwise(
FoldingContext &context, Operation<DERIVED, RESULT, LEFT, RIGHT> &operation)
-> std::optional<Expr<RESULT>> {
+ const int kind{operation.kind()};
return ApplyElementwise(context, operation,
std::function<Expr<RESULT>(Expr<LEFT> &&, Expr<RIGHT> &&)>{
- [](Expr<LEFT> &&left, Expr<RIGHT> &&right) {
- return Expr<RESULT>{DERIVED{std::move(left), std::move(right)}};
+ [kind](Expr<LEFT> &&left, Expr<RIGHT> &&right) {
+ return Expr<RESULT>{
+ DERIVED{kind, std::move(left), std::move(right)}};
}});
}
// Unary operations
template <typename TO, typename FROM>
-common::IfNoLvalue<std::optional<TO>, FROM> ConvertString(FROM &&s) {
- if constexpr (std::is_same_v<TO, FROM>) {
+common::IfNoLvalue<std::optional<TO>, FROM> ConvertString(
+ int toKind, FROM &&s) {
+ const int fromKind{s.kind()};
+ if (std::is_same_v<TO, FROM> && toKind == fromKind) {
return std::make_optional<TO>(std::move(s));
+ } else if (auto result{s.ToAscii(toKind)}; !result.IsMonostate()) {
+ return result;
} else {
- // Fortran character conversion is well defined between distinct kinds
- // only when the actual characters are valid 7-bit ASCII.
- TO str;
- for (auto iter{s.cbegin()}; iter != s.cend(); ++iter) {
- if (static_cast<std::uint64_t>(*iter) > 127) {
- return std::nullopt;
- }
- str.push_back(static_cast<typename TO::value_type>(*iter));
- }
- return std::make_optional<TO>(std::move(str));
+ return std::nullopt;
}
}
template <typename TO, TypeCategory FROMCAT>
Expr<TO> FoldOperation(
FoldingContext &context, Convert<TO, FROMCAT> &&convert) {
+ const int toKind{convert.kind()};
if (auto array{ApplyElementwise(context, convert)}) {
return *array;
}
struct {
FoldingContext &context;
Convert<TO, FROMCAT> &convert;
- } msvcWorkaround{context, convert};
+ int toKind;
+ } msvcWorkaround{context, convert, toKind};
return common::visit(
[&msvcWorkaround](auto &kindExpr) -> Expr<TO> {
using Operand = ResultType<decltype(kindExpr)>;
+ const int toKind{msvcWorkaround.toKind};
// This variable is a workaround for msvc which emits an error when
// using the FROMCAT template parameter below.
TypeCategory constexpr FromCat{FROMCAT};
@@ -1853,95 +1916,113 @@ Expr<TO> FoldOperation(
auto &convert{msvcWorkaround.convert};
if (auto value{GetScalarConstantValue<Operand>(kindExpr)}) {
FoldingContext &ctx{msvcWorkaround.context};
+ const int fromKind{value->kind()};
if constexpr (TO::category == TypeCategory::Integer) {
if constexpr (FromCat == TypeCategory::Integer) {
- auto converted{Scalar<TO>::ConvertSigned(*value)};
+ auto converted{
+ Scalar<TO>::ConvertSigned(*value, Scalar<TO>::bits(toKind))};
if (converted.overflow) {
ctx.Warn(common::UsageWarning::FoldingException,
"conversion of %s_%d to INTEGER(%d) overflowed; result is %s"_warn_en_US,
- value->SignedDecimal(), Operand::kind, TO::kind,
+ value->SignedDecimal(), fromKind, toKind,
converted.value.SignedDecimal());
}
- return ScalarConstantToExpr(std::move(converted.value));
+ return MakeConstantExpr<TO>(toKind, std::move(converted.value));
} else if constexpr (FromCat == TypeCategory::Unsigned) {
- auto converted{Scalar<TO>::ConvertUnsigned(*value)};
+ auto converted{Scalar<TO>::ConvertUnsigned(
+ *value, Scalar<TO>::bits(toKind))};
if ((converted.overflow || converted.value.IsNegative())) {
ctx.Warn(common::UsageWarning::FoldingException,
"conversion of %s_U%d to INTEGER(%d) overflowed; result is %s"_warn_en_US,
- value->UnsignedDecimal(), Operand::kind, TO::kind,
+ value->UnsignedDecimal(), fromKind, toKind,
converted.value.SignedDecimal());
}
- return ScalarConstantToExpr(std::move(converted.value));
+ return MakeConstantExpr<TO>(toKind, std::move(converted.value));
} else if constexpr (FromCat == TypeCategory::Real) {
- auto converted{value->template ToInteger<Scalar<TO>>()};
+ auto converted{value->ToInteger(
+ common::RoundingMode::ToZero, Scalar<TO>::bits(toKind))};
if (converted.flags.test(RealFlag::InvalidArgument)) {
ctx.Warn(common::UsageWarning::FoldingException,
"REAL(%d) to INTEGER(%d) conversion: invalid argument"_warn_en_US,
- Operand::kind, TO::kind);
+ fromKind, toKind);
} else if (converted.flags.test(RealFlag::Overflow)) {
ctx.Warn(common::UsageWarning::FoldingException,
"REAL(%d) to INTEGER(%d) conversion overflowed"_warn_en_US,
- Operand::kind, TO::kind);
+ fromKind, toKind);
}
- return ScalarConstantToExpr(std::move(converted.value));
+ return MakeConstantExpr<TO>(toKind, std::move(converted.value));
}
} else if constexpr (TO::category == TypeCategory::Unsigned) {
if constexpr (FromCat == TypeCategory::Integer ||
FromCat == TypeCategory::Unsigned) {
- return Expr<TO>{
- Constant<TO>{Scalar<TO>::ConvertUnsigned(*value).value}};
+ return MakeConstantExpr<TO>(toKind,
+ Scalar<TO>::ConvertUnsigned(*value, Scalar<TO>::bits(toKind))
+ .value);
} else if constexpr (FromCat == TypeCategory::Real) {
- return Expr<TO>{
- Constant<TO>{value->template ToInteger<Scalar<TO>>().value}};
+ return MakeConstantExpr<TO>(toKind,
+ value
+ ->ToInteger(common::RoundingMode::ToZero,
+ Scalar<TO>::bits(toKind))
+ .value);
}
} else if constexpr (TO::category == TypeCategory::Real) {
if constexpr (FromCat == TypeCategory::Integer ||
FromCat == TypeCategory::Unsigned) {
auto converted{Scalar<TO>::FromInteger(
- *value, FromCat == TypeCategory::Unsigned)};
+ toKind, *value, FromCat == TypeCategory::Unsigned)};
if (!converted.flags.empty()) {
char buffer[64];
std::snprintf(buffer, sizeof buffer,
- "INTEGER(%d) to REAL(%d) conversion", Operand::kind,
- TO::kind);
+ "INTEGER(%d) to REAL(%d) conversion", fromKind, toKind);
ctx.RealFlagWarnings(converted.flags, buffer);
}
- return ScalarConstantToExpr(std::move(converted.value));
+ return MakeConstantExpr<TO>(toKind, std::move(converted.value));
} else if constexpr (FromCat == TypeCategory::Real) {
- auto converted{Scalar<TO>::Convert(*value)};
+ auto converted{Scalar<TO>::Convert(toKind, *value)};
char buffer[64];
if (!converted.flags.empty()) {
std::snprintf(buffer, sizeof buffer,
- "REAL(%d) to REAL(%d) conversion", Operand::kind, TO::kind);
+ "REAL(%d) to REAL(%d) conversion", fromKind, toKind);
ctx.RealFlagWarnings(converted.flags, buffer);
}
if (ctx.targetCharacteristics().areSubnormalsFlushedToZero()) {
converted.value = converted.value.FlushSubnormalToZero();
}
- return ScalarConstantToExpr(std::move(converted.value));
+ return MakeConstantExpr<TO>(toKind, std::move(converted.value));
}
} else if constexpr (TO::category == TypeCategory::Complex) {
if constexpr (FromCat == TypeCategory::Complex) {
return FoldOperation(ctx,
- ComplexConstructor<TO::kind>{
- AsExpr(Convert<typename TO::Part>{AsCategoryExpr(
- Constant<typename Operand::Part>{value->REAL()})}),
- AsExpr(Convert<typename TO::Part>{AsCategoryExpr(
- Constant<typename Operand::Part>{value->AIMAG()})})});
+ ComplexConstructor{toKind,
+ Fold(ctx,
+ AsExpr(Convert<typename TO::Part>(toKind,
+ AsCategoryExpr(Constant<typename Operand::Part>{
+ toKind, value->REAL()})))),
+ Fold(ctx,
+ AsExpr(Convert<typename TO::Part>(toKind,
+ AsCategoryExpr(Constant<typename Operand::Part>{
+ toKind, value->AIMAG()}))))});
}
} else if constexpr (TO::category == TypeCategory::Character &&
FromCat == TypeCategory::Character) {
- if (auto converted{ConvertString<Scalar<TO>>(std::move(*value))}) {
+ if (auto converted{
+ ConvertString<Scalar<TO>>(toKind, std::move(*value))}) {
return ScalarConstantToExpr(std::move(*converted));
}
} else if constexpr (TO::category == TypeCategory::Logical &&
FromCat == TypeCategory::Logical) {
- return Expr<TO>{value->IsTrue()};
+ // The conversion's target kind is a runtime property; build the
+ // result LOGICAL constant with that kind rather than letting it
+ // default (the Expr<Logical>(bool) constructor would otherwise
+ // produce LogicalResultKind=4 and silently drop the conversion).
+ return Expr<TO>{Constant<TO>{
+ toKind, value::LogicalValue{toKind, value->IsTrue()}}};
}
} else if constexpr (TO::category == FromCat &&
FromCat != TypeCategory::Character) {
// Conversion of non-constant in same type category
- if constexpr (std::is_same_v<Operand, TO>) {
+ auto fromTy{kindExpr.GetType()};
+ if (fromTy && fromTy->kind() == toKind) {
return std::move(kindExpr); // remove needless conversion
} else if constexpr (TO::category == TypeCategory::Logical ||
TO::category == TypeCategory::Integer) {
@@ -1949,16 +2030,26 @@ Expr<TO> FoldOperation(
std::get_if<Convert<Operand, TO::category>>(&kindExpr.u)}) {
// Conversion of conversion of same category & kind
if (auto *x{std::get_if<Expr<TO>>(&innerConv->left().u)}) {
- if constexpr (TO::category == TypeCategory::Logical ||
- TO::kind <= Operand::kind) {
- return std::move(*x); // no-op Logical or Integer
- // widening/narrowing conversion pair
- } else if constexpr (std::is_same_v<TO,
- DescriptorInquiry::Result>) {
- if (std::holds_alternative<DescriptorInquiry>(x->u) ||
- std::holds_alternative<TypeParamInquiry>(x->u)) {
+ // intermediateKind is the kind of the middle (Operand) result;
+ // xKind is the kind of the innermost expression, which must
+ // match the outer target for the round trip to be a no-op.
+ auto intermediateTy{kindExpr.GetType()};
+ auto xTy{x->GetType()};
+ int intermediateKind{
+ intermediateTy ? intermediateTy->kind() : 0};
+ int xKind{xTy ? xTy->kind() : 0};
+ if constexpr (TO::category == TypeCategory::Logical) {
+ return std::move(*x); // no-op Logical conversion pair
+ } else { // Integer
+ if (xKind == toKind && toKind <= intermediateKind) {
+ return std::move(*x); // widening/narrowing conversion pair
+ } else if (toKind == SubscriptIntegerKind &&
+ xKind == toKind) {
// int(int(size(...),kind=k),kind=8) -> size(...)
- return std::move(*x);
+ if (std::holds_alternative<DescriptorInquiry>(x->u) ||
+ std::holds_alternative<TypeParamInquiry>(x->u)) {
+ return std::move(*x);
+ }
}
}
}
@@ -1972,11 +2063,12 @@ Expr<TO> FoldOperation(
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, Parentheses<T> &&x) {
+ const int kind{x.kind()};
auto &operand{x.left()};
operand = Fold(context, std::move(operand));
if (auto value{GetScalarConstantValue<T>(operand)}) {
// Preserve parentheses, even around constants.
- return Expr<T>{Parentheses<T>{Expr<T>{Constant<T>{*value}}}};
+ return Expr<T>{Parentheses<T>{kind, MakeConstantExpr<T>(kind, *value)}};
} else if (std::holds_alternative<Parentheses<T>>(operand.u)) {
// ((x)) -> (x)
return std::move(operand);
@@ -1987,6 +2079,7 @@ Expr<T> FoldOperation(FoldingContext &context, Parentheses<T> &&x) {
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, Negate<T> &&x) {
+ const int kind{x.kind()};
if (auto array{ApplyElementwise(context, x)}) {
return *array;
}
@@ -2003,14 +2096,14 @@ Expr<T> FoldOperation(FoldingContext &context, Negate<T> &&x) {
auto negated{value->Negate()};
if (negated.overflow) {
context.Warn(common::UsageWarning::FoldingException,
- "INTEGER(%d) negation overflowed"_warn_en_US, T::kind);
+ "INTEGER(%d) negation overflowed"_warn_en_US, value->kind());
}
- return Expr<T>{Constant<T>{std::move(negated.value)}};
+ return Expr<T>{Constant<T>{kind, std::move(negated.value)}};
} else if constexpr (T::category == TypeCategory::Unsigned) {
- return Expr<T>{Constant<T>{std::move(value->Negate().value)}};
+ return Expr<T>{Constant<T>{kind, std::move(value->Negate().value)}};
} else {
// REAL & COMPLEX negation: no exceptions possible
- return Expr<T>{Constant<T>{value->Negate()}};
+ return Expr<T>{Constant<T>{kind, value->Negate()}};
}
}
return Expr<T>{std::move(x)};
@@ -2037,6 +2130,7 @@ std::optional<std::pair<Scalar<LEFT>, Scalar<RIGHT>>> OperandsAreConstants(
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, Add<T> &&x) {
+ const int kind{x.kind()};
if (auto array{ApplyElementwise(context, x)}) {
return *array;
}
@@ -2045,12 +2139,12 @@ Expr<T> FoldOperation(FoldingContext &context, Add<T> &&x) {
auto sum{folded->first.AddSigned(folded->second)};
if (sum.overflow) {
context.Warn(common::UsageWarning::FoldingException,
- "INTEGER(%d) addition overflowed"_warn_en_US, T::kind);
+ "INTEGER(%d) addition overflowed"_warn_en_US, folded->first.kind());
}
- return Expr<T>{Constant<T>{sum.value}};
+ return Expr<T>{Constant<T>{kind, sum.value}};
} else if constexpr (T::category == TypeCategory::Unsigned) {
return Expr<T>{
- Constant<T>{folded->first.AddUnsigned(folded->second).value}};
+ Constant<T>{kind, folded->first.AddUnsigned(folded->second).value}};
} else {
auto sum{folded->first.Add(
folded->second, context.targetCharacteristics().roundingMode())};
@@ -2058,7 +2152,7 @@ Expr<T> FoldOperation(FoldingContext &context, Add<T> &&x) {
if (context.targetCharacteristics().areSubnormalsFlushedToZero()) {
sum.value = sum.value.FlushSubnormalToZero();
}
- return Expr<T>{Constant<T>{sum.value}};
+ return Expr<T>{Constant<T>{kind, sum.value}};
}
} else if constexpr (T::category == TypeCategory::Integer ||
T::category == TypeCategory::Unsigned) {
@@ -2085,6 +2179,7 @@ Expr<T> FoldOperation(FoldingContext &context, Add<T> &&x) {
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, Subtract<T> &&x) {
+ const int kind{x.kind()};
if (auto array{ApplyElementwise(context, x)}) {
return *array;
}
@@ -2093,12 +2188,13 @@ Expr<T> FoldOperation(FoldingContext &context, Subtract<T> &&x) {
auto difference{folded->first.SubtractSigned(folded->second)};
if (difference.overflow) {
context.Warn(common::UsageWarning::FoldingException,
- "INTEGER(%d) subtraction overflowed"_warn_en_US, T::kind);
+ "INTEGER(%d) subtraction overflowed"_warn_en_US,
+ folded->first.kind());
}
- return Expr<T>{Constant<T>{difference.value}};
+ return Expr<T>{Constant<T>{kind, difference.value}};
} else if constexpr (T::category == TypeCategory::Unsigned) {
- return Expr<T>{
- Constant<T>{folded->first.SubtractSigned(folded->second).value}};
+ return Expr<T>{Constant<T>{
+ kind, folded->first.SubtractSigned(folded->second).value}};
} else {
auto difference{folded->first.Subtract(
folded->second, context.targetCharacteristics().roundingMode())};
@@ -2106,7 +2202,7 @@ Expr<T> FoldOperation(FoldingContext &context, Subtract<T> &&x) {
if (context.targetCharacteristics().areSubnormalsFlushedToZero()) {
difference.value = difference.value.FlushSubnormalToZero();
}
- return Expr<T>{Constant<T>{difference.value}};
+ return Expr<T>{Constant<T>{kind, difference.value}};
}
} else if constexpr (T::category == TypeCategory::Integer ||
T::category == TypeCategory::Unsigned) {
@@ -2125,6 +2221,7 @@ Expr<T> FoldOperation(FoldingContext &context, Subtract<T> &&x) {
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, Multiply<T> &&x) {
+ const int kind{x.kind()};
if (auto array{ApplyElementwise(context, x)}) {
return *array;
}
@@ -2133,12 +2230,13 @@ Expr<T> FoldOperation(FoldingContext &context, Multiply<T> &&x) {
auto product{folded->first.MultiplySigned(folded->second)};
if (product.SignedMultiplicationOverflowed()) {
context.Warn(common::UsageWarning::FoldingException,
- "INTEGER(%d) multiplication overflowed"_warn_en_US, T::kind);
+ "INTEGER(%d) multiplication overflowed"_warn_en_US,
+ folded->first.kind());
}
- return Expr<T>{Constant<T>{product.lower}};
+ return Expr<T>{Constant<T>{kind, product.lower}};
} else if constexpr (T::category == TypeCategory::Unsigned) {
- return Expr<T>{
- Constant<T>{folded->first.MultiplyUnsigned(folded->second).lower}};
+ return Expr<T>{Constant<T>{
+ kind, folded->first.MultiplyUnsigned(folded->second).lower}};
} else {
auto product{folded->first.Multiply(
folded->second, context.targetCharacteristics().roundingMode())};
@@ -2146,23 +2244,25 @@ Expr<T> FoldOperation(FoldingContext &context, Multiply<T> &&x) {
if (context.targetCharacteristics().areSubnormalsFlushedToZero()) {
product.value = product.value.FlushSubnormalToZero();
}
- return Expr<T>{Constant<T>{product.value}};
+ return Expr<T>{Constant<T>{kind, product.value}};
}
} else if constexpr (T::category == TypeCategory::Integer) {
if (auto c{GetScalarConstantValue<T>(x.right())}) {
x.right() = std::move(x.left());
- x.left() = Expr<T>{std::move(*c)};
+ x.left() = Expr<T>{Constant<T>(kind, *c)};
}
if (auto c{GetScalarConstantValue<T>(x.left())}) {
if (c->IsZero() && x.right().Rank() == 0) {
return std::move(x.left());
- } else if (c->CompareSigned(Scalar<T>{1}) == Ordering::Equal) {
+ } else if (c->CompareSigned(value::IntegerValue{kind, 1}) ==
+ Ordering::Equal) {
if (IsVariable(x.right())) {
return FoldOperation(context, Parentheses<T>{std::move(x.right())});
} else {
return std::move(x.right());
}
- } else if (c->CompareSigned(Scalar<T>{-1}) == Ordering::Equal) {
+ } else if (c->CompareSigned(value::IntegerValue{kind, -1}) ==
+ Ordering::Equal) {
return FoldOperation(context, Negate<T>{std::move(x.right())});
}
}
@@ -2172,6 +2272,7 @@ Expr<T> FoldOperation(FoldingContext &context, Multiply<T> &&x) {
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) {
+ const int kind{x.kind()};
if (auto array{ApplyElementwise(context, x)}) {
return *array;
}
@@ -2180,22 +2281,22 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) {
auto quotAndRem{folded->first.DivideSigned(folded->second)};
if (quotAndRem.divisionByZero) {
context.Warn(common::UsageWarning::FoldingException,
- "INTEGER(%d) division by zero"_warn_en_US, T::kind);
+ "INTEGER(%d) division by zero"_warn_en_US, folded->first.kind());
return Expr<T>{std::move(x)};
}
if (quotAndRem.overflow) {
context.Warn(common::UsageWarning::FoldingException,
- "INTEGER(%d) division overflowed"_warn_en_US, T::kind);
+ "INTEGER(%d) division overflowed"_warn_en_US, folded->first.kind());
}
- return Expr<T>{Constant<T>{quotAndRem.quotient}};
+ return Expr<T>{Constant<T>{kind, quotAndRem.quotient}};
} else if constexpr (T::category == TypeCategory::Unsigned) {
auto quotAndRem{folded->first.DivideUnsigned(folded->second)};
if (quotAndRem.divisionByZero) {
context.Warn(common::UsageWarning::FoldingException,
- "UNSIGNED(%d) division by zero"_warn_en_US, T::kind);
+ "UNSIGNED(%d) division by zero"_warn_en_US, folded->first.kind());
return Expr<T>{std::move(x)};
}
- return Expr<T>{Constant<T>{quotAndRem.quotient}};
+ return Expr<T>{Constant<T>{kind, quotAndRem.quotient}};
} else {
auto quotient{folded->first.Divide(
folded->second, context.targetCharacteristics().roundingMode())};
@@ -2206,10 +2307,10 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) {
if constexpr (T::category == TypeCategory::Real) {
if (folded->second.IsZero() && context.moduleFileName().has_value()) {
using IntType = typename T::Scalar::Word;
- auto intNumerator{folded->first.template ToInteger<IntType>()};
+ auto intNumerator{folded->first.ToInteger()};
isCanonicalNaNOrInf = intNumerator.flags == RealFlags{} &&
- intNumerator.value >= IntType{-1} &&
- intNumerator.value <= IntType{1};
+ intNumerator.value >= IntType{-1, 16} &&
+ intNumerator.value <= IntType{1, 16};
}
}
if (!isCanonicalNaNOrInf) {
@@ -2218,7 +2319,7 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) {
if (context.targetCharacteristics().areSubnormalsFlushedToZero()) {
quotient.value = quotient.value.FlushSubnormalToZero();
}
- return Expr<T>{Constant<T>{quotient.value}};
+ return Expr<T>{Constant<T>{kind, quotient.value}};
}
}
return Expr<T>{std::move(x)};
@@ -2226,6 +2327,7 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) {
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, Power<T> &&x) {
+ const int kind{x.kind()};
if (auto array{ApplyElementwise(context, x)}) {
return *array;
}
@@ -2234,30 +2336,33 @@ Expr<T> FoldOperation(FoldingContext &context, Power<T> &&x) {
auto power{folded->first.Power(folded->second)};
if (power.divisionByZero) {
context.Warn(common::UsageWarning::FoldingException,
- "INTEGER(%d) zero to negative power"_warn_en_US, T::kind);
+ "INTEGER(%d) zero to negative power"_warn_en_US,
+ folded->first.kind());
} else if (power.overflow) {
context.Warn(common::UsageWarning::FoldingException,
- "INTEGER(%d) power overflowed"_warn_en_US, T::kind);
+ "INTEGER(%d) power overflowed"_warn_en_US, folded->first.kind());
} else if (power.zeroToZero) {
context.Warn(common::UsageWarning::FoldingException,
- "INTEGER(%d) 0**0 is not defined"_warn_en_US, T::kind);
+ "INTEGER(%d) 0**0 is not defined"_warn_en_US, folded->first.kind());
}
- return Expr<T>{Constant<T>{power.power}};
+ return Expr<T>{Constant<T>{kind, power.power}};
} else {
if (folded->first.IsZero()) {
if (folded->second.IsZero()) {
context.Warn(common::UsageWarning::FoldingException,
"REAL/COMPLEX 0**0 is not defined"_warn_en_US);
} else {
- return Expr<T>(Constant<T>{folded->first}); // 0. ** nonzero -> 0.
+ return Expr<T>(
+ Constant<T>{kind, folded->first}); // 0. ** nonzero -> 0.
}
- } else if (auto callable{GetHostRuntimeWrapper<T, T, T>("pow")}) {
- return Expr<T>{
- Constant<T>{(*callable)(context, folded->first, folded->second)}};
+ } else if (auto callable{GetHostRuntimeWrapper<T, T, T>(
+ kind, {kind, kind}, "pow")}) {
+ return Expr<T>{Constant<T>{
+ kind, (*callable)(context, folded->first, folded->second)}};
} else {
context.Warn(common::UsageWarning::FoldingFailure,
"Power for %s cannot be folded on host"_warn_en_US,
- T{}.AsFortran());
+ DynamicType{T::category, folded->first.kind()}.AsFortran());
}
}
}
@@ -2266,18 +2371,19 @@ Expr<T> FoldOperation(FoldingContext &context, Power<T> &&x) {
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, RealToIntPower<T> &&x) {
+ const int kind{x.kind()};
if (auto array{ApplyElementwise(context, x)}) {
return *array;
}
return common::visit(
- [&](auto &y) -> Expr<T> {
+ [&, kind](auto &y) -> Expr<T> {
if (auto folded{OperandsAreConstants(x.left(), y)}) {
auto power{evaluate::IntPower(folded->first, folded->second)};
context.RealFlagWarnings(power.flags, "power with INTEGER exponent");
if (context.targetCharacteristics().areSubnormalsFlushedToZero()) {
power.value = power.value.FlushSubnormalToZero();
}
- return Expr<T>{Constant<T>{power.value}};
+ return Expr<T>{Constant<T>{kind, power.value}};
} else {
return Expr<T>{std::move(x)};
}
@@ -2298,6 +2404,7 @@ Expr<T> FoldOperation(FoldingContext &context, ConditionalExpr<T> &&x) {
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, Extremum<T> &&x) {
+ const int kind{x.kind()};
if (auto array{ApplyElementwise(context, x,
std::function<Expr<T>(Expr<T> &&, Expr<T> &&)>{[=](Expr<T> &&l,
Expr<T> &&r) {
@@ -2308,17 +2415,17 @@ Expr<T> FoldOperation(FoldingContext &context, Extremum<T> &&x) {
if (auto folded{OperandsAreConstants(x)}) {
if constexpr (T::category == TypeCategory::Integer) {
if (folded->first.CompareSigned(folded->second) == x.ordering) {
- return Expr<T>{Constant<T>{folded->first}};
+ return Expr<T>{Constant<T>{kind, folded->first}};
}
} else if constexpr (T::category == TypeCategory::Unsigned) {
if (folded->first.CompareUnsigned(folded->second) == x.ordering) {
- return Expr<T>{Constant<T>{folded->first}};
+ return Expr<T>{Constant<T>{kind, folded->first}};
}
} else if constexpr (T::category == TypeCategory::Real) {
if (folded->first.IsNotANumber() ||
(folded->first.Compare(folded->second) == Relation::Less) ==
(x.ordering == Ordering::Less)) {
- return Expr<T>{Constant<T>{folded->first}};
+ return Expr<T>{Constant<T>{kind, folded->first}};
}
} else {
static_assert(T::category == TypeCategory::Character);
@@ -2327,38 +2434,38 @@ Expr<T> FoldOperation(FoldingContext &context, Extremum<T> &&x) {
auto maxLen{std::max(folded->first.length(), folded->second.length())};
bool isFirst{x.ordering == Compare(folded->first, folded->second)};
auto res{isFirst ? std::move(folded->first) : std::move(folded->second)};
- res = res.length() == maxLen
- ? std::move(res)
- : CharacterUtils<T::kind>::Resize(res, maxLen);
- return Expr<T>{Constant<T>{std::move(res)}};
+ if (res.length() != maxLen) {
+ res = CharacterUtils::Resize(res, maxLen);
+ }
+ return Expr<T>{Constant<T>{kind, std::move(res)}};
}
- return Expr<T>{Constant<T>{folded->second}};
+ return Expr<T>{Constant<T>{kind, folded->second}};
}
return Expr<T>{std::move(x)};
}
-template <int KIND>
-Expr<Type<TypeCategory::Real, KIND>> ToReal(
- FoldingContext &context, Expr<SomeType> &&expr) {
- using Result = Type<TypeCategory::Real, KIND>;
+inline Expr<Type<TypeCategory::Real>> ToReal(
+ int kind, FoldingContext &context, Expr<SomeType> &&expr) {
+ using Result = Type<TypeCategory::Real>;
std::optional<Expr<Result>> result;
common::visit(
[&](auto &&x) {
using From = std::decay_t<decltype(x)>;
if constexpr (std::is_same_v<From, BOZLiteralConstant>) {
// Move the bits without any integer->real conversion
- From original{x};
- result = ConvertToType<Result>(std::move(x));
+ BOZLiteralConstant original{x};
+ result = ConvertToType<Result>(kind, std::move(x));
const auto *constant{UnwrapExpr<Constant<Result>>(*result)};
CHECK(constant);
Scalar<Result> real{constant->GetScalarValue().value()};
- From converted{From::ConvertUnsigned(real.RawBits()).value};
+ BOZLiteralConstant converted{
+ BOZLiteralConstant::ConvertUnsigned(real.RawBits(), 128).value};
if (original != converted) { // C1601
context.Warn(common::UsageWarning::FoldingValueChecks,
"Nonzero bits truncated from BOZ literal constant in REAL intrinsic"_warn_en_US);
}
} else if constexpr (IsNumericCategoryExpr<From>()) {
- result = Fold(context, ConvertToType<Result>(std::move(x)));
+ result = Fold(context, ConvertToType<Result>(kind, std::move(x)));
} else {
common::die("ToReal: bad argument expression");
}
@@ -2368,25 +2475,25 @@ Expr<Type<TypeCategory::Real, KIND>> ToReal(
}
// REAL(z) and AIMAG(z)
-template <int KIND>
-Expr<Type<TypeCategory::Real, KIND>> FoldOperation(
- FoldingContext &context, ComplexComponent<KIND> &&x) {
- using Operand = Type<TypeCategory::Complex, KIND>;
- using Result = Type<TypeCategory::Real, KIND>;
+inline Expr<Type<TypeCategory::Real>> FoldOperation(
+ FoldingContext &context, ComplexComponent &&x) {
+ const int kind{x.kind()};
+ using Operand = Type<TypeCategory::Complex>;
+ using Result = Type<TypeCategory::Real>;
if (auto array{ApplyElementwise(context, x,
std::function<Expr<Result>(Expr<Operand> &&)>{
[=](Expr<Operand> &&operand) {
- return Expr<Result>{ComplexComponent<KIND>{
- x.isImaginaryPart, std::move(operand)}};
+ return Expr<Result>{
+ ComplexComponent{x.isImaginaryPart, std::move(operand)}};
}})}) {
return *array;
}
auto &operand{x.left()};
if (auto value{GetScalarConstantValue<Operand>(operand)}) {
if (x.isImaginaryPart) {
- return Expr<Result>{Constant<Result>{value->AIMAG()}};
+ return Expr<Result>{Constant<Result>{kind, value->AIMAG()}};
} else {
- return Expr<Result>{Constant<Result>{value->REAL()}};
+ return Expr<Result>{Constant<Result>{kind, value->REAL()}};
}
}
return Expr<Result>{std::move(x)};
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index c7db4069e3e28..2545f4b4210b5 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -10,6 +10,7 @@
#include "fold-matmul.h"
#include "fold-reduction.h"
#include "flang/Evaluate/check-expression.h"
+#include "flang/Evaluate/shape.h"
namespace Fortran::evaluate {
@@ -17,16 +18,17 @@ namespace Fortran::evaluate {
// Return scalar value if asScalar == true and shape-dim array otherwise.
template <typename T>
Expr<T> PackageConstantBounds(
- const ConstantSubscripts &&bounds, bool asScalar = false) {
+ int kind, const ConstantSubscripts &&bounds, bool asScalar = false) {
if (asScalar) {
- return Expr<T>{Constant<T>{bounds.at(0)}};
+ return MakeConstantExpr<T>(kind, bounds.at(0));
} else {
// As rank-dim array
const int rank{GetRank(bounds)};
std::vector<Scalar<T>> packed(rank);
std::transform(bounds.begin(), bounds.end(), packed.begin(),
- [](ConstantSubscript x) { return Scalar<T>(x); });
- return Expr<T>{Constant<T>{std::move(packed), ConstantSubscripts{rank}}};
+ [kind](ConstantSubscript x) { return Scalar<T>(kind, x); });
+ return Expr<T>{
+ Constant<T>{kind, std::move(packed), ConstantSubscripts{rank}}};
}
}
@@ -99,16 +101,16 @@ class GetConstantArrayBoundHelper {
public:
template <typename T>
static Expr<T> GetLbound(
- const Expr<SomeType> &array, std::optional<int> dim) {
- return PackageConstantBounds<T>(
+ int kind, const Expr<SomeType> &array, std::optional<int> dim) {
+ return PackageConstantBounds<T>(kind,
GetConstantArrayBoundHelper(dim, /*getLbound=*/true).Get(array),
dim.has_value());
}
template <typename T>
static Expr<T> GetUbound(
- const Expr<SomeType> &array, std::optional<int> dim) {
- return PackageConstantBounds<T>(
+ int kind, const Expr<SomeType> &array, std::optional<int> dim) {
+ return PackageConstantBounds<T>(kind,
GetConstantArrayBoundHelper(dim, /*getLbound=*/false).Get(array),
dim.has_value());
}
@@ -173,10 +175,10 @@ class GetConstantArrayBoundHelper {
bool arrayFromParenthesesExpr{false};
};
-template <int KIND>
-Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
- FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
- using T = Type<TypeCategory::Integer, KIND>;
+Expr<Type<TypeCategory::Integer>> LBOUND(FoldingContext &context,
+ FunctionRef<Type<TypeCategory::Integer>> &&funcRef) {
+ using T = Type<TypeCategory::Integer>;
+ const int kind{funcRef.kind()};
ActualArguments &args{funcRef.arguments()};
if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
std::optional<int> dim;
@@ -201,33 +203,33 @@ Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
lowerBoundsAreOne = false;
if (dim) {
if (auto lb{GetLBOUND(context, *named, *dim)}) {
- return Fold(context, ConvertToType<T>(std::move(*lb)));
+ return Fold(context, ConvertToType<T>(kind, std::move(*lb)));
}
} else if (auto extents{
AsExtentArrayExpr(GetLBOUNDs(context, *named))}) {
return Fold(context,
- ConvertToType<T>(Expr<ExtentType>{std::move(*extents)}));
+ ConvertToType<T>(kind, Expr<ExtentType>{std::move(*extents)}));
}
} else {
lowerBoundsAreOne = symbol.Rank() == 0; // LBOUND(array%component)
}
}
if (IsActuallyConstant(*array)) {
- return GetConstantArrayBoundHelper::GetLbound<T>(*array, dim);
+ return GetConstantArrayBoundHelper::GetLbound<T>(kind, *array, dim);
}
if (lowerBoundsAreOne) {
ConstantSubscripts ones(rank, ConstantSubscript{1});
- return PackageConstantBounds<T>(std::move(ones), dim.has_value());
+ return PackageConstantBounds<T>(kind, std::move(ones), dim.has_value());
}
}
}
return Expr<T>{std::move(funcRef)};
}
-template <int KIND>
-Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
- FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
- using T = Type<TypeCategory::Integer, KIND>;
+Expr<Type<TypeCategory::Integer>> UBOUND(FoldingContext &context,
+ FunctionRef<Type<TypeCategory::Integer>> &&funcRef) {
+ using T = Type<TypeCategory::Integer>;
+ const int kind{funcRef.kind()};
ActualArguments &args{funcRef.arguments()};
if (auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
std::optional<int> dim;
@@ -249,17 +251,18 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
takeBoundsFromShape = false;
if (dim) {
if (auto ub{GetUBOUND(context, *named, *dim)}) {
- return Fold(context, ConvertToType<T>(std::move(*ub)));
+ return Fold(context, ConvertToType<T>(kind, std::move(*ub)));
}
} else {
Shape ubounds{GetUBOUNDs(context, *named)};
if (semantics::IsAssumedSizeArray(symbol)) {
CHECK(!ubounds.back());
- ubounds.back() = ExtentExpr{-1};
+ ubounds.back() = MakeExtentExpr(-1);
}
if (auto extents{AsExtentArrayExpr(ubounds)}) {
return Fold(context,
- ConvertToType<T>(Expr<ExtentType>{std::move(*extents)}));
+ ConvertToType<T>(
+ kind, Expr<ExtentType>{std::move(*extents)}));
}
}
} else {
@@ -267,17 +270,18 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
}
}
if (IsActuallyConstant(*array)) {
- return GetConstantArrayBoundHelper::GetUbound<T>(*array, dim);
+ return GetConstantArrayBoundHelper::GetUbound<T>(kind, *array, dim);
}
if (takeBoundsFromShape) {
if (auto shape{GetContextFreeShape(context, *array)}) {
if (dim) {
if (auto &dimSize{shape->at(*dim)}) {
return Fold(context,
- ConvertToType<T>(Expr<ExtentType>{std::move(*dimSize)}));
+ ConvertToType<T>(
+ kind, Expr<ExtentType>{std::move(*dimSize)}));
}
} else if (auto shapeExpr{AsExtentArrayExpr(*shape)}) {
- return Fold(context, ConvertToType<T>(std::move(*shapeExpr)));
+ return Fold(context, ConvertToType<T>(kind, std::move(*shapeExpr)));
}
}
}
@@ -287,10 +291,10 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
}
// LCOBOUND() & UCOBOUND()
-template <int KIND>
-Expr<Type<TypeCategory::Integer, KIND>> COBOUND(FoldingContext &context,
- FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef, bool isUCOBOUND) {
- using T = Type<TypeCategory::Integer, KIND>;
+Expr<Type<TypeCategory::Integer>> COBOUND(FoldingContext &context,
+ FunctionRef<Type<TypeCategory::Integer>> &&funcRef, bool isUCOBOUND) {
+ using T = Type<TypeCategory::Integer>;
+ const int kind{funcRef.kind()};
ActualArguments &args{funcRef.arguments()};
if (const Symbol * coarray{UnwrapWholeSymbolOrComponentDataRef(args[0])}) {
std::optional<int> dim;
@@ -306,27 +310,32 @@ Expr<Type<TypeCategory::Integer, KIND>> COBOUND(FoldingContext &context,
if (dim) {
if (auto cb{isUCOBOUND ? GetUCOBOUND(*coarray, *dim)
: GetLCOBOUND(*coarray, *dim)}) {
- return Fold(context, ConvertToType<T>(std::move(*cb)));
+ return Fold(context, ConvertToType<T>(kind, std::move(*cb)));
}
} else if (auto cbs{
AsExtentArrayExpr(isUCOBOUND ? GetUCOBOUNDs(*coarray)
: GetLCOBOUNDs(*coarray))}) {
- return Fold(context, ConvertToType<T>(Expr<ExtentType>{std::move(*cbs)}));
+ return Fold(
+ context, ConvertToType<T>(kind, Expr<ExtentType>{std::move(*cbs)}));
}
}
return Expr<T>{std::move(funcRef)};
}
// COUNT()
-template <typename T, int MASK_KIND> class CountAccumulator {
- using MaskT = Type<TypeCategory::Logical, MASK_KIND>;
+template <typename T> class CountAccumulator {
+ using MaskT = Type<TypeCategory::Logical>;
public:
- CountAccumulator(const Constant<MaskT> &mask) : mask_{mask} {}
+ constexpr int kind() const { return kind_; }
+
+ CountAccumulator(int kind, const Constant<MaskT> &mask)
+ : kind_{kind}, mask_{mask} {}
void operator()(
Scalar<T> &element, const ConstantSubscripts &at, bool /*first*/) {
+ CHECK(element.kind() == kind());
if (mask_.At(at).IsTrue()) {
- auto incremented{element.AddSigned(Scalar<T>{1})};
+ auto incremented{element.AddSigned(Scalar<T>{kind(), 1})};
overflow_ |= incremented.overflow;
element = incremented.value;
}
@@ -335,21 +344,23 @@ template <typename T, int MASK_KIND> class CountAccumulator {
void Done(Scalar<T> &) const {}
private:
+ int kind_;
const Constant<MaskT> &mask_;
bool overflow_{false};
};
-template <typename T, int maskKind>
+template <typename T>
static Expr<T> FoldCount(FoldingContext &context, FunctionRef<T> &&ref) {
- using KindLogical = Type<TypeCategory::Logical, maskKind>;
+ using KindLogical = Type<TypeCategory::Logical>;
static_assert(T::category == TypeCategory::Integer);
+ const int kind{ref.kind()};
std::optional<int> dim;
if (std::optional<ArrayAndMask<KindLogical>> arrayAndMask{
- ProcessReductionArgs<KindLogical>(
- context, ref.arguments(), dim, /*ARRAY=*/0, /*DIM=*/1)}) {
- CountAccumulator<T, maskKind> accumulator{arrayAndMask->array};
- Constant<T> result{DoReduction<T>(arrayAndMask->array, arrayAndMask->mask,
- dim, Scalar<T>{}, accumulator)};
+ ProcessReductionArgs<KindLogical>(LogicalResultKind, context,
+ ref.arguments(), dim, /*ARRAY=*/0, /*DIM=*/1)}) {
+ CountAccumulator<T> accumulator{kind, arrayAndMask->array};
+ Constant<T> result{DoReduction<T>(kind, arrayAndMask->array,
+ arrayAndMask->mask, dim, Scalar<T>{kind, 0}, accumulator)};
if (accumulator.overflow()) {
context.Warn(common::UsageWarning::FoldingException,
"Result of intrinsic function COUNT overflows its result type"_warn_en_US);
@@ -370,12 +381,12 @@ template <WhichLocation WHICH> class LocationHelper {
using Types = std::conditional_t<WHICH == WhichLocation::Findloc,
AllIntrinsicTypes, RelationalTypes>;
- template <typename T> Result Test() const {
- if (T::category != type_.category() || T::kind != type_.kind()) {
+ template <typename T> Result Test(int kind) const {
+ if (T::category != type_.category() || kind != type_.kind()) {
return std::nullopt;
}
CHECK(arg_.size() == (WHICH == WhichLocation::Findloc ? 6 : 5));
- Folder<T> folder{context_};
+ Folder<T> folder{kind, context_};
Constant<T> *array{folder.Folding(arg_[0])};
if (!array) {
return std::nullopt;
@@ -397,9 +408,9 @@ template <WhichLocation WHICH> class LocationHelper {
}
bool back{false};
if (arg_[backArg]) {
- const auto *backConst{
- Folder<LogicalResult>{context_, /*forOptionalArgument=*/true}.Folding(
- arg_[backArg])};
+ const auto *backConst{Folder<LogicalResult>{
+ LogicalResultKind, context_, /*forOptionalArgument=*/true}
+ .Folding(arg_[backArg])};
if (backConst) {
back = backConst->GetScalarValue().value().IsTrue();
} else {
@@ -422,7 +433,7 @@ template <WhichLocation WHICH> class LocationHelper {
ConstantSubscript n{GetSize(array->shape())};
std::vector<Scalar<LogicalResult>> mask_elements(
n, Scalar<LogicalResult>{scalarMask.value()});
- *mask = Constant<LogicalResult>{
+ *mask = Constant<LogicalResult>{LogicalResultKind,
std::move(mask_elements), ConstantSubscripts{array->shape()}};
}
mask->SetLowerBoundsToOne();
@@ -487,9 +498,9 @@ template <WhichLocation WHICH> class LocationHelper {
}
std::vector<Scalar<SubscriptInteger>> resultElements;
for (ConstantSubscript j : resultIndices) {
- resultElements.emplace_back(j);
+ resultElements.emplace_back(SubscriptIntegerKind, j);
}
- return Constant<SubscriptInteger>{
+ return Constant<SubscriptInteger>{SubscriptIntegerKind,
std::move(resultElements), std::move(resultShape)};
}
@@ -499,15 +510,16 @@ template <WhichLocation WHICH> class LocationHelper {
std::optional<Constant<T>> &value,
[[maybe_unused]] RelationalOperator relation,
[[maybe_unused]] bool back) const {
+ const int kind{element.kind()};
std::optional<Expr<LogicalResult>> cmp;
bool result{true};
if (value) {
if constexpr (T::category == TypeCategory::Logical) {
// array(at) .EQV. value?
static_assert(WHICH == WhichLocation::Findloc);
- cmp.emplace(ConvertToType<LogicalResult>(
- Expr<T>{LogicalOperation<T::kind>{LogicalOperator::Eqv,
- Expr<T>{Constant<T>{element}}, Expr<T>{Constant<T>{*value}}}}));
+ cmp.emplace(Expr<LogicalResult>{LogicalOperation{LogicalOperator::Eqv,
+ MakeConstantExpr<T>(kind, element),
+ MakeConstantExpr<T>(kind, *value)}});
} else { // compare array(at) to value
if constexpr (T::category == TypeCategory::Real &&
(WHICH == WhichLocation::Maxloc ||
@@ -515,12 +527,13 @@ template <WhichLocation WHICH> class LocationHelper {
if (value && value->GetScalarValue().value().IsNotANumber() &&
(back || !element.IsNotANumber())) {
// Replace NaN
- cmp.emplace(Constant<LogicalResult>{Scalar<LogicalResult>{true}});
+ cmp.emplace(MakeLogicalResultConstant(true));
}
}
if (!cmp) {
- cmp.emplace(PackageRelation(relation, Expr<T>{Constant<T>{element}},
- Expr<T>{Constant<T>{*value}}));
+ cmp.emplace(
+ PackageRelation(relation, MakeConstantExpr<T>(kind, element),
+ MakeConstantExpr<T>(kind, *value)));
}
}
Expr<LogicalResult> folded{Fold(context_, std::move(*cmp))};
@@ -531,7 +544,7 @@ template <WhichLocation WHICH> class LocationHelper {
if constexpr (WHICH == WhichLocation::Maxloc ||
WHICH == WhichLocation::Minloc) {
if (result) {
- value.emplace(std::move(element));
+ value.emplace(Constant<T>{kind, element});
}
}
return result;
@@ -562,8 +575,7 @@ static std::optional<Constant<SubscriptInteger>> FoldLocationCall(
}
}
}
- return common::SearchTypes(
- LocationHelper<which>{std::move(*type), arg, context});
+ return SearchTypes(LocationHelper<which>{std::move(*type), arg, context});
}
}
return std::nullopt;
@@ -572,10 +584,11 @@ static std::optional<Constant<SubscriptInteger>> FoldLocationCall(
template <WhichLocation which, typename T>
static Expr<T> FoldLocation(FoldingContext &context, FunctionRef<T> &&ref) {
static_assert(T::category == TypeCategory::Integer);
+ const int kind{ref.kind()};
if (std::optional<Constant<SubscriptInteger>> found{
FoldLocationCall<which>(ref.arguments(), context)}) {
- return Expr<T>{Fold(
- context, ConvertToType<T>(Expr<SubscriptInteger>{std::move(*found)}))};
+ return Expr<T>{Fold(context,
+ ConvertToType<T>(kind, Expr<SubscriptInteger>{std::move(*found)}))};
} else {
return Expr<T>{std::move(ref)};
}
@@ -586,15 +599,16 @@ template <typename T>
static Expr<T> FoldBitReduction(FoldingContext &context, FunctionRef<T> &&ref,
Scalar<T> (Scalar<T>::*operation)(const Scalar<T> &) const,
Scalar<T> identity) {
+ const int kind{ref.kind()};
static_assert(T::category == TypeCategory::Integer ||
T::category == TypeCategory::Unsigned);
std::optional<int> dim;
if (std::optional<ArrayAndMask<T>> arrayAndMask{
- ProcessReductionArgs<T>(context, ref.arguments(), dim,
+ ProcessReductionArgs<T>(kind, context, ref.arguments(), dim,
/*ARRAY=*/0, /*DIM=*/1, /*MASK=*/2)}) {
OperationAccumulator<T> accumulator{arrayAndMask->array, operation};
- return Expr<T>{DoReduction<T>(
- arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)};
+ return Expr<T>{DoReduction<T>(kind, arrayAndMask->array, arrayAndMask->mask,
+ dim, identity, accumulator)};
}
return Expr<T>{std::move(ref)};
}
@@ -603,38 +617,44 @@ static Expr<T> FoldBitReduction(FoldingContext &context, FunctionRef<T> &&ref,
template <typename T>
std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
FoldingContext &context, FunctionRef<T> &funcRef) {
+ const int kind{funcRef.kind()};
ActualArguments &args{funcRef.arguments()};
auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
CHECK(intrinsic);
std::string name{intrinsic->name};
- using Int4 = Type<TypeCategory::Integer, 4>;
+ using Int4 = Type<TypeCategory::Integer>;
if (name == "bit_size") {
- return Expr<T>{Scalar<T>::bits};
+ return MakeConstantExpr<T>(kind, Scalar<T>::bits(kind));
} else if (name == "digits") {
if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
- return Expr<T>{common::visit(
- [](const auto &kx) {
- return Scalar<ResultType<decltype(kx)>>::DIGITS;
- },
- cx->u)};
+ return MakeConstantExpr<T>(kind,
+ common::visit(
+ [](const auto &kx) {
+ return Scalar<ResultType<decltype(kx)>>::DIGITS(kx.kind());
+ },
+ cx->u));
} else if (const auto *cx{UnwrapExpr<Expr<SomeUnsigned>>(args[0])}) {
- return Expr<T>{common::visit(
- [](const auto &kx) {
- return Scalar<ResultType<decltype(kx)>>::DIGITS + 1;
- },
- cx->u)};
+ return MakeConstantExpr<T>(kind,
+ common::visit(
+ [](const auto &kx) {
+ return Scalar<ResultType<decltype(kx)>>::DIGITS(kx.kind()) + 1;
+ },
+ cx->u));
} else if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
- return Expr<T>{common::visit(
- [](const auto &kx) {
- return Scalar<ResultType<decltype(kx)>>::DIGITS;
- },
- cx->u)};
+ return MakeConstantExpr<T>(kind,
+ common::visit(
+ [](const auto &kx) {
+ return Scalar<ResultType<decltype(kx)>>::DIGITS(kx.kind());
+ },
+ cx->u));
} else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
- return Expr<T>{common::visit(
- [](const auto &kx) {
- return Scalar<typename ResultType<decltype(kx)>::Part>::DIGITS;
- },
- cx->u)};
+ return MakeConstantExpr<T>(kind,
+ common::visit(
+ [](const auto &kx) {
+ return Scalar<typename ResultType<decltype(kx)>::Part>::DIGITS(
+ kx.kind());
+ },
+ cx->u));
}
} else if (name == "dot_product") {
return FoldDotProduct<T>(context, std::move(funcRef));
@@ -643,24 +663,27 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
name == "dshiftl" ? &Scalar<T>::DSHIFTL : &Scalar<T>::DSHIFTR};
// Third argument can be of any kind. However, it must be smaller or equal
// than BIT_SIZE. It can be converted to Int4 to simplify.
- if (const auto *argCon{Folder<T>(context).Folding(args[0])};
+ if (const auto *argCon{Folder<T>(kind, context).Folding(args[0])};
argCon && argCon->empty()) {
- } else if (const auto *shiftCon{Folder<Int4>(context).Folding(args[2])}) {
+ } else if (const auto *shiftCon{Folder<Int4>(
+ /*kind=*/4, context)
+ .Folding(args[2])}) {
for (const auto &scalar : shiftCon->values()) {
std::int64_t shiftVal{scalar.ToInt64()};
if (shiftVal < 0) {
context.messages().Say("SHIFT=%jd count for %s is negative"_err_en_US,
std::intmax_t{shiftVal}, name);
break;
- } else if (shiftVal > T::Scalar::bits) {
+ } else if (shiftVal > Scalar<T>::bits(kind)) {
context.messages().Say(
"SHIFT=%jd count for %s is greater than %d"_err_en_US,
- std::intmax_t{shiftVal}, name, T::Scalar::bits);
+ std::intmax_t{shiftVal}, name, Scalar<T>::bits(kind));
break;
}
}
}
- return FoldElementalIntrinsic<T, T, T, Int4>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, T, Int4>(kind, {kind, kind, 4}, context,
+ std::move(funcRef),
ScalarFunc<T, T, T, Int4>(
[&fptr](const Scalar<T> &i, const Scalar<T> &j,
const Scalar<Int4> &shift) -> Scalar<T> {
@@ -676,14 +699,14 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
} else {
common::die("missing case to fold intrinsic function %s", name.c_str());
}
- return FoldElementalIntrinsic<T, T, T>(
- context, std::move(funcRef), ScalarFunc<T, T, T>(fptr));
+ return FoldElementalIntrinsic<T, T, T>(kind, {kind, kind}, context,
+ std::move(funcRef), ScalarFunc<T, T, T>(fptr));
} else if (name == "iall") {
- return FoldBitReduction(
- context, std::move(funcRef), &Scalar<T>::IAND, Scalar<T>{}.NOT());
+ return FoldBitReduction(context, std::move(funcRef), &Scalar<T>::IAND,
+ Scalar<T>{kind, 0}.NOT());
} else if (name == "iany") {
return FoldBitReduction(
- context, std::move(funcRef), &Scalar<T>::IOR, Scalar<T>{});
+ context, std::move(funcRef), &Scalar<T>::IOR, Scalar<T>{kind, 0});
} else if (name == "ibclr" || name == "ibset") {
// Second argument can be of any kind. However, it must be smaller
// than BIT_SIZE. It can be converted to Int4 to simplify.
@@ -694,9 +717,9 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
} else {
common::die("missing case to fold intrinsic function %s", name.c_str());
}
- if (const auto *argCon{Folder<T>(context).Folding(args[0])};
+ if (const auto *argCon{Folder<T>(kind, context).Folding(args[0])};
argCon && argCon->empty()) {
- } else if (const auto *posCon{Folder<Int4>(context).Folding(args[1])}) {
+ } else if (const auto *posCon{Folder<Int4>(4, context).Folding(args[1])}) {
for (const auto &scalar : posCon->values()) {
std::int64_t posVal{scalar.ToInt64()};
if (posVal < 0) {
@@ -704,23 +727,24 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
"bit position for %s (%jd) is negative"_err_en_US, name,
std::intmax_t{posVal});
break;
- } else if (posVal >= T::Scalar::bits) {
+ } else if (posVal >= Scalar<T>::bits(kind)) {
context.messages().Say(
"bit position for %s (%jd) is not less than %d"_err_en_US, name,
- std::intmax_t{posVal}, T::Scalar::bits);
+ std::intmax_t{posVal}, Scalar<T>::bits(kind));
break;
}
}
}
- return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, Int4>(kind, {kind, 4}, context,
+ std::move(funcRef),
ScalarFunc<T, T, Int4>(
[&](const Scalar<T> &i, const Scalar<Int4> &pos) -> Scalar<T> {
return std::invoke(fptr, i, static_cast<int>(pos.ToInt64()));
}));
} else if (name == "ibits") {
- const auto *posCon{Folder<Int4>(context).Folding(args[1])};
- const auto *lenCon{Folder<Int4>(context).Folding(args[2])};
- if (const auto *argCon{Folder<T>(context).Folding(args[0])};
+ const auto *posCon{Folder<Int4>(4, context).Folding(args[1])};
+ const auto *lenCon{Folder<Int4>(4, context).Folding(args[2])};
+ if (const auto *argCon{Folder<T>(kind, context).Folding(args[0])};
argCon && argCon->empty()) {
} else {
std::size_t posCt{posCon ? posCon->size() : 0};
@@ -743,15 +767,16 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
"bit length for IBITS(LEN=%jd) is negative"_err_en_US,
std::intmax_t{lenVal});
break;
- } else if (posVal + lenVal > T::Scalar::bits) {
+ } else if (posVal + lenVal > Scalar<T>::bits(kind)) {
context.messages().Say(
"IBITS() must have POS+LEN (>=%jd) no greater than %d"_err_en_US,
- std::intmax_t{posVal + lenVal}, T::Scalar::bits);
+ std::intmax_t{posVal + lenVal}, Scalar<T>::bits(kind));
break;
}
}
}
- return FoldElementalIntrinsic<T, T, Int4, Int4>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, Int4, Int4>(kind, {kind, 4, 4}, context,
+ std::move(funcRef),
ScalarFunc<T, T, Int4, Int4>(
[&](const Scalar<T> &i, const Scalar<Int4> &pos,
const Scalar<Int4> &len) -> Scalar<T> {
@@ -768,7 +793,7 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
if (derived->IsEnumerationType()) {
if (auto ordExpr{GetEnumerationOrdinal(*derivedExpr)}) {
if (auto ordVal{ToInt64(*ordExpr)}) {
- return Expr<T>{Constant<T>{Scalar<T>{*ordVal}}};
+ return MakeConstantExpr<T>(kind, *ordVal);
}
}
// Non-constant enumeration argument — leave unfolded
@@ -782,7 +807,7 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
using From = std::decay_t<decltype(x)>;
if constexpr (std::is_same_v<From, BOZLiteralConstant> ||
IsNumericCategoryExpr<From>()) {
- return Fold(context, ConvertToType<T>(std::move(x)));
+ return Fold(context, ConvertToType<T>(kind, std::move(x)));
}
DIE("int() argument type not valid");
},
@@ -790,13 +815,13 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
}
} else if (name == "iparity") {
return FoldBitReduction(
- context, std::move(funcRef), &Scalar<T>::IEOR, Scalar<T>{});
+ context, std::move(funcRef), &Scalar<T>::IEOR, Scalar<T>{kind, 0});
} else if (name == "ishft" || name == "ishftc") {
- const auto *argCon{Folder<T>(context).Folding(args[0])};
- const auto *shiftCon{Folder<Int4>(context).Folding(args[1])};
+ const auto *argCon{Folder<T>(kind, context).Folding(args[0])};
+ const auto *shiftCon{Folder<Int4>(4, context).Folding(args[1])};
const auto *shiftVals{shiftCon ? &shiftCon->values() : nullptr};
const auto *sizeCon{args.size() == 3
- ? Folder<Int4>{context, /*forOptionalArgument=*/true}.Folding(
+ ? Folder<Int4>{4, context, /*forOptionalArgument=*/true}.Folding(
args[2])
: nullptr};
const auto *sizeVals{sizeCon ? &sizeCon->values() : nullptr};
@@ -806,15 +831,15 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
} else {
for (const auto &scalar : *shiftVals) {
std::int64_t shiftVal{scalar.ToInt64()};
- if (shiftVal < -T::Scalar::bits) {
+ if (shiftVal < -Scalar<T>::bits(kind)) {
context.messages().Say(
"SHIFT=%jd count for %s is less than %d"_err_en_US,
- std::intmax_t{shiftVal}, name, -T::Scalar::bits);
+ std::intmax_t{shiftVal}, name, -Scalar<T>::bits(kind));
break;
- } else if (shiftVal > T::Scalar::bits) {
+ } else if (shiftVal > Scalar<T>::bits(kind)) {
context.messages().Say(
"SHIFT=%jd count for %s is greater than %d"_err_en_US,
- std::intmax_t{shiftVal}, name, T::Scalar::bits);
+ std::intmax_t{shiftVal}, name, Scalar<T>::bits(kind));
break;
}
}
@@ -826,10 +851,10 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
"SIZE=%jd count for ishftc is not positive"_err_en_US,
std::intmax_t{sizeVal}, name);
break;
- } else if (sizeVal > T::Scalar::bits) {
+ } else if (sizeVal > Scalar<T>::bits(kind)) {
context.messages().Say(
"SIZE=%jd count for ishftc is greater than %d"_err_en_US,
- std::intmax_t{sizeVal}, T::Scalar::bits);
+ std::intmax_t{sizeVal}, Scalar<T>::bits(kind));
break;
}
}
@@ -852,20 +877,22 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
}
}
if (name == "ishft") {
- return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, Int4>(kind, {kind, 4}, context,
+ std::move(funcRef),
ScalarFunc<T, T, Int4>(
[&](const Scalar<T> &i, const Scalar<Int4> &shift) -> Scalar<T> {
return i.ISHFT(static_cast<int>(shift.ToInt64()));
}));
} else if (!args.at(2)) { // ISHFTC(no SIZE=)
- return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, Int4>(kind, {kind, 4}, context,
+ std::move(funcRef),
ScalarFunc<T, T, Int4>(
[&](const Scalar<T> &i, const Scalar<Int4> &shift) -> Scalar<T> {
return i.ISHFTC(static_cast<int>(shift.ToInt64()));
}));
} else { // ISHFTC(with SIZE=)
- return FoldElementalIntrinsic<T, T, Int4, Int4>(context,
- std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, Int4, Int4>(kind, {kind, 4, 4},
+ context, std::move(funcRef),
ScalarFunc<T, T, Int4, Int4>(
[&](const Scalar<T> &i, const Scalar<Int4> &shift,
const Scalar<Int4> &size) -> Scalar<T> {
@@ -880,10 +907,10 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
if (auto *expr{UnwrapExpr<Expr<SomeKind<T::category>>>(args[0])}) {
// Rewrite to IAND(INT(n,k),255_k) for k=KIND(T)
intrinsic->name = "iand";
- auto converted{ConvertToType<T>(std::move(*expr))};
+ auto converted{ConvertToType<T>(kind, std::move(*expr))};
*expr =
Fold(context, Expr<SomeKind<T::category>>{std::move(converted)});
- args.emplace_back(AsGenericExpr(Expr<T>{Scalar<T>{255}}));
+ args.emplace_back(AsGenericExpr(MakeConstantExpr<T>(kind, 255)));
return FoldIntrinsicFunction(context, std::move(funcRef));
}
}
@@ -893,36 +920,38 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
// It can be safely converted to Int4 to simplify.
const auto fptr{name == "maskl" || name == "umaskl" ? &Scalar<T>::MASKL
: &Scalar<T>::MASKR};
- return FoldElementalIntrinsic<T, Int4>(context, std::move(funcRef),
- ScalarFunc<T, Int4>([&fptr](const Scalar<Int4> &places) -> Scalar<T> {
- return fptr(static_cast<int>(places.ToInt64()));
- }));
+ return FoldElementalIntrinsic<T, Int4>(kind, {4}, context,
+ std::move(funcRef),
+ ScalarFunc<T, Int4>(
+ [&fptr, kind](const Scalar<Int4> &places) -> Scalar<T> {
+ return fptr(kind, static_cast<int>(places.ToInt64()));
+ }));
} else if (name == "matmul") {
return FoldMatmul(context, std::move(funcRef));
} else if (name == "max") {
return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
} else if (name == "maxval") {
- return FoldMaxvalMinval<T>(context, std::move(funcRef),
+ return FoldMaxvalMinval<T>(kind, context, std::move(funcRef),
RelationalOperator::GT,
T::category == TypeCategory::Unsigned ? typename T::Scalar{}
- : T::Scalar::Least());
+ : T::Scalar::Least(kind));
} else if (name == "merge_bits") {
- return FoldElementalIntrinsic<T, T, T, T>(
- context, std::move(funcRef), &Scalar<T>::MERGE_BITS);
+ return FoldElementalIntrinsic<T, T, T, T>(kind, {kind, kind, kind}, context,
+ std::move(funcRef), &Scalar<T>::MERGE_BITS);
} else if (name == "min") {
return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
} else if (name == "minval") {
- return FoldMaxvalMinval<T>(context, std::move(funcRef),
+ return FoldMaxvalMinval<T>(kind, context, std::move(funcRef),
RelationalOperator::LT,
T::category == TypeCategory::Unsigned ? typename T::Scalar{}.NOT()
- : T::Scalar::HUGE());
+ : T::Scalar::HUGE(kind));
} else if (name == "not") {
return FoldElementalIntrinsic<T, T>(
- context, std::move(funcRef), &Scalar<T>::NOT);
+ kind, {kind}, context, std::move(funcRef), &Scalar<T>::NOT);
} else if (name == "product") {
- return FoldProduct<T>(context, std::move(funcRef), Scalar<T>{1});
+ return FoldProduct<T>(context, std::move(funcRef), Scalar<T>{kind, 1});
} else if (name == "radix") {
- return Expr<T>{2};
+ return Expr<T>{Constant<T>{kind, typename T::Scalar{kind, 2}}};
} else if (name == "shifta" || name == "shiftr" || name == "shiftl") {
// Second argument can be of any kind. However, it must be smaller or
// equal than BIT_SIZE. It can be converted to Int4 to simplify.
@@ -935,24 +964,26 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
} else {
common::die("missing case to fold intrinsic function %s", name.c_str());
}
- if (const auto *argCon{Folder<T>(context).Folding(args[0])};
+ if (const auto *argCon{Folder<T>(kind, context).Folding(args[0])};
argCon && argCon->empty()) {
- } else if (const auto *shiftCon{Folder<Int4>(context).Folding(args[1])}) {
+ } else if (const auto *shiftCon{
+ Folder<Int4>(4, context).Folding(args[1])}) {
for (const auto &scalar : shiftCon->values()) {
std::int64_t shiftVal{scalar.ToInt64()};
if (shiftVal < 0) {
context.messages().Say("SHIFT=%jd count for %s is negative"_err_en_US,
- std::intmax_t{shiftVal}, name, -T::Scalar::bits);
+ std::intmax_t{shiftVal}, name, -Scalar<T>::bits(kind));
break;
- } else if (shiftVal > T::Scalar::bits) {
+ } else if (shiftVal > Scalar<T>::bits(kind)) {
context.messages().Say(
"SHIFT=%jd count for %s is greater than %d"_err_en_US,
- std::intmax_t{shiftVal}, name, T::Scalar::bits);
+ std::intmax_t{shiftVal}, name, Scalar<T>::bits(kind));
break;
}
}
}
- return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, Int4>(kind, {kind, 4}, context,
+ std::move(funcRef),
ScalarFunc<T, T, Int4>(
[&](const Scalar<T> &i, const Scalar<Int4> &shift) -> Scalar<T> {
return std::invoke(fptr, i, static_cast<int>(shift.ToInt64()));
@@ -963,22 +994,21 @@ std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
return std::nullopt;
}
-template <int KIND>
-Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
- FoldingContext &context,
- FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
+Expr<Type<TypeCategory::Integer>> FoldIntrinsicFunction(FoldingContext &context,
+ FunctionRef<Type<TypeCategory::Integer>> &&funcRef) {
+ using T = Type<TypeCategory::Integer>;
+ const int kind{funcRef.kind()};
if (auto foldedCommon{FoldIntrinsicFunctionCommon(context, funcRef)}) {
return std::move(*foldedCommon);
}
- using T = Type<TypeCategory::Integer, KIND>;
ActualArguments &args{funcRef.arguments()};
auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
CHECK(intrinsic);
std::string name{intrinsic->name};
- auto FromInt64{[&name, &context](std::int64_t n) {
- Scalar<T> result{n};
+ auto FromInt64{[&name, &context, kind](std::int64_t n) {
+ Scalar<T> result{kind, n};
if (result.ToInt64() != n) {
context.Warn(common::UsageWarning::FoldingException,
"Result of intrinsic function '%s' (%jd) overflows its result type"_warn_en_US,
@@ -988,12 +1018,13 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}};
if (name == "abs") { // incl. babs, iiabs, jiaabs, & kiabs
- return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
- ScalarFunc<T, T>([&context](const Scalar<T> &i) -> Scalar<T> {
+ return FoldElementalIntrinsic<T, T>(kind, {kind}, context,
+ std::move(funcRef),
+ ScalarFunc<T, T>([&context, kind](const Scalar<T> &i) -> Scalar<T> {
typename Scalar<T>::ValueWithOverflow j{i.ABS()};
if (j.overflow) {
context.Warn(common::UsageWarning::FoldingException,
- "abs(integer(kind=%d)) folding overflowed"_warn_en_US, KIND);
+ "abs(integer(kind=%d)) folding overflowed"_warn_en_US, kind);
}
return j.value;
}));
@@ -1006,9 +1037,9 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return common::visit(
[&](const auto &kx) {
using TR = ResultType<decltype(kx)>;
- return FoldElementalIntrinsic<T, TR>(context, std::move(funcRef),
- ScalarFunc<T, TR>([&](const Scalar<TR> &x) {
- auto y{x.template ToInteger<Scalar<T>>(mode)};
+ return FoldElementalIntrinsic<T, TR>(kind, {kx.kind()}, context,
+ std::move(funcRef), ScalarFunc<T, TR>([&](const Scalar<TR> &x) {
+ auto y{x.ToInteger(mode, Scalar<T>::bits(kind))};
if (y.flags.test(RealFlag::Overflow)) {
context.Warn(common::UsageWarning::FoldingException,
"%s intrinsic folding overflow"_warn_en_US, name);
@@ -1019,20 +1050,10 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
cx->u);
}
} else if (name == "count") {
- int maskKind = args[0]->GetType()->kind();
- switch (maskKind) {
- SWITCH_COVERS_ALL_CASES
- case 1:
- return FoldCount<T, 1>(context, std::move(funcRef));
- case 2:
- return FoldCount<T, 2>(context, std::move(funcRef));
- case 4:
- return FoldCount<T, 4>(context, std::move(funcRef));
- case 8:
- return FoldCount<T, 8>(context, std::move(funcRef));
- }
+ return FoldCount<T>(context, std::move(funcRef));
} else if (name == "dim") {
- return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, T>(kind, {kind, kind}, context,
+ std::move(funcRef),
ScalarFunc<T, T, T>(
[&context](const Scalar<T> &x, const Scalar<T> &y) -> Scalar<T> {
auto result{x.DIM(y)};
@@ -1045,10 +1066,10 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
} else if (name == "exponent") {
if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
return common::visit(
- [&funcRef, &context](const auto &x) -> Expr<T> {
+ [&funcRef, &context, kind](const auto &x) -> Expr<T> {
using TR = typename std::decay_t<decltype(x)>::Result;
- return FoldElementalIntrinsic<T, TR>(context, std::move(funcRef),
- &Scalar<TR>::template EXPONENT<Scalar<T>>);
+ return FoldElementalIntrinsic<T, TR>(kind, {x.kind()}, context,
+ std::move(funcRef), &Scalar<TR>::EXPONENT);
},
sx->u);
} else {
@@ -1057,7 +1078,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
} else if (name == "findloc") {
return FoldLocation<WhichLocation::Findloc, T>(context, std::move(funcRef));
} else if (name == "huge") {
- return Expr<T>{Scalar<T>::HUGE()};
+ return MakeConstantExpr<T>(kind, Scalar<T>::HUGE(kind));
} else if (name == "iachar" || name == "ichar") {
auto *someChar{UnwrapExpr<Expr<SomeCharacter>>(args[0])};
CHECK(someChar);
@@ -1074,16 +1095,15 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
name);
}
return common::visit(
- [&funcRef, &context, &FromInt64](const auto &str) -> Expr<T> {
+ [&funcRef, &context, &FromInt64, kind](const auto &str) -> Expr<T> {
using Char = typename std::decay_t<decltype(str)>::Result;
- (void)FromInt64;
- return FoldElementalIntrinsic<T, Char>(context,
- std::move(funcRef),
+ return FoldElementalIntrinsic<T, Char>(kind, {str.kind()},
+ context, std::move(funcRef),
ScalarFunc<T, Char>(
#ifndef _MSC_VER
[&FromInt64](const Scalar<Char> &c) {
- return FromInt64(CharacterUtils<Char::kind>::ICHAR(
- CharacterUtils<Char::kind>::Resize(c, 1)));
+ return FromInt64(CharacterUtils::ICHAR(
+ CharacterUtils::Resize(c, 1)));
}));
#else // _MSC_VER
// MSVC 14 get confused by the original code above and
@@ -1092,9 +1112,10 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
// CharacterUtils<2>::ICHAR(). Can't find a work-around,
// so remove the FromInt64 error checking lambda that
// seems to have caused the proble.
- [](const Scalar<Char> &c) {
- return CharacterUtils<Char::kind>::ICHAR(
- CharacterUtils<Char::kind>::Resize(c, 1));
+ [kind](const Scalar<Char> &c) -> Scalar<T> {
+ return Scalar<T>{kind,
+ CharacterUtils::ICHAR(
+ CharacterUtils::Resize(c, 1))};
}));
#endif // _MSC_VER
},
@@ -1106,33 +1127,34 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return common::visit(
[&](const auto &kch) -> Expr<T> {
using TC = typename std::decay_t<decltype(kch)>::Result;
+ const int kchKind{kch.kind()};
if (UnwrapExpr<Expr<SomeLogical>>(args[2])) { // BACK=
- return FoldElementalIntrinsic<T, TC, TC, LogicalResult>(context,
+ return FoldElementalIntrinsic<T, TC, TC, LogicalResult>(kind,
+ {kchKind, kchKind, LogicalResultKind}, context,
std::move(funcRef),
ScalarFunc<T, TC, TC, LogicalResult>{
[&name, &FromInt64](const Scalar<TC> &str,
const Scalar<TC> &other,
const Scalar<LogicalResult> &back) {
return FromInt64(name == "index"
- ? CharacterUtils<TC::kind>::INDEX(
- str, other, back.IsTrue())
- : name == "scan"
- ? CharacterUtils<TC::kind>::SCAN(
+ ? CharacterUtils::INDEX(
str, other, back.IsTrue())
- : CharacterUtils<TC::kind>::VERIFY(
- str, other, back.IsTrue()));
+ : name == "scan" ? CharacterUtils::SCAN(str,
+ other, back.IsTrue())
+ : CharacterUtils::VERIFY(str,
+ other, back.IsTrue()));
}});
} else {
- return FoldElementalIntrinsic<T, TC, TC>(context,
- std::move(funcRef),
+ return FoldElementalIntrinsic<T, TC, TC>(kind, {kchKind, kchKind},
+ context, std::move(funcRef),
ScalarFunc<T, TC, TC>{
[&name, &FromInt64](
const Scalar<TC> &str, const Scalar<TC> &other) {
return FromInt64(name == "index"
- ? CharacterUtils<TC::kind>::INDEX(str, other)
+ ? CharacterUtils::INDEX(str, other)
: name == "scan"
- ? CharacterUtils<TC::kind>::SCAN(str, other)
- : CharacterUtils<TC::kind>::VERIFY(str, other));
+ ? CharacterUtils::SCAN(str, other)
+ : CharacterUtils::VERIFY(str, other));
}});
}
},
@@ -1141,7 +1163,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
DIE("first argument must be CHARACTER");
}
} else if (name == "int_ptr_kind") {
- return Expr<T>{8};
+ return MakeConstantExpr<T>(kind, 8);
} else if (name == "kind") {
// FoldOperation(FunctionRef &&) in fold-implementation.h will not
// have folded the argument; in the case of TypeParamInquiry,
@@ -1152,12 +1174,12 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
if (const auto *intrinType{typeSpec->AsIntrinsic()}) {
if (auto k{ToInt64(Fold(
context, Expr<SubscriptInteger>{intrinType->kind()}))}) {
- return Expr<T>{*k};
+ return MakeConstantExpr<T>(kind, *k);
}
}
}
} else if (auto dyType{expr->GetType()}) {
- return Expr<T>{dyType->kind()};
+ return MakeConstantExpr<T>(kind, dyType->kind());
}
}
} else if (name == "lbound") {
@@ -1168,12 +1190,13 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
name == "popcnt") {
if (auto *sn{UnwrapExpr<Expr<SomeKind<T::category>>>(args[0])}) {
return common::visit(
- [&funcRef, &context, &name](const auto &n) -> Expr<T> {
+ [&funcRef, &context, &name, kind](const auto &n) -> Expr<T> {
using TI = typename std::decay_t<decltype(n)>::Result;
if (name == "poppar") {
- return FoldElementalIntrinsic<T, TI>(context, std::move(funcRef),
- ScalarFunc<T, TI>([](const Scalar<TI> &i) -> Scalar<T> {
- return Scalar<T>{i.POPPAR() ? 1 : 0};
+ return FoldElementalIntrinsic<T, TI>(kind, {n.kind()}, context,
+ std::move(funcRef),
+ ScalarFunc<T, TI>([kind](const Scalar<TI> &i) -> Scalar<T> {
+ return Scalar<T>{kind, i.POPPAR() ? 1 : 0};
}));
}
auto fptr{&Scalar<TI>::LEADZ};
@@ -1186,12 +1209,13 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
common::die(
"missing case to fold intrinsic function %s", name.c_str());
}
- return FoldElementalIntrinsic<T, TI>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, TI>(kind, {n.kind()}, context,
+ std::move(funcRef),
// `i` should be declared as `const Scalar<TI>&`.
// We declare it as `auto` to workaround an msvc bug:
// https://developercommunity.visualstudio.com/t/Regression:-nested-closure-assumes-wrong/10130223
- ScalarFunc<T, TI>([&fptr](const auto &i) -> Scalar<T> {
- return Scalar<T>{std::invoke(fptr, i)};
+ ScalarFunc<T, TI>([&fptr, kind](const auto &i) -> Scalar<T> {
+ return Scalar<T>{kind, std::invoke(fptr, i)};
}));
},
sn->u);
@@ -1204,7 +1228,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
[&](auto &kx) {
if (auto len{kx.LEN()}) {
if (IsScopeInvariantExpr(*len, &context)) {
- return Fold(context, ConvertToType<T>(*std::move(len)));
+ return Fold(context, ConvertToType<T>(kind, *std::move(len)));
} else {
return Expr<T>{std::move(funcRef)};
}
@@ -1221,9 +1245,10 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return common::visit(
[&](const auto &kch) -> Expr<T> {
using TC = typename std::decay_t<decltype(kch)>::Result;
- return FoldElementalIntrinsic<T, TC>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, TC>(kind, {kch.kind()}, context,
+ std::move(funcRef),
ScalarFunc<T, TC>{[&FromInt64](const Scalar<TC> &str) {
- return FromInt64(CharacterUtils<TC::kind>::LEN_TRIM(str));
+ return FromInt64(CharacterUtils::LEN_TRIM(str));
}});
},
charExpr->u);
@@ -1235,9 +1260,9 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
} else if (name == "maxexponent") {
if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
return common::visit(
- [](const auto &x) {
+ [&](const auto &x) {
using TR = typename std::decay_t<decltype(x)>::Result;
- return Expr<T>{Scalar<TR>::MAXEXPONENT};
+ return MakeConstantExpr<T>(kind, Scalar<TR>::MAXEXPONENT(x.kind()));
},
sx->u);
}
@@ -1248,9 +1273,9 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
} else if (name == "minexponent") {
if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
return common::visit(
- [](const auto &x) {
+ [&](const auto &x) {
using TR = typename std::decay_t<decltype(x)>::Result;
- return Expr<T>{Scalar<TR>::MINEXPONENT};
+ return MakeConstantExpr<T>(kind, Scalar<TR>::MINEXPONENT(x.kind()));
},
sx->u);
}
@@ -1267,7 +1292,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
badPConst = true;
}
}
- return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, T>(kind, {kind, kind}, context,
+ std::move(funcRef),
ScalarFuncWithContext<T, T, T>(
[badPConst](FoldingContext &context, const Scalar<T> &x,
const Scalar<T> &y) -> Scalar<T> {
@@ -1292,7 +1318,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
badPConst = true;
}
}
- return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, T>(kind, {kind, kind}, context,
+ std::move(funcRef),
ScalarFuncWithContext<T, T, T>([badPConst](FoldingContext &context,
const Scalar<T> &x,
const Scalar<T> &y) -> Scalar<T> {
@@ -1305,43 +1332,55 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}));
} else if (name == "precision") {
if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
- return Expr<T>{common::visit(
- [](const auto &kx) {
- return Scalar<ResultType<decltype(kx)>>::PRECISION;
- },
- cx->u)};
+ return MakeConstantExpr<T>(kind,
+ common::visit(
+ [](const auto &kx) -> std::int64_t {
+ using KX = ResultType<decltype(kx)>;
+ return Scalar<KX>::PRECISION(kx.kind());
+ },
+ cx->u));
} else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
- return Expr<T>{common::visit(
- [](const auto &kx) {
- return Scalar<typename ResultType<decltype(kx)>::Part>::PRECISION;
- },
- cx->u)};
+ return MakeConstantExpr<T>(kind,
+ common::visit(
+ [](const auto &kx) -> std::int64_t {
+ using Part = typename ResultType<decltype(kx)>::Part;
+ return Scalar<Part>::PRECISION(kx.kind());
+ },
+ cx->u));
}
} else if (name == "range") {
if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
- return Expr<T>{common::visit(
- [](const auto &kx) {
- return Scalar<ResultType<decltype(kx)>>::RANGE;
- },
- cx->u)};
+ return MakeConstantExpr<T>(kind,
+ common::visit(
+ [](const auto &kx) -> std::int64_t {
+ using KX = ResultType<decltype(kx)>;
+ return Scalar<KX>::RANGE(kx.kind());
+ },
+ cx->u));
} else if (const auto *cx{UnwrapExpr<Expr<SomeUnsigned>>(args[0])}) {
- return Expr<T>{common::visit(
- [](const auto &kx) {
- return Scalar<ResultType<decltype(kx)>>::UnsignedRANGE;
- },
- cx->u)};
+ return MakeConstantExpr<T>(kind,
+ common::visit(
+ [](const auto &kx) -> std::int64_t {
+ using KX = ResultType<decltype(kx)>;
+ return Scalar<KX>::UnsignedRANGE(kx.kind());
+ },
+ cx->u));
} else if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
- return Expr<T>{common::visit(
- [](const auto &kx) {
- return Scalar<ResultType<decltype(kx)>>::RANGE;
- },
- cx->u)};
+ return MakeConstantExpr<T>(kind,
+ common::visit(
+ [](const auto &kx) -> std::int64_t {
+ using KX = ResultType<decltype(kx)>;
+ return Scalar<KX>::RANGE(kx.kind());
+ },
+ cx->u));
} else if (const auto *cx{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
- return Expr<T>{common::visit(
- [](const auto &kx) {
- return Scalar<typename ResultType<decltype(kx)>::Part>::RANGE;
- },
- cx->u)};
+ return MakeConstantExpr<T>(kind,
+ common::visit(
+ [](const auto &kx) -> std::int64_t {
+ using Part = typename ResultType<decltype(kx)>::Part;
+ return Scalar<Part>::RANGE(kx.kind());
+ },
+ cx->u));
}
} else if (name == "rank") {
if (args[0]) {
@@ -1352,55 +1391,58 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
symbol = args[0]->GetAssumedTypeDummy();
}
if (symbol && IsAssumedRank(*symbol)) {
- // DescriptorInquiry can only be placed in expression of kind
- // DescriptorInquiry::Result::kind.
- return ConvertToType<T>(
- Expr<Type<TypeCategory::Integer, DescriptorInquiry::Result::kind>>{
- DescriptorInquiry{
- NamedEntity{*symbol}, DescriptorInquiry::Field::Rank}});
+ return ConvertToType<T>(kind,
+ Expr<DescriptorInquiry::Result>{DescriptorInquiry{
+ NamedEntity{*symbol}, DescriptorInquiry::Field::Rank}});
}
- return Expr<T>{args[0]->Rank()};
+ return MakeConstantExpr<T>(kind, args[0]->Rank());
}
} else if (name == "selected_char_kind") {
- if (const auto *chCon{UnwrapExpr<Constant<TypeOf<std::string>>>(args[0])}) {
- if (std::optional<std::string> value{chCon->GetScalarValue()}) {
+ if (const auto *chCon{
+ UnwrapExpr<Constant<Type<TypeCategory::Character>>>(args[0])}) {
+ if (std::optional<value::CharacterValue> charVal{
+ chCon->GetScalarValue()}) {
int defaultKind{
context.defaults().GetDefaultKind(TypeCategory::Character)};
- return Expr<T>{SelectedCharKind(*value, defaultKind)};
+ return MakeConstantExpr<T>(
+ kind, SelectedCharKind(*charVal->AsStdString(), defaultKind));
}
}
} else if (name == "selected_int_kind" || name == "selected_unsigned_kind") {
if (auto p{ToInt64(args[0])}) {
- return Expr<T>{context.targetCharacteristics().SelectedIntKind(*p)};
+ return MakeConstantExpr<T>(
+ kind, context.targetCharacteristics().SelectedIntKind(*p));
}
} else if (name == "selected_logical_kind") {
if (auto p{ToInt64(args[0])}) {
- return Expr<T>{context.targetCharacteristics().SelectedLogicalKind(*p)};
+ return MakeConstantExpr<T>(
+ kind, context.targetCharacteristics().SelectedLogicalKind(*p));
}
} else if (name == "selected_real_kind" ||
name == "__builtin_ieee_selected_real_kind") {
if (auto p{GetInt64ArgOr(args[0], 0)}) {
if (auto r{GetInt64ArgOr(args[1], 0)}) {
if (auto radix{GetInt64ArgOr(args[2], 2)}) {
- return Expr<T>{
- context.targetCharacteristics().SelectedRealKind(*p, *r, *radix)};
+ return MakeConstantExpr<T>(kind,
+ context.targetCharacteristics().SelectedRealKind(*p, *r, *radix));
}
}
}
} else if (name == "shape") {
if (auto shape{GetContextFreeShape(context, args[0])}) {
if (auto shapeExpr{AsExtentArrayExpr(*shape)}) {
- return Fold(context, ConvertToType<T>(std::move(*shapeExpr)));
+ return Fold(context, ConvertToType<T>(kind, std::move(*shapeExpr)));
}
}
} else if (name == "sign") {
- return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
- ScalarFunc<T, T, T>([&context](const Scalar<T> &j,
+ return FoldElementalIntrinsic<T, T, T>(kind, {kind, kind}, context,
+ std::move(funcRef),
+ ScalarFunc<T, T, T>([&context, kind](const Scalar<T> &j,
const Scalar<T> &k) -> Scalar<T> {
typename Scalar<T>::ValueWithOverflow result{j.SIGN(k)};
if (result.overflow) {
context.Warn(common::UsageWarning::FoldingException,
- "sign(integer(kind=%d)) folding overflowed"_warn_en_US, KIND);
+ "sign(integer(kind=%d)) folding overflowed"_warn_en_US, kind);
}
return result.value;
}));
@@ -1413,31 +1455,34 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return MakeInvalidIntrinsic<T>(std::move(funcRef));
} else if (dim) {
if (auto &extent{shape->at(*dim)}) {
- return Fold(context, ConvertToType<T>(std::move(*extent)));
+ return Fold(context, ConvertToType<T>(kind, std::move(*extent)));
}
}
} else if (auto extents{common::AllElementsPresent(std::move(*shape))}) {
// DIM= is absent; compute PRODUCT(SHAPE())
- ExtentExpr product{1};
+ ExtentExpr product{MakeExtentExpr(1)};
for (auto &&extent : std::move(*extents)) {
product = std::move(product) * std::move(extent);
}
- return Expr<T>{ConvertToType<T>(Fold(context, std::move(product)))};
+ return Expr<T>{
+ ConvertToType<T>(kind, Fold(context, std::move(product)))};
}
}
} else if (name == "sizeof") { // in bytes; extension
if (auto info{
characteristics::TypeAndShape::Characterize(args[0], context)}) {
if (auto bytes{info->MeasureSizeInBytes(context)}) {
- return Expr<T>{Fold(context, ConvertToType<T>(std::move(*bytes)))};
+ return Expr<T>{
+ Fold(context, ConvertToType<T>(kind, std::move(*bytes)))};
}
}
} else if (name == "storage_size") { // in bits
if (auto info{
characteristics::TypeAndShape::Characterize(args[0], context)}) {
if (auto bytes{info->MeasureElementSizeInBytes(context, true)}) {
- return Expr<T>{
- Fold(context, Expr<T>{8} * ConvertToType<T>(std::move(*bytes)))};
+ return Expr<T>{Fold(context,
+ MakeConstantExpr<T>(kind, 8) *
+ ConvertToType<T>(kind, std::move(*bytes)))};
}
}
} else if (name == "ubound") {
@@ -1463,26 +1508,26 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
common::UsageWarning::FoldingValueChecks, *context.moduleFileName(),
"NUMERIC_STORAGE_SIZE from ISO_FORTRAN_ENV is not well-defined when default INTEGER and REAL are not consistent due to compiler options"_warn_en_US);
}
- return Expr<T>{8 * std::min(intBytes, realBytes)};
+ return MakeConstantExpr<T>(kind, 8 * std::min(intBytes, realBytes));
}
}
return Expr<T>{std::move(funcRef)};
}
-template <int KIND>
-Expr<Type<TypeCategory::Unsigned, KIND>> FoldIntrinsicFunction(
+Expr<Type<TypeCategory::Unsigned>> FoldIntrinsicFunction(
FoldingContext &context,
- FunctionRef<Type<TypeCategory::Unsigned, KIND>> &&funcRef) {
+ FunctionRef<Type<TypeCategory::Unsigned>> &&funcRef) {
+ using T = Type<TypeCategory::Unsigned>;
+ const int kind{funcRef.kind()};
if (auto foldedCommon{FoldIntrinsicFunctionCommon(context, funcRef)}) {
return std::move(*foldedCommon);
}
- using T = Type<TypeCategory::Unsigned, KIND>;
ActualArguments &args{funcRef.arguments()};
auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
CHECK(intrinsic);
std::string name{intrinsic->name};
if (name == "huge") {
- return Expr<T>{Scalar<T>{}.NOT()};
+ return MakeConstantExpr<T>(kind, Scalar<T>::Zero(kind).NOT());
} else if (name == "mod" || name == "modulo") {
bool badPConst{false};
if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
@@ -1494,7 +1539,8 @@ Expr<Type<TypeCategory::Unsigned, KIND>> FoldIntrinsicFunction(
badPConst = true;
}
}
- return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, T>(kind, {kind, kind}, context,
+ std::move(funcRef),
ScalarFuncWithContext<T, T, T>(
[badPConst, &name](FoldingContext &context, const Scalar<T> &x,
const Scalar<T> &y) -> Scalar<T> {
@@ -1528,7 +1574,8 @@ Expr<TypeParamInquiry::Result> FoldOperation(
if (paramExpr && IsConstantExpr(*paramExpr, &context)) {
Expr<SomeInteger> intExpr{*paramExpr};
return Fold(context,
- ConvertToType<TypeParamInquiry::Result>(std::move(intExpr)));
+ ConvertToType<TypeParamInquiry::Result>(
+ TypeParamInquiry::ResultKind, std::move(intExpr)));
}
}
}
@@ -1550,7 +1597,8 @@ Expr<TypeParamInquiry::Result> FoldOperation(
(!isLen || ToInt64(*initExpr))) {
Expr<SomeInteger> expr{*initExpr};
return Fold(context,
- ConvertToType<TypeParamInquiry::Result>(std::move(expr)));
+ ConvertToType<TypeParamInquiry::Result>(
+ TypeParamInquiry::ResultKind, std::move(expr)));
}
}
}
@@ -1559,6 +1607,7 @@ Expr<TypeParamInquiry::Result> FoldOperation(
if (value->isExplicit()) {
auto folded{Fold(context,
AsExpr(ConvertToType<TypeParamInquiry::Result>(
+ TypeParamInquiry::ResultKind,
Expr<SomeInteger>{value->GetExplicit().value()})))};
if (!isLen || ToInt64(folded)) {
return folded;
@@ -1578,7 +1627,8 @@ Expr<RankOneBoundElement::Result> FoldOperation(
// Base is a constant array; extract the element at dimension_ (0-based).
ConstantSubscripts at{c->lbounds()};
at[0] = c->lbounds()[0] + x.dimension();
- return Expr<ResultType>{Constant<ResultType>{c->At(at)}};
+ return MakeConstantExpr<ResultType>(
+ RankOneBoundElement::ResultKind, c->At(at));
}
return Expr<ResultType>{
RankOneBoundElement{std::move(folded), x.dimension()}};
diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp
index ab8c5876a13f5..f8fe642f38536 100644
--- a/flang/lib/Evaluate/fold-logical.cpp
+++ b/flang/lib/Evaluate/fold-logical.cpp
@@ -18,25 +18,28 @@ template <typename T>
static std::optional<Expr<SomeType>> ZeroExtend(const Constant<T> &c) {
std::vector<Scalar<LargestInt>> exts;
for (const auto &v : c.values()) {
- exts.push_back(Scalar<LargestInt>::ConvertUnsigned(v).value);
+ exts.push_back(Scalar<LargestInt>::ConvertUnsigned(
+ v, Scalar<LargestInt>::bits(LargestIntKind))
+ .value);
}
- return AsGenericExpr(
- Constant<LargestInt>(std::move(exts), ConstantSubscripts(c.shape())));
+ return AsGenericExpr(Constant<LargestInt>{
+ LargestIntKind, std::move(exts), ConstantSubscripts{c.shape()}});
}
// for ALL, ANY & PARITY
template <typename T>
-static Expr<T> FoldAllAnyParity(FoldingContext &context, FunctionRef<T> &&ref,
+static Expr<T> FoldAllAnyParity(int kind, FoldingContext &context,
+ FunctionRef<T> &&ref,
Scalar<T> (Scalar<T>::*operation)(const Scalar<T> &) const,
Scalar<T> identity) {
static_assert(T::category == TypeCategory::Logical);
std::optional<int> dim;
if (std::optional<ArrayAndMask<T>> arrayAndMask{
- ProcessReductionArgs<T>(context, ref.arguments(), dim,
+ ProcessReductionArgs<T>(kind, context, ref.arguments(), dim,
/*ARRAY(MASK)=*/0, /*DIM=*/1)}) {
OperationAccumulator accumulator{arrayAndMask->array, operation};
- return Expr<T>{DoReduction<T>(
- arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)};
+ return Expr<T>{DoReduction<T>(kind, arrayAndMask->array, arrayAndMask->mask,
+ dim, identity, accumulator)};
}
return Expr<T>{std::move(ref)};
}
@@ -46,22 +49,22 @@ static Expr<T> FoldAllAnyParity(FoldingContext &context, FunctionRef<T> &&ref,
// are constant. It is guaranteed that 'x' is evaluated at most once.
// TODO: unsigned
-template <int X_RKIND, int MOLD_IKIND>
-Expr<SomeReal> RealToIntBoundHelper(bool round, bool negate) {
- using RType = Type<TypeCategory::Real, X_RKIND>;
- using RealType = Scalar<RType>;
- using IntType = Scalar<Type<TypeCategory::Integer, MOLD_IKIND>>;
- RealType result{}; // 0.
+static Expr<SomeReal> RealToIntBound(
+ int xRKind, int moldIKind, bool round, bool negate) {
+ using RealType = Scalar<Type<TypeCategory::Real>>;
+ using IntType = Scalar<Type<TypeCategory::Integer>>;
+ RealType result{RealType::Zero(xRKind)}; // 0.
common::RoundingMode roundingMode{round
? common::RoundingMode::TiesAwayFromZero
: common::RoundingMode::ToZero};
// Add decreasing powers of two to the result to find the largest magnitude
// value that can be converted to the integer type without overflow.
- RealType at{RealType::FromInteger(IntType{negate ? -1 : 1}).value};
+ RealType at{
+ RealType::FromInteger(xRKind, IntType{moldIKind, negate ? -1 : 1}).value};
bool decrement{true};
- while (!at.template ToInteger<IntType>(roundingMode)
- .flags.test(RealFlag::Overflow)) {
- auto tmp{at.SCALE(IntType{1})};
+ while (!at.ToInteger(roundingMode, IntType::bits(moldIKind))
+ .flags.test(RealFlag::Overflow)) {
+ auto tmp{at.SCALE(IntType{moldIKind, 1})};
if (tmp.flags.test(RealFlag::Overflow)) {
decrement = false;
break;
@@ -70,64 +73,20 @@ Expr<SomeReal> RealToIntBoundHelper(bool round, bool negate) {
}
while (true) {
if (decrement) {
- at = at.SCALE(IntType{-1}).value;
+ at = at.SCALE(IntType{moldIKind, -1}).value;
} else {
decrement = true;
}
auto tmp{at.Add(result)};
if (tmp.flags.test(RealFlag::Inexact)) {
break;
- } else if (!tmp.value.template ToInteger<IntType>(roundingMode)
- .flags.test(RealFlag::Overflow)) {
+ } else if (!tmp.value.ToInteger(roundingMode, IntType::bits(moldIKind))
+ .flags.test(RealFlag::Overflow)) {
result = tmp.value;
}
}
- return AsCategoryExpr(Constant<RType>{std::move(result)});
-}
-
-static Expr<SomeReal> RealToIntBound(
- int xRKind, int moldIKind, bool round, bool negate) {
- switch (xRKind) {
-#define ICASES(RK) \
- switch (moldIKind) { \
- case 1: \
- return RealToIntBoundHelper<RK, 1>(round, negate); \
- break; \
- case 2: \
- return RealToIntBoundHelper<RK, 2>(round, negate); \
- break; \
- case 4: \
- return RealToIntBoundHelper<RK, 4>(round, negate); \
- break; \
- case 8: \
- return RealToIntBoundHelper<RK, 8>(round, negate); \
- break; \
- case 16: \
- return RealToIntBoundHelper<RK, 16>(round, negate); \
- break; \
- } \
- break
- case 2:
- ICASES(2);
- break;
- case 3:
- ICASES(3);
- break;
- case 4:
- ICASES(4);
- break;
- case 8:
- ICASES(8);
- break;
- case 10:
- ICASES(10);
- break;
- case 16:
- ICASES(16);
- break;
- }
- DIE("RealToIntBound: no case");
-#undef ICASES
+ return AsCategoryExpr(
+ Constant<Type<TypeCategory::Real>>{xRKind, std::move(result)});
}
class RealToIntLimitHelper {
@@ -137,9 +96,9 @@ class RealToIntLimitHelper {
RealToIntLimitHelper(
FoldingContext &context, Expr<SomeReal> &&hi, Expr<SomeReal> &lo)
: context_{context}, hi_{std::move(hi)}, lo_{lo} {}
- template <typename T> Result Test() {
- if (UnwrapExpr<Expr<T>>(hi_)) {
- bool promote{T::kind < 16};
+ template <typename T> Result Test(int kind) {
+ if (UnwrapExpr<Expr<T>>(kind, hi_)) {
+ bool promote{kind < 16};
Result constResult;
if (auto hiV{GetScalarConstantValue<T>(hi_)}) {
auto loV{GetScalarConstantValue<T>(lo_)};
@@ -148,13 +107,15 @@ class RealToIntLimitHelper {
promote = promote &&
(diff.flags.test(RealFlag::Overflow) ||
diff.flags.test(RealFlag::Inexact));
- constResult = AsCategoryExpr(Constant<T>{std::move(diff.value)});
+ constResult = AsCategoryExpr(Constant<T>{kind, std::move(diff.value)});
}
if (promote) {
- constexpr int nextKind{T::kind < 4 ? 4 : T::kind == 4 ? 8 : 16};
- using T2 = Type<TypeCategory::Real, nextKind>;
- hi_ = Expr<SomeReal>{Fold(context_, ConvertToType<T2>(std::move(hi_)))};
- lo_ = Expr<SomeReal>{Fold(context_, ConvertToType<T2>(std::move(lo_)))};
+ int nextKind{kind < 4 ? 4 : kind == 4 ? 8 : 16};
+ using T2 = Type<TypeCategory::Real>;
+ hi_ = Expr<SomeReal>{
+ Fold(context_, ConvertToType<T2>(nextKind, std::move(hi_)))};
+ lo_ = Expr<SomeReal>{
+ Fold(context_, ConvertToType<T2>(nextKind, std::move(lo_)))};
if (constResult) {
// Use promoted constants on next iteration of SearchTypes
return std::nullopt;
@@ -178,84 +139,37 @@ class RealToIntLimitHelper {
static std::optional<Expr<SomeReal>> RealToIntLimit(
FoldingContext &context, Expr<SomeReal> &&hi, Expr<SomeReal> &lo) {
- return common::SearchTypes(RealToIntLimitHelper{context, std::move(hi), lo});
+ return SearchTypes(RealToIntLimitHelper{context, std::move(hi), lo});
}
// RealToRealBounds() returns a pair (HUGE(x),REAL(HUGE(mold),KIND(x)))
// when REAL(HUGE(x),KIND(mold)) overflows, and std::nullopt otherwise.
-template <int X_RKIND, int MOLD_RKIND>
-std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>>
-RealToRealBoundsHelper() {
- using RType = Type<TypeCategory::Real, X_RKIND>;
- using RealType = Scalar<RType>;
- using MoldRealType = Scalar<Type<TypeCategory::Real, MOLD_RKIND>>;
- if (!MoldRealType::Convert(RealType::HUGE()).flags.test(RealFlag::Overflow)) {
- return std::nullopt;
- } else {
- return std::make_pair(AsCategoryExpr(Constant<RType>{
- RealType::Convert(MoldRealType::HUGE()).value}),
- AsCategoryExpr(Constant<RType>{RealType::HUGE()}));
- }
-}
-
static std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>>
RealToRealBounds(int xRKind, int moldRKind) {
- switch (xRKind) {
-#define RCASES(RK) \
- switch (moldRKind) { \
- case 2: \
- return RealToRealBoundsHelper<RK, 2>(); \
- break; \
- case 3: \
- return RealToRealBoundsHelper<RK, 3>(); \
- break; \
- case 4: \
- return RealToRealBoundsHelper<RK, 4>(); \
- break; \
- case 8: \
- return RealToRealBoundsHelper<RK, 8>(); \
- break; \
- case 10: \
- return RealToRealBoundsHelper<RK, 10>(); \
- break; \
- case 16: \
- return RealToRealBoundsHelper<RK, 16>(); \
- break; \
- } \
- break
- case 2:
- RCASES(2);
- break;
- case 3:
- RCASES(3);
- break;
- case 4:
- RCASES(4);
- break;
- case 8:
- RCASES(8);
- break;
- case 10:
- RCASES(10);
- break;
- case 16:
- RCASES(16);
- break;
+ using RType = Type<TypeCategory::Real>;
+ using RealType = Scalar<Type<TypeCategory::Real>>;
+ using MoldRealType = Scalar<Type<TypeCategory::Real>>;
+ if (!RealType::Convert(moldRKind, RealType::HUGE(xRKind))
+ .flags.test(RealFlag::Overflow)) {
+ return std::nullopt;
+ } else {
+ return std::make_pair(
+ AsCategoryExpr(Constant<RType>{xRKind,
+ RealType::Convert(xRKind, MoldRealType::HUGE(moldRKind)).value}),
+ AsCategoryExpr(Constant<RType>{xRKind, RealType::HUGE(xRKind)}));
}
- DIE("RealToRealBounds: no case");
-#undef RCASES
}
-template <int X_IKIND, int MOLD_RKIND>
-std::optional<Expr<SomeInteger>> IntToRealBoundHelper(bool negate) {
- using IType = Type<TypeCategory::Integer, X_IKIND>;
- using IntType = Scalar<IType>;
- using RealType = Scalar<Type<TypeCategory::Real, MOLD_RKIND>>;
- IntType result{}; // 0
+static std::optional<Expr<SomeInteger>> IntToRealBoundHelper(
+ int xIKind, int moldRKind, bool negate) {
+ using IType = Type<TypeCategory::Integer>;
+ using IntType = Scalar<Type<TypeCategory::Integer>>;
+ using RealType = Scalar<Type<TypeCategory::Real>>;
+ IntType result{xIKind, 0}; // 0
while (true) {
std::optional<IntType> next;
- for (int bit{0}; bit < IntType::bits; ++bit) {
- IntType power{IntType{}.IBSET(bit)};
+ for (int bit{0}; bit < IntType::bits(xIKind); ++bit) {
+ IntType power{IntType{xIKind, 0}.IBSET(bit)};
if (power.IsNegative()) {
if (!negate) {
break;
@@ -265,7 +179,8 @@ std::optional<Expr<SomeInteger>> IntToRealBoundHelper(bool negate) {
}
auto tmp{power.AddSigned(result)};
if (tmp.overflow ||
- RealType::FromInteger(tmp.value).flags.test(RealFlag::Overflow)) {
+ RealType::FromInteger(moldRKind, tmp.value)
+ .flags.test(RealFlag::Overflow)) {
break;
}
next = tmp.value;
@@ -277,112 +192,37 @@ std::optional<Expr<SomeInteger>> IntToRealBoundHelper(bool negate) {
break;
}
}
- if (result.CompareSigned(IntType::HUGE()) == Ordering::Equal) {
+ if (result.CompareSigned(IntType::HUGE(xIKind)) == Ordering::Equal) {
return std::nullopt;
} else {
- return AsCategoryExpr(Constant<IType>{std::move(result)});
+ return AsCategoryExpr(Constant<IType>{xIKind, std::move(result)});
}
}
static std::optional<Expr<SomeInteger>> IntToRealBound(
int xIKind, int moldRKind, bool negate) {
- switch (xIKind) {
-#define RCASES(IK) \
- switch (moldRKind) { \
- case 2: \
- return IntToRealBoundHelper<IK, 2>(negate); \
- break; \
- case 3: \
- return IntToRealBoundHelper<IK, 3>(negate); \
- break; \
- case 4: \
- return IntToRealBoundHelper<IK, 4>(negate); \
- break; \
- case 8: \
- return IntToRealBoundHelper<IK, 8>(negate); \
- break; \
- case 10: \
- return IntToRealBoundHelper<IK, 10>(negate); \
- break; \
- case 16: \
- return IntToRealBoundHelper<IK, 16>(negate); \
- break; \
- } \
- break
- case 1:
- RCASES(1);
- break;
- case 2:
- RCASES(2);
- break;
- case 4:
- RCASES(4);
- break;
- case 8:
- RCASES(8);
- break;
- case 16:
- RCASES(16);
- break;
- }
- DIE("IntToRealBound: no case");
-#undef RCASES
+ return IntToRealBoundHelper(xIKind, moldRKind, negate);
}
-template <int X_IKIND, int MOLD_IKIND>
-std::optional<Expr<SomeInteger>> IntToIntBoundHelper() {
- if constexpr (X_IKIND <= MOLD_IKIND) {
+static std::optional<Expr<SomeInteger>> IntToIntBoundHelper(
+ int xIKind, int moldIKind) {
+ if (xIKind <= moldIKind) {
return std::nullopt;
} else {
- using XIType = Type<TypeCategory::Integer, X_IKIND>;
+ using XIType = Type<TypeCategory::Integer>;
using IntegerType = Scalar<XIType>;
- using MoldIType = Type<TypeCategory::Integer, MOLD_IKIND>;
+ using MoldIType = Type<TypeCategory::Integer>;
using MoldIntegerType = Scalar<MoldIType>;
- return AsCategoryExpr(Constant<XIType>{
- IntegerType::ConvertSigned(MoldIntegerType::HUGE()).value});
+ return AsCategoryExpr(Constant<XIType>{xIKind,
+ IntegerType::ConvertSigned(
+ MoldIntegerType::HUGE(moldIKind), Scalar<XIType>::bits(xIKind))
+ .value});
}
}
static std::optional<Expr<SomeInteger>> IntToIntBound(
int xIKind, int moldIKind) {
- switch (xIKind) {
-#define ICASES(IK) \
- switch (moldIKind) { \
- case 1: \
- return IntToIntBoundHelper<IK, 1>(); \
- break; \
- case 2: \
- return IntToIntBoundHelper<IK, 2>(); \
- break; \
- case 4: \
- return IntToIntBoundHelper<IK, 4>(); \
- break; \
- case 8: \
- return IntToIntBoundHelper<IK, 8>(); \
- break; \
- case 16: \
- return IntToIntBoundHelper<IK, 16>(); \
- break; \
- } \
- break
- case 1:
- ICASES(1);
- break;
- case 2:
- ICASES(2);
- break;
- case 4:
- ICASES(4);
- break;
- case 8:
- ICASES(8);
- break;
- case 16:
- ICASES(16);
- break;
- }
- DIE("IntToIntBound: no case");
-#undef ICASES
+ return IntToIntBoundHelper(xIKind, moldIKind);
}
// ApplyIntrinsic() constructs the typed expression representation
@@ -397,10 +237,10 @@ class IntrinsicCallHelper {
}
using Result = std::optional<Expr<SomeType>>;
using Types = LengthlessIntrinsicTypes;
- template <typename T> Result Test() {
+ template <typename T> Result Test(int kind) {
if (T::category == typeAndShape_->type().category() &&
- T::kind == typeAndShape_->type().kind()) {
- return AsGenericExpr(FunctionRef<T>{
+ kind == typeAndShape_->type().kind()) {
+ return AsGenericExpr(FunctionRef<T>{typeAndShape_->type().kind(),
ProcedureDesignator{std::move(call_.specificIntrinsic)},
std::move(call_.arguments)});
} else {
@@ -420,7 +260,7 @@ static Expr<SomeType> ApplyIntrinsic(
auto found{
context.intrinsics().Probe(CallCharacteristics{func}, args, context)};
CHECK(found.has_value());
- auto result{common::SearchTypes(IntrinsicCallHelper{std::move(*found)})};
+ auto result{SearchTypes(IntrinsicCallHelper{std::move(*found)})};
CHECK(result.has_value());
return *result;
}
@@ -446,8 +286,10 @@ static Expr<SomeType> IntTransferMold(
if (asVector) {
shape = ConstantSubscripts{1};
}
- Constant<SubscriptInteger> value{
- std::vector<Scalar<SubscriptInteger>>{0}, std::move(shape)};
+ Constant<SubscriptInteger> value{SubscriptIntegerKind,
+ std::vector<Scalar<SubscriptInteger>>{
+ Scalar<SubscriptInteger>{SubscriptIntegerKind, 0}},
+ std::move(shape)};
auto expr{ConvertToType(iType, AsGenericExpr(std::move(value)))};
CHECK(expr.has_value());
return std::move(*expr);
@@ -463,11 +305,11 @@ static Expr<SomeType> GetRealBits(FoldingContext &context, Expr<SomeReal> &&x) {
context.targetCharacteristics(), *xType, asVector)}});
}
-template <int KIND>
-static Expr<Type<TypeCategory::Logical, KIND>> RewriteOutOfRange(
+static Expr<Type<TypeCategory::Logical>> RewriteOutOfRange(
FoldingContext &context,
- FunctionRef<Type<TypeCategory::Logical, KIND>> &&funcRef) {
- using ResultType = Type<TypeCategory::Logical, KIND>;
+ FunctionRef<Type<TypeCategory::Logical>> &&funcRef) {
+ using ResultType = Type<TypeCategory::Logical>;
+ const int resultKind{funcRef.kind()};
ActualArguments &args{funcRef.arguments()};
// Fold x= and round= unconditionally
if (auto *x{UnwrapExpr<Expr<SomeType>>(args[0])}) {
@@ -494,11 +336,11 @@ static Expr<Type<TypeCategory::Logical, KIND>> RewriteOutOfRange(
// 'hi' is INT(HUGE(mold), KIND(x))
// OUT_OF_RANGE(x,mold) = (x + (hi + 1)) .UGT. (2*hi + 1)
auto one{DEREF(UnwrapExpr<Expr<SomeInteger>>(ConvertToType(
- xType, AsGenericExpr(Constant<SubscriptInteger>{1}))))};
+ xType, AsGenericExpr(MakeSubscriptIntConstant(1)))))};
auto lhs{std::move(*iXExpr) +
(Expr<SomeInteger>{*hi} + Expr<SomeInteger>{one})};
auto two{DEREF(UnwrapExpr<Expr<SomeInteger>>(ConvertToType(
- xType, AsGenericExpr(Constant<SubscriptInteger>{2}))))};
+ xType, AsGenericExpr(MakeSubscriptIntConstant(2)))))};
auto rhs{std::move(two) * std::move(*hi) + std::move(one)};
result = CompareUnsigned(context, "bgt",
Expr<SomeType>{std::move(lhs)}, Expr<SomeType>{std::move(rhs)});
@@ -585,7 +427,7 @@ static Expr<Type<TypeCategory::Logical, KIND>> RewriteOutOfRange(
GetRealBits(context, std::move(absR) - std::move(moldHuge))};
auto &diffBitsI{DEREF(UnwrapExpr<Expr<SomeInteger>>(diffBits))};
Expr<SomeType> decr{std::move(diffBitsI) -
- Expr<SomeInteger>{Expr<SubscriptInteger>{1}}};
+ Expr<SomeInteger>{MakeSubscriptIntExpr(1)}};
result = CompareUnsigned(context, "blt", std::move(decr),
GetRealBits(context, std::move(xHuge)));
} else {
@@ -597,13 +439,11 @@ static Expr<Type<TypeCategory::Logical, KIND>> RewriteOutOfRange(
// xType can never overflow moldType, so
// OUT_OF_RANGE(x) = (x /= 0) .AND. .FALSE.
// which has the same shape as x.
- Expr<LogicalResult> scalarFalse{
- Constant<LogicalResult>{Scalar<LogicalResult>{false}}};
+ Expr<LogicalResult> scalarFalse{MakeLogicalResultExpr(false)};
if (x->Rank() > 0) {
if (auto nez{Relate(context.messages(), RelationalOperator::NE,
- std::move(*x),
- AsGenericExpr(Constant<SubscriptInteger>{0}))}) {
- result = Expr<LogicalResult>{LogicalOperation<LogicalResult::kind>{
+ std::move(*x), AsGenericExpr(MakeSubscriptIntConstant(0)))}) {
+ result = Expr<LogicalResult>{LogicalOperation{
LogicalOperator::And, std::move(*nez), std::move(scalarFalse)}};
}
} else {
@@ -612,8 +452,8 @@ static Expr<Type<TypeCategory::Logical, KIND>> RewriteOutOfRange(
}
if (result) {
auto restorer{context.messages().DiscardMessages()};
- return Fold(
- context, AsExpr(ConvertToType<ResultType>(std::move(*result))));
+ return Fold(context,
+ AsExpr(ConvertToType<ResultType>(resultKind, std::move(*result))));
}
}
}
@@ -638,29 +478,28 @@ static std::optional<common::RoundingMode> GetRoundingMode(
return std::nullopt;
}
-template <int KIND>
-Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
- FoldingContext &context,
- FunctionRef<Type<TypeCategory::Logical, KIND>> &&funcRef) {
- using T = Type<TypeCategory::Logical, KIND>;
+Expr<Type<TypeCategory::Logical>> FoldIntrinsicFunction(FoldingContext &context,
+ FunctionRef<Type<TypeCategory::Logical>> &&funcRef) {
+ using T = Type<TypeCategory::Logical>;
+ const int kind{funcRef.kind()};
ActualArguments &args{funcRef.arguments()};
auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
CHECK(intrinsic);
std::string name{intrinsic->name};
if (name == "all") {
- return FoldAllAnyParity(
- context, std::move(funcRef), &Scalar<T>::AND, Scalar<T>{true});
+ return FoldAllAnyParity(kind, context, std::move(funcRef), &Scalar<T>::AND,
+ Scalar<T>{kind, true});
} else if (name == "allocated") {
if (IsNullAllocatable(args[0]->UnwrapExpr())) {
- return Expr<T>{false};
+ return MakeConstantExpr<T>(kind, false);
}
} else if (name == "any") {
- return FoldAllAnyParity(
- context, std::move(funcRef), &Scalar<T>::OR, Scalar<T>{false});
+ return FoldAllAnyParity(kind, context, std::move(funcRef), &Scalar<T>::OR,
+ Scalar<T>{kind, false});
} else if (name == "associated") {
if (IsNullPointer(args[0]->UnwrapExpr()) ||
(args[1] && IsNullPointer(args[1]->UnwrapExpr()))) {
- return Expr<T>{false};
+ return MakeConstantExpr<T>(kind, false);
}
} else if (name == "bge" || name == "bgt" || name == "ble" || name == "blt") {
static_assert(std::is_same_v<Scalar<LargestInt>, BOZLiteralConstant>);
@@ -673,7 +512,9 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
std::optional<Expr<SomeType>> constArgs[2];
for (int i{0}; i <= 1; i++) {
if (BOZLiteralConstant * x{UnwrapExpr<BOZLiteralConstant>(args[i])}) {
- constArgs[i] = AsGenericExpr(Constant<LargestInt>{std::move(*x)});
+ // Copy rather than move: when only one operand is constant the fold
+ // below is skipped and args[i] must retain its original BOZ value.
+ constArgs[i] = AsGenericExpr(Constant<LargestInt>{LargestIntKind, *x});
} else if (auto *x{UnwrapExpr<Expr<SomeInteger>>(args[i])}) {
common::visit(
[&](const auto &ix) {
@@ -703,33 +544,33 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
*args[i] = std::move(constArgs[i].value());
}
- return FoldElementalIntrinsic<T, LargestInt, LargestInt>(context,
- std::move(funcRef),
+ return FoldElementalIntrinsic<T, LargestInt, LargestInt>(kind,
+ {LargestIntKind, LargestIntKind}, context, std::move(funcRef),
ScalarFunc<T, LargestInt, LargestInt>(
- [&fptr](
+ [&fptr, kind](
const Scalar<LargestInt> &i, const Scalar<LargestInt> &j) {
- return Scalar<T>{std::invoke(fptr, i, j)};
+ return Scalar<T>{kind, std::invoke(fptr, i, j)};
}));
} else {
return Expr<T>{std::move(funcRef)};
}
} else if (name == "btest") {
- using SameInt = Type<TypeCategory::Integer, KIND>;
+ using SameInt = Type<TypeCategory::Integer>;
if (const auto *ix{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
return common::visit(
[&](const auto &x) {
using IT = ResultType<decltype(x)>;
- return FoldElementalIntrinsic<T, IT, SameInt>(context,
- std::move(funcRef),
+ return FoldElementalIntrinsic<T, IT, SameInt>(kind,
+ {x.kind(), kind}, context, std::move(funcRef),
ScalarFunc<T, IT, SameInt>(
[&](const Scalar<IT> &x, const Scalar<SameInt> &pos) {
auto posVal{pos.ToInt64()};
- if (posVal < 0 || posVal >= x.bits) {
+ if (posVal < 0 || posVal >= x.bits()) {
context.messages().Say(
"POS=%jd out of range for BTEST"_err_en_US,
static_cast<std::intmax_t>(posVal));
}
- return Scalar<T>{x.BTEST(posVal)};
+ return Scalar<T>{kind, x.BTEST(posVal)};
}));
},
ix->u);
@@ -737,17 +578,17 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
return common::visit(
[&](const auto &x) {
using UT = ResultType<decltype(x)>;
- return FoldElementalIntrinsic<T, UT, SameInt>(context,
- std::move(funcRef),
+ return FoldElementalIntrinsic<T, UT, SameInt>(kind,
+ {x.kind(), kind}, context, std::move(funcRef),
ScalarFunc<T, UT, SameInt>(
[&](const Scalar<UT> &x, const Scalar<SameInt> &pos) {
auto posVal{pos.ToInt64()};
- if (posVal < 0 || posVal >= x.bits) {
+ if (posVal < 0 || posVal >= x.bits()) {
context.messages().Say(
"POS=%jd out of range for BTEST"_err_en_US,
static_cast<std::intmax_t>(posVal));
}
- return Scalar<T>{x.BTEST(posVal)};
+ return Scalar<T>{kind, x.BTEST(posVal)};
}));
},
ux->u);
@@ -762,7 +603,7 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
auto t1{args[1]->GetType()};
if (t0 && t1) {
if (auto result{t0->ExtendsTypeOf(*t1)}) {
- return Expr<T>{*result};
+ return MakeConstantExpr<T>(kind, *result);
}
}
}
@@ -771,31 +612,38 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
if (args[0] && args[0]->UnwrapExpr() &&
IsActuallyConstant(*args[0]->UnwrapExpr())) {
auto restorer{context.messages().DiscardMessages()};
- using DefaultReal = Type<TypeCategory::Real, 4>;
- return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
- ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
- return Scalar<T>{x.IsNotANumber()};
+ using DefaultReal = Type<TypeCategory::Real>;
+ constexpr int DefaultRealKind{4};
+ return FoldElementalIntrinsic<T, DefaultReal>(kind, {DefaultRealKind},
+ context, std::move(funcRef),
+ ScalarFunc<T, DefaultReal>([kind](const Scalar<DefaultReal> &x) {
+ return Scalar<T>{kind, x.IsNotANumber()};
}));
}
} else if (name == "__builtin_ieee_is_negative") {
auto restorer{context.messages().DiscardMessages()};
- using DefaultReal = Type<TypeCategory::Real, 4>;
+ using DefaultReal = Type<TypeCategory::Real>;
+ constexpr int DefaultRealKind{4};
if (args[0] && args[0]->UnwrapExpr() &&
IsActuallyConstant(*args[0]->UnwrapExpr())) {
- return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
- ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
- return Scalar<T>{x.IsNegative()};
+ return FoldElementalIntrinsic<T, DefaultReal>(kind, {DefaultRealKind},
+ context, std::move(funcRef),
+ ScalarFunc<T, DefaultReal>([kind](const Scalar<DefaultReal> &x) {
+ return Scalar<T>{kind, x.IsNegative()};
}));
}
} else if (name == "__builtin_ieee_is_normal") {
auto restorer{context.messages().DiscardMessages()};
- using DefaultReal = Type<TypeCategory::Real, 4>;
+ using DefaultReal = Type<TypeCategory::Real>;
+ constexpr int DefaultRealKind = 4;
if (args[0] && args[0]->UnwrapExpr() &&
IsActuallyConstant(*args[0]->UnwrapExpr())) {
- return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
- ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
- return Scalar<T>{x.IsNormal()};
- }));
+ return FoldElementalIntrinsic<T, DefaultReal>(kind, {DefaultRealKind},
+ context, std::move(funcRef),
+ ScalarFunc<T, DefaultReal>([kind](const Scalar<DefaultReal> &x) {
+ return Scalar<T>{kind, x.IsNormal()};
+ }),
+ /*hasOptionalArgument=*/false);
}
} else if (name == "is_contiguous") {
if (args.at(0)) {
@@ -812,25 +660,31 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
"is_contiguous() is always true for named constants and subobjects of named constants"_warn_en_US);
}
}
- return Expr<T>{*knownContiguous};
+ return MakeConstantExpr<T>(kind, *knownContiguous);
}
}
} else if (name == "is_iostat_end") {
if (args[0] && args[0]->UnwrapExpr() &&
IsActuallyConstant(*args[0]->UnwrapExpr())) {
- using Int64 = Type<TypeCategory::Integer, 8>;
- return FoldElementalIntrinsic<T, Int64>(context, std::move(funcRef),
- ScalarFunc<T, Int64>([](const Scalar<Int64> &x) {
- return Scalar<T>{x.ToInt64() == FORTRAN_RUNTIME_IOSTAT_END};
+ // Int64 used to be Type<Integer,8>; force the argument to that kind as
+ // before.
+ using Int64 = Type<TypeCategory::Integer>;
+ constexpr int Int64Kind{8};
+ return FoldElementalIntrinsic<T, Int64>(kind, {Int64Kind}, context,
+ std::move(funcRef),
+ ScalarFunc<T, Int64>([kind](const Scalar<Int64> &x) {
+ return Scalar<T>{kind, x.ToInt64() == FORTRAN_RUNTIME_IOSTAT_END};
}));
}
} else if (name == "is_iostat_eor") {
if (args[0] && args[0]->UnwrapExpr() &&
IsActuallyConstant(*args[0]->UnwrapExpr())) {
- using Int64 = Type<TypeCategory::Integer, 8>;
- return FoldElementalIntrinsic<T, Int64>(context, std::move(funcRef),
- ScalarFunc<T, Int64>([](const Scalar<Int64> &x) {
- return Scalar<T>{x.ToInt64() == FORTRAN_RUNTIME_IOSTAT_EOR};
+ using Int64 = Type<TypeCategory::Integer>;
+ constexpr int Int64Kind{8};
+ return FoldElementalIntrinsic<T, Int64>(kind, {Int64Kind}, context,
+ std::move(funcRef),
+ ScalarFunc<T, Int64>([kind](const Scalar<Int64> &x) {
+ return Scalar<T>{kind, x.ToInt64() == FORTRAN_RUNTIME_IOSTAT_EOR};
}));
}
} else if (name == "lge" || name == "lgt" || name == "lle" || name == "llt") {
@@ -839,25 +693,25 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
auto *cx1{UnwrapExpr<Expr<SomeCharacter>>(args[1])};
if (cx0 && cx1) {
return Fold(context,
- ConvertToType<T>(
+ ConvertToType<T>(kind,
PackageRelation(name == "lge" ? RelationalOperator::GE
: name == "lgt" ? RelationalOperator::GT
: name == "lle" ? RelationalOperator::LE
: RelationalOperator::LT,
- ConvertToType<Ascii>(std::move(*cx0)),
- ConvertToType<Ascii>(std::move(*cx1)))));
+ ConvertToType<Ascii>(AsciiKind, std::move(*cx0)),
+ ConvertToType<Ascii>(AsciiKind, std::move(*cx1)))));
}
} else if (name == "logical") {
if (auto *expr{UnwrapExpr<Expr<SomeLogical>>(args[0])}) {
- return Fold(context, ConvertToType<T>(std::move(*expr)));
+ return Fold(context, ConvertToType<T>(kind, std::move(*expr)));
}
} else if (name == "matmul") {
return FoldMatmul(context, std::move(funcRef));
} else if (name == "out_of_range") {
- return RewriteOutOfRange<KIND>(context, std::move(funcRef));
+ return RewriteOutOfRange(context, std::move(funcRef));
} else if (name == "parity") {
- return FoldAllAnyParity(
- context, std::move(funcRef), &Scalar<T>::NEQV, Scalar<T>{false});
+ return FoldAllAnyParity(kind, context, std::move(funcRef), &Scalar<T>::NEQV,
+ Scalar<T>{kind, false});
} else if (name == "same_type_as") {
// Type equality testing with SAME_TYPE_AS() ignores any type parameters.
// Returns a constant truth value when the result is known now.
@@ -866,18 +720,20 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
auto t1{args[1]->GetType()};
if (t0 && t1) {
if (auto result{t0->SameTypeAs(*t1)}) {
- return Expr<T>{*result};
+ return MakeConstantExpr<T>(kind, *result);
}
}
}
} else if (name == "__builtin_ieee_support_datatype") {
- return Expr<T>{true};
+ return MakeConstantExpr<T>(kind, true);
} else if (name == "__builtin_ieee_support_denormal") {
- return Expr<T>{context.targetCharacteristics().ieeeFeatures().test(
- IeeeFeature::Denormal)};
+ return MakeConstantExpr<T>(kind,
+ context.targetCharacteristics().ieeeFeatures().test(
+ IeeeFeature::Denormal));
} else if (name == "__builtin_ieee_support_divide") {
- return Expr<T>{context.targetCharacteristics().ieeeFeatures().test(
- IeeeFeature::Divide)};
+ return MakeConstantExpr<T>(kind,
+ context.targetCharacteristics().ieeeFeatures().test(
+ IeeeFeature::Divide));
} else if (name == "__builtin_ieee_support_flag") {
if (context.targetCharacteristics().ieeeFeatures().test(
IeeeFeature::Flags)) {
@@ -890,20 +746,22 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
if (auto flag{ToInt64(value)}) {
if (flag != _FORTRAN_RUNTIME_IEEE_DENORM) {
// Check for suppport for standard exceptions.
- return Expr<T>{
+ return MakeConstantExpr<T>(kind,
context.targetCharacteristics().ieeeFeatures().test(
- IeeeFeature::Flags)};
+ IeeeFeature::Flags));
} else if (args[1]) {
// Check for nonstandard ieee_denorm exception support for
// a given kind.
- return Expr<T>{context.targetCharacteristics()
+ return MakeConstantExpr<T>(kind,
+ context.targetCharacteristics()
.hasSubnormalExceptionSupport(
- args[1]->GetType().value().kind())};
+ args[1]->GetType().value().kind()));
} else {
// Check for nonstandard ieee_denorm exception support for
// all kinds.
- return Expr<T>{context.targetCharacteristics()
- .hasSubnormalExceptionSupport()};
+ return MakeConstantExpr<T>(kind,
+ context.targetCharacteristics()
+ .hasSubnormalExceptionSupport());
}
}
}
@@ -914,48 +772,52 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
} else if (name == "__builtin_ieee_support_halting") {
if (!context.targetCharacteristics()
.haltingSupportIsUnknownAtCompileTime()) {
- return Expr<T>{context.targetCharacteristics().ieeeFeatures().test(
- IeeeFeature::Halting)};
+ return MakeConstantExpr<T>(kind,
+ context.targetCharacteristics().ieeeFeatures().test(
+ IeeeFeature::Halting));
}
} else if (name == "__builtin_ieee_support_inf") {
- return Expr<T>{
- context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::Inf)};
+ return MakeConstantExpr<T>(kind,
+ context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::Inf));
} else if (name == "__builtin_ieee_support_io") {
- return Expr<T>{
- context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::Io)};
+ return MakeConstantExpr<T>(kind,
+ context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::Io));
} else if (name == "__builtin_ieee_support_nan") {
- return Expr<T>{
- context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::NaN)};
+ return MakeConstantExpr<T>(kind,
+ context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::NaN));
} else if (name == "__builtin_ieee_support_rounding") {
if (context.targetCharacteristics().ieeeFeatures().test(
IeeeFeature::Rounding)) {
if (auto mode{GetRoundingMode(args[0])}) {
- return Expr<T>{mode < common::RoundingMode::TiesAwayFromZero};
+ return MakeConstantExpr<T>(
+ kind, mode < common::RoundingMode::TiesAwayFromZero);
}
}
} else if (name == "__builtin_ieee_support_sqrt") {
- return Expr<T>{
- context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::Sqrt)};
+ return MakeConstantExpr<T>(kind,
+ context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::Sqrt));
} else if (name == "__builtin_ieee_support_standard") {
// ieee_support_standard depends in part on ieee_support_halting.
if (!context.targetCharacteristics()
.haltingSupportIsUnknownAtCompileTime()) {
- return Expr<T>{context.targetCharacteristics().ieeeFeatures().test(
- IeeeFeature::Standard)};
+ return MakeConstantExpr<T>(kind,
+ context.targetCharacteristics().ieeeFeatures().test(
+ IeeeFeature::Standard));
}
} else if (name == "__builtin_ieee_support_subnormal") {
- return Expr<T>{context.targetCharacteristics().ieeeFeatures().test(
- IeeeFeature::Subnormal)};
+ return MakeConstantExpr<T>(kind,
+ context.targetCharacteristics().ieeeFeatures().test(
+ IeeeFeature::Subnormal));
} else if (name == "__builtin_ieee_support_underflow_control") {
// Setting kind=0 checks subnormal flushing control across all type kinds.
if (args[0]) {
- return Expr<T>{
+ return MakeConstantExpr<T>(kind,
context.targetCharacteristics().hasSubnormalFlushingControl(
- args[0]->GetType().value().kind())};
+ args[0]->GetType().value().kind()));
} else {
- return Expr<T>{
+ return MakeConstantExpr<T>(kind,
context.targetCharacteristics().hasSubnormalFlushingControl(
- /*any=*/false)};
+ /*any=*/false));
}
}
return Expr<T>{std::move(funcRef)};
@@ -990,7 +852,7 @@ Expr<LogicalResult> FoldOperation(
} else {
static_assert(T::category != TypeCategory::Logical);
}
- return Expr<LogicalResult>{Constant<LogicalResult>{result}};
+ return MakeLogicalResultExpr(result);
}
return Expr<LogicalResult>{Relational<SomeType>{std::move(relation)}};
}
@@ -1004,28 +866,28 @@ Expr<LogicalResult> FoldOperation(
std::move(relation.u));
}
-template <int KIND>
-Expr<Type<TypeCategory::Logical, KIND>> FoldOperation(
- FoldingContext &context, Not<KIND> &&x) {
+Expr<Type<TypeCategory::Logical>> FoldOperation(
+ FoldingContext &context, Not &&x) {
if (auto array{ApplyElementwise(context, x)}) {
return *array;
}
- using Ty = Type<TypeCategory::Logical, KIND>;
+ using Ty = Type<TypeCategory::Logical>;
+ const int kind{x.kind()};
auto &operand{x.left()};
if (auto value{GetScalarConstantValue<Ty>(operand)}) {
- return Expr<Ty>{Constant<Ty>{!value->IsTrue()}};
+ return MakeConstantExpr<Ty>(kind, !value->IsTrue());
}
return Expr<Ty>{x};
}
-template <int KIND>
-Expr<Type<TypeCategory::Logical, KIND>> FoldOperation(
- FoldingContext &context, LogicalOperation<KIND> &&operation) {
- using LOGICAL = Type<TypeCategory::Logical, KIND>;
+Expr<Type<TypeCategory::Logical>> FoldOperation(
+ FoldingContext &context, LogicalOperation &&operation) {
+ using LOGICAL = Type<TypeCategory::Logical>;
+ const int kind{operation.kind()};
if (auto array{ApplyElementwise(context, operation,
std::function<Expr<LOGICAL>(Expr<LOGICAL> &&, Expr<LOGICAL> &&)>{
[=](Expr<LOGICAL> &&x, Expr<LOGICAL> &&y) {
- return Expr<LOGICAL>{LogicalOperation<KIND>{
+ return Expr<LOGICAL>{LogicalOperation{
operation.logicalOperator, std::move(x), std::move(y)}};
}})}) {
return *array;
@@ -1048,7 +910,7 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldOperation(
case LogicalOperator::Not:
DIE("not a binary operator");
}
- return Expr<LOGICAL>{Constant<LOGICAL>{result}};
+ return MakeConstantExpr<LOGICAL>(kind, result);
}
return Expr<LOGICAL>{std::move(operation)};
}
diff --git a/flang/lib/Evaluate/fold-matmul.h b/flang/lib/Evaluate/fold-matmul.h
index a8a24c09774e8..e0c58acdbb4bc 100644
--- a/flang/lib/Evaluate/fold-matmul.h
+++ b/flang/lib/Evaluate/fold-matmul.h
@@ -15,10 +15,11 @@ namespace Fortran::evaluate {
template <typename T>
static Expr<T> FoldMatmul(FoldingContext &context, FunctionRef<T> &&funcRef) {
+ const int kind{funcRef.kind()};
using Element = typename Constant<T>::Element;
auto args{funcRef.arguments()};
CHECK(args.size() == 2);
- Folder<T> folder{context};
+ Folder<T> folder{kind, context};
Constant<T> *ma{folder.Folding(args[0])};
Constant<T> *mb{folder.Folding(args[1])};
if (!ma || !mb) {
@@ -51,8 +52,8 @@ static Expr<T> FoldMatmul(FoldingContext &context, FunctionRef<T> &&funcRef) {
if (mb->Rank() == 2) {
bAt[1] += ci;
}
- Element sum{};
- [[maybe_unused]] Element correction{};
+ Element sum{Element::Zero(kind)};
+ [[maybe_unused]] Element correction{Element::Zero(kind)};
for (ConstantSubscript j{0}; j < commonExtent; ++j) {
Element aElt{ma->At(aAt)};
Element bElt{mb->At(bAt)};
@@ -90,7 +91,7 @@ static Expr<T> FoldMatmul(FoldingContext &context, FunctionRef<T> &&funcRef) {
if (overflow) {
context.Warn(common::UsageWarning::FoldingException,
"MATMUL of %s data overflowed during computation"_warn_en_US,
- T::AsFortran());
+ Type<T::category>(kind).AsFortran());
}
ConstantSubscripts shape;
if (ma->Rank() == 2) {
@@ -99,7 +100,7 @@ static Expr<T> FoldMatmul(FoldingContext &context, FunctionRef<T> &&funcRef) {
if (mb->Rank() == 2) {
shape.push_back(columns);
}
- return Expr<T>{Constant<T>{std::move(elements), std::move(shape)}};
+ return Expr<T>{Constant<T>{kind, std::move(elements), std::move(shape)}};
}
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_FOLD_MATMUL_H_
diff --git a/flang/lib/Evaluate/fold-real.cpp b/flang/lib/Evaluate/fold-real.cpp
index 9c591e2ef36ec..57b935ac05799 100644
--- a/flang/lib/Evaluate/fold-real.cpp
+++ b/flang/lib/Evaluate/fold-real.cpp
@@ -15,15 +15,17 @@ namespace Fortran::evaluate {
template <typename T>
static Expr<T> FoldTransformationalBessel(
FunctionRef<T> &&funcRef, FoldingContext &context) {
+ const int kind{funcRef.kind()};
CHECK(funcRef.arguments().size() == 3);
/// Bessel runtime functions use `int` integer arguments. Convert integer
/// arguments to Int4, any overflow error will be reported during the
/// conversion folding.
- using Int4 = Type<TypeCategory::Integer, 4>;
- if (auto args{GetConstantArguments<Int4, Int4, T>(
- context, funcRef.arguments(), /*hasOptionalArgument=*/false)}) {
+ using Int4 = Type<TypeCategory::Integer>;
+ if (auto args{GetConstantArguments<Int4, Int4, T>({4, 4, kind}, context,
+ funcRef.arguments(), /*hasOptionalArgument=*/false)}) {
const std::string &name{std::get<SpecificIntrinsic>(funcRef.proc().u).name};
- if (auto elementalBessel{GetHostRuntimeWrapper<T, Int4, T>(name)}) {
+ if (auto elementalBessel{
+ GetHostRuntimeWrapper<T, Int4, T>(kind, {4, kind}, name)}) {
std::vector<Scalar<T>> results;
int n1{static_cast<int>(
std::get<0>(*args)->GetScalarValue().value().ToInt64())};
@@ -31,27 +33,29 @@ static Expr<T> FoldTransformationalBessel(
std::get<1>(*args)->GetScalarValue().value().ToInt64())};
Scalar<T> x{std::get<2>(*args)->GetScalarValue().value()};
for (int i{n1}; i <= n2; ++i) {
- results.emplace_back((*elementalBessel)(context, Scalar<Int4>{i}, x));
+ results.emplace_back(
+ (*elementalBessel)(context, value::IntegerValue{4, i}, x));
}
- return Expr<T>{Constant<T>{
- std::move(results), ConstantSubscripts{std::max(n2 - n1 + 1, 0)}}};
+ return Expr<T>{Constant<T>{kind, std::move(results),
+ ConstantSubscripts{std::max(n2 - n1 + 1, 0)}}};
} else {
context.Warn(common::UsageWarning::FoldingFailure,
"%s(integer(kind=4), real(kind=%d)) cannot be folded on host"_warn_en_US,
- name, T::kind);
+ name, kind);
}
}
return Expr<T>{std::move(funcRef)};
}
// NORM2
-template <int KIND> class Norm2Accumulator {
- using T = Type<TypeCategory::Real, KIND>;
+class Norm2Accumulator {
+ using T = Type<TypeCategory::Real>;
public:
Norm2Accumulator(
const Constant<T> &array, const Constant<T> &maxAbs, Rounding rounding)
- : array_{array}, maxAbs_{maxAbs}, rounding_{rounding} {};
+ : array_{array}, maxAbs_{maxAbs}, rounding_{rounding},
+ correction_{Scalar<T>::Zero(array.kind())} {};
void operator()(
Scalar<T> &element, const ConstantSubscripts &at, bool /*first*/) {
// Summation of scaled elements:
@@ -103,44 +107,42 @@ template <int KIND> class Norm2Accumulator {
const Constant<T> &maxAbs_;
const Rounding rounding_;
bool overflow_{false};
- Scalar<T> correction_{};
+ Scalar<T> correction_;
ConstantSubscripts maxAbsAt_{maxAbs_.lbounds()};
};
-template <int KIND>
-static Expr<Type<TypeCategory::Real, KIND>> FoldNorm2(FoldingContext &context,
- FunctionRef<Type<TypeCategory::Real, KIND>> &&funcRef) {
- using T = Type<TypeCategory::Real, KIND>;
+static Expr<Type<TypeCategory::Real>> FoldNorm2(int kind,
+ FoldingContext &context, FunctionRef<Type<TypeCategory::Real>> &&funcRef) {
+ using T = Type<TypeCategory::Real>;
using Element = typename Constant<T>::Element;
std::optional<int> dim;
if (std::optional<ArrayAndMask<T>> arrayAndMask{
- ProcessReductionArgs<T>(context, funcRef.arguments(), dim,
+ ProcessReductionArgs<T>(kind, context, funcRef.arguments(), dim,
/*X=*/0, /*DIM=*/1)}) {
MaxvalMinvalAccumulator<T, /*ABS=*/true> maxAbsAccumulator{
- RelationalOperator::GT, context, arrayAndMask->array};
- const Element identity{};
- Constant<T> maxAbs{DoReduction<T>(arrayAndMask->array, arrayAndMask->mask,
- dim, identity, maxAbsAccumulator)};
+ kind, RelationalOperator::GT, context, arrayAndMask->array};
+ const Element identity{Element::Zero(kind)};
+ Constant<T> maxAbs{DoReduction<T>(kind, arrayAndMask->array,
+ arrayAndMask->mask, dim, identity, maxAbsAccumulator)};
Norm2Accumulator norm2Accumulator{arrayAndMask->array, maxAbs,
context.targetCharacteristics().roundingMode()};
- Constant<T> result{DoReduction<T>(arrayAndMask->array, arrayAndMask->mask,
- dim, identity, norm2Accumulator)};
+ Constant<T> result{DoReduction<T>(kind, arrayAndMask->array,
+ arrayAndMask->mask, dim, identity, norm2Accumulator)};
if (norm2Accumulator.overflow()) {
context.Warn(common::UsageWarning::FoldingException,
- "NORM2() of REAL(%d) data overflowed"_warn_en_US, KIND);
+ "NORM2() of REAL(%d) data overflowed"_warn_en_US, kind);
}
return Expr<T>{std::move(result)};
}
return Expr<T>{std::move(funcRef)};
}
-template <int KIND>
-Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
- FoldingContext &context,
- FunctionRef<Type<TypeCategory::Real, KIND>> &&funcRef) {
- using T = Type<TypeCategory::Real, KIND>;
- using ComplexT = Type<TypeCategory::Complex, KIND>;
- using Int4 = Type<TypeCategory::Integer, 4>;
+Expr<Type<TypeCategory::Real>> FoldIntrinsicFunction(
+ FoldingContext &context, FunctionRef<Type<TypeCategory::Real>> &&funcRef) {
+ const int kind{funcRef.kind()};
+ using T = Type<TypeCategory::Real>;
+ using ComplexT = Type<TypeCategory::Complex>;
+ using Int4 = Type<TypeCategory::Integer>;
ActualArguments &args{funcRef.arguments()};
auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
CHECK(intrinsic);
@@ -154,12 +156,12 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
name == "log_gamma" || name == "sin" || name == "sinh" || name == "tan" ||
name == "tanh") {
CHECK(args.size() == 1);
- if (auto callable{GetHostRuntimeWrapper<T, T>(name)}) {
+ if (auto callable{GetHostRuntimeWrapper<T, T>(kind, {kind}, name)}) {
return FoldElementalIntrinsic<T, T>(
- context, std::move(funcRef), *callable);
+ kind, {kind}, context, std::move(funcRef), *callable);
} else {
context.Warn(common::UsageWarning::FoldingFailure,
- "%s(real(kind=%d)) cannot be folded on host"_warn_en_US, name, KIND);
+ "%s(real(kind=%d)) cannot be folded on host"_warn_en_US, name, kind);
}
} else if (name == "amax0" || name == "amin0" || name == "amin1" ||
name == "amax1" || name == "dmin1" || name == "dmax1") {
@@ -167,24 +169,26 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
} else if (name == "atan" || name == "atan2") {
std::string localName{name == "atan" ? "atan2" : name};
CHECK(args.size() == 2);
- if (auto callable{GetHostRuntimeWrapper<T, T, T>(localName)}) {
+ if (auto callable{
+ GetHostRuntimeWrapper<T, T, T>(kind, {kind, kind}, localName)}) {
return FoldElementalIntrinsic<T, T, T>(
- context, std::move(funcRef), *callable);
+ kind, {kind, kind}, context, std::move(funcRef), *callable);
} else {
context.Warn(common::UsageWarning::FoldingFailure,
"%s(real(kind=%d), real(kind%d)) cannot be folded on host"_warn_en_US,
- name, KIND, KIND);
+ name, kind, kind);
}
} else if (name == "bessel_jn" || name == "bessel_yn") {
if (args.size() == 2) { // elemental
// runtime functions use int arg
- if (auto callable{GetHostRuntimeWrapper<T, Int4, T>(name)}) {
+ if (auto callable{
+ GetHostRuntimeWrapper<T, Int4, T>(kind, {4, kind}, name)}) {
return FoldElementalIntrinsic<T, Int4, T>(
- context, std::move(funcRef), *callable);
+ kind, {4, kind}, context, std::move(funcRef), *callable);
} else {
context.Warn(common::UsageWarning::FoldingFailure,
"%s(integer(kind=4), real(kind=%d)) cannot be folded on host"_warn_en_US,
- name, KIND);
+ name, kind);
}
} else {
return FoldTransformationalBessel<T>(std::move(funcRef), context);
@@ -193,9 +197,10 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
// Argument can be complex or real
if (UnwrapExpr<Expr<SomeReal>>(args[0])) {
return FoldElementalIntrinsic<T, T>(
- context, std::move(funcRef), &Scalar<T>::ABS);
+ kind, {kind}, context, std::move(funcRef), &Scalar<T>::ABS);
} else if (UnwrapExpr<Expr<SomeComplex>>(args[0])) {
- return FoldElementalIntrinsic<T, ComplexT>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, ComplexT>(kind, {kind}, context,
+ std::move(funcRef),
ScalarFunc<T, ComplexT>([&name, &context](
const Scalar<ComplexT> &z) -> Scalar<T> {
ValueWithRealFlags<Scalar<T>> y{z.ABS()};
@@ -217,7 +222,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
common::RoundingMode mode{name == "aint"
? common::RoundingMode::ToZero
: common::RoundingMode::TiesAwayFromZero};
- return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T>(kind, {kind}, context,
+ std::move(funcRef),
ScalarFunc<T, T>(
[&name, &context, mode](const Scalar<T> &x) -> Scalar<T> {
ValueWithRealFlags<Scalar<T>> y{x.ToWholeNumber(mode)};
@@ -228,7 +234,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
return y.value;
}));
} else if (name == "dim") {
- return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, T>(kind, {kind, kind}, context,
+ std::move(funcRef),
ScalarFunc<T, T, T>([&context](const Scalar<T> &x,
const Scalar<T> &y) -> Scalar<T> {
ValueWithRealFlags<Scalar<T>> result{x.DIM(y)};
@@ -247,21 +254,23 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
const auto *yExpr{args[1]->UnwrapExpr()};
if (xExpr && yExpr) {
return Fold(context,
- ToReal<T::kind>(context, common::Clone(*xExpr)) *
- ToReal<T::kind>(context, common::Clone(*yExpr)));
+ ToReal(kind, context, common::Clone(*xExpr)) *
+ ToReal(kind, context, common::Clone(*yExpr)));
}
}
} else if (name == "epsilon") {
- return Expr<T>{Scalar<T>::EPSILON()};
+ return MakeConstantExpr<T>(kind, Scalar<T>::EPSILON(kind));
} else if (name == "fraction") {
- return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T>(kind, {kind}, context,
+ std::move(funcRef),
ScalarFunc<T, T>(
[](const Scalar<T> &x) -> Scalar<T> { return x.FRACTION(); }));
} else if (name == "huge") {
- return Expr<T>{Scalar<T>::HUGE()};
+ return MakeConstantExpr<T>(kind, Scalar<T>::HUGE(kind));
} else if (name == "hypot") {
CHECK(args.size() == 2);
- return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, T>(kind, {kind, kind}, context,
+ std::move(funcRef),
ScalarFunc<T, T, T>(
[&](const Scalar<T> &x, const Scalar<T> &y) -> Scalar<T> {
ValueWithRealFlags<Scalar<T>> result{x.HYPOT(y)};
@@ -276,13 +285,13 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
} else if (name == "max") {
return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
} else if (name == "maxval") {
- return FoldMaxvalMinval<T>(context, std::move(funcRef),
- RelationalOperator::GT, T::Scalar::HUGE().Negate());
+ return FoldMaxvalMinval<T>(kind, context, std::move(funcRef),
+ RelationalOperator::GT, Scalar<T>::HUGE(kind).Negate());
} else if (name == "min") {
return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
} else if (name == "minval") {
- return FoldMaxvalMinval<T>(
- context, std::move(funcRef), RelationalOperator::LT, T::Scalar::HUGE());
+ return FoldMaxvalMinval<T>(kind, context, std::move(funcRef),
+ RelationalOperator::LT, Scalar<T>::HUGE(kind));
} else if (name == "mod") {
CHECK(args.size() == 2);
bool badPConst{false};
@@ -295,7 +304,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
badPConst = true;
}
}
- return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, T>(kind, {kind, kind}, context,
+ std::move(funcRef),
ScalarFunc<T, T, T>([&context, badPConst](const Scalar<T> &x,
const Scalar<T> &y) -> Scalar<T> {
auto result{x.MOD(y)};
@@ -317,7 +327,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
badPConst = true;
}
}
- return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, T>(kind, {kind, kind}, context,
+ std::move(funcRef),
ScalarFunc<T, T, T>([&context, badPConst](const Scalar<T> &x,
const Scalar<T> &y) -> Scalar<T> {
auto result{x.MODULO(y)};
@@ -341,7 +352,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
sConst->IsZero() ? "zero" : "NaN");
badSConst = true;
}
- return FoldElementalIntrinsic<T, T, TS>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, TS>(kind, {kind, sVal.kind()},
+ context, std::move(funcRef),
ScalarFunc<T, T, TS>([&](const Scalar<T> &x,
const Scalar<TS> &s) -> Scalar<T> {
if (!badSConst && (s.IsZero() || s.IsNotANumber())) {
@@ -360,16 +372,17 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
sExpr->u);
}
} else if (name == "norm2") {
- return FoldNorm2<T::kind>(context, std::move(funcRef));
+ return FoldNorm2(kind, context, std::move(funcRef));
} else if (name == "product") {
- auto one{Scalar<T>::FromInteger(value::Integer<8>{1}).value};
+ auto one{Scalar<T>::FromInteger(kind, value::IntegerValue{1, 1}).value};
return FoldProduct<T>(context, std::move(funcRef), one);
} else if (name == "real" || name == "dble") {
if (auto *expr{args[0].value().UnwrapExpr()}) {
- return ToReal<KIND>(context, std::move(*expr));
+ return ToReal(kind, context, std::move(*expr));
}
} else if (name == "rrspacing") {
- return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T>(kind, {kind}, context,
+ std::move(funcRef),
ScalarFunc<T, T>(
[](const Scalar<T> &x) -> Scalar<T> { return x.RRSPACING(); }));
} else if (name == "scale") {
@@ -377,12 +390,11 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
return common::visit(
[&](const auto &byVal) {
using TBY = ResultType<decltype(byVal)>;
- return FoldElementalIntrinsic<T, T, TBY>(context,
- std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, TBY>(kind, {kind, byVal.kind()},
+ context, std::move(funcRef),
ScalarFunc<T, T, TBY>(
[&](const Scalar<T> &x, const Scalar<TBY> &y) -> Scalar<T> {
- ValueWithRealFlags<Scalar<T>> result{
- x.template SCALE<Scalar<TBY>>(y)};
+ ValueWithRealFlags<Scalar<T>> result{x.SCALE(y)};
if (result.flags.test(RealFlag::Overflow)) {
context.Warn(common::UsageWarning::FoldingException,
"SCALE/IEEE_SCALB intrinsic folding overflow"_warn_en_US);
@@ -397,7 +409,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
return common::visit(
[&](const auto &iVal) {
using TY = ResultType<decltype(iVal)>;
- return FoldElementalIntrinsic<T, T, TY>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, TY>(kind, {kind, iVal.kind()},
+ context, std::move(funcRef),
ScalarFunc<T, T, TY>(
[&](const Scalar<T> &x, const Scalar<TY> &i) -> Scalar<T> {
return x.SET_EXPONENT(i.ToInt64());
@@ -407,13 +420,15 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
}
} else if (name == "sign") {
return FoldElementalIntrinsic<T, T, T>(
- context, std::move(funcRef), &Scalar<T>::SIGN);
+ kind, {kind, kind}, context, std::move(funcRef), &Scalar<T>::SIGN);
} else if (name == "spacing") {
- return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T>(kind, {kind}, context,
+ std::move(funcRef),
ScalarFunc<T, T>(
[](const Scalar<T> &x) -> Scalar<T> { return x.SPACING(); }));
} else if (name == "sqrt") {
- return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T>(kind, {kind}, context,
+ std::move(funcRef),
ScalarFunc<T, T>([&context](const Scalar<T> &x) -> Scalar<T> {
ValueWithRealFlags<Scalar<T>> result{x.SQRT()};
if (result.flags.test(RealFlag::InvalidArgument)) {
@@ -425,7 +440,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
} else if (name == "sum") {
return FoldSum<T>(context, std::move(funcRef));
} else if (name == "tiny") {
- return Expr<T>{Scalar<T>::TINY()};
+ return MakeConstantExpr<T>(kind, Scalar<T>::TINY(kind));
} else if (name == "__builtin_fma") {
CHECK(args.size() == 3);
} else if (name == "__builtin_ieee_next_after") {
@@ -433,16 +448,19 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
return common::visit(
[&](const auto &yVal) {
using TY = ResultType<decltype(yVal)>;
- return FoldElementalIntrinsic<T, T, TY>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T, TY>(kind, {kind, yVal.kind()},
+ context, std::move(funcRef),
ScalarFunc<T, T, TY>([&](const Scalar<T> &x,
const Scalar<TY> &y) -> Scalar<T> {
- auto xBig{Scalar<LargestReal>::Convert(x).value};
- auto yBig{Scalar<LargestReal>::Convert(y).value};
+ auto xBig{
+ Scalar<LargestReal>::Convert(LargestRealKind, x).value};
+ auto yBig{
+ Scalar<LargestReal>::Convert(LargestRealKind, y).value};
switch (xBig.Compare(yBig)) {
case Relation::Unordered:
context.Warn(common::UsageWarning::FoldingValueChecks,
"IEEE_NEXT_AFTER intrinsic folding: arguments are unordered"_warn_en_US);
- return x.NotANumber();
+ return Scalar<T>::NotANumber(kind);
case Relation::Equal:
break;
case Relation::Less:
@@ -459,7 +477,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
name == "__builtin_ieee_next_down") {
bool upward{name == "__builtin_ieee_next_up"};
const char *iName{upward ? "IEEE_NEXT_UP" : "IEEE_NEXT_DOWN"};
- return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
+ return FoldElementalIntrinsic<T, T>(kind, {kind}, context,
+ std::move(funcRef),
ScalarFunc<T, T>([&](const Scalar<T> &x) -> Scalar<T> {
auto result{x.NEAREST(upward)};
if (result.flags.test(RealFlag::InvalidArgument)) {
diff --git a/flang/lib/Evaluate/fold-reduction.cpp b/flang/lib/Evaluate/fold-reduction.cpp
index c5f5e1996b6b1..d5ea820b471fb 100644
--- a/flang/lib/Evaluate/fold-reduction.cpp
+++ b/flang/lib/Evaluate/fold-reduction.cpp
@@ -17,7 +17,8 @@ bool CheckReductionDIM(std::optional<int> &dim, FoldingContext &context,
return true; // no DIM= argument
}
if (auto *dimConst{
- Folder<SubscriptInteger>{context}.Folding(arg[*dimIndex])}) {
+ Folder<SubscriptInteger>{SubscriptIntegerKind, context}.Folding(
+ arg[*dimIndex])}) {
if (auto dimScalar{dimConst->GetScalarValue()}) {
auto dimVal{dimScalar->ToInt64()};
if (dimVal >= 1 && dimVal <= rank) {
@@ -37,7 +38,7 @@ Constant<LogicalResult> *GetReductionMASK(
std::optional<ActualArgument> &maskArg, const ConstantSubscripts &shape,
FoldingContext &context) {
Constant<LogicalResult> *mask{
- Folder<LogicalResult>{context}.Folding(maskArg)};
+ Folder<LogicalResult>{LogicalResultKind, context}.Folding(maskArg)};
if (mask &&
!CheckConformance(context.messages(), AsShape(shape),
AsShape(mask->shape()), CheckConformanceFlags::RightScalarExpandable,
diff --git a/flang/lib/Evaluate/fold-reduction.h b/flang/lib/Evaluate/fold-reduction.h
index a068364135295..0acc731fd58b1 100644
--- a/flang/lib/Evaluate/fold-reduction.h
+++ b/flang/lib/Evaluate/fold-reduction.h
@@ -18,9 +18,10 @@ template <typename T>
static Expr<T> FoldDotProduct(
FoldingContext &context, FunctionRef<T> &&funcRef) {
using Element = typename Constant<T>::Element;
+ const int kind{funcRef.kind()};
auto args{funcRef.arguments()};
CHECK(args.size() == 2);
- Folder<T> folder{context};
+ Folder<T> folder{kind, context};
Constant<T> *va{folder.Folding(args[0])};
Constant<T> *vb{folder.Folding(args[1])};
if (va && vb) {
@@ -31,7 +32,7 @@ static Expr<T> FoldDotProduct(
va->size(), vb->size());
return MakeInvalidIntrinsic(std::move(funcRef));
}
- Element sum{};
+ Element sum{Element::Zero(kind)};
bool overflow{false};
if constexpr (T::category == TypeCategory::Complex) {
std::vector<Element> conjugates;
@@ -39,11 +40,11 @@ static Expr<T> FoldDotProduct(
conjugates.emplace_back(x.CONJG());
}
Constant<T> conjgA{
- std::move(conjugates), ConstantSubscripts{va->shape()}};
+ kind, std::move(conjugates), ConstantSubscripts{va->shape()}};
Expr<T> products{Fold(
context, Expr<T>{std::move(conjgA)} * Expr<T>{Constant<T>{*vb}})};
Constant<T> &cProducts{DEREF(UnwrapConstantValue<T>(products))};
- [[maybe_unused]] Element correction{};
+ [[maybe_unused]] Element correction{Element::Zero(kind)};
const auto &rounding{context.targetCharacteristics().roundingMode()};
for (const Element &x : cProducts.values()) {
if constexpr (useKahanSummation) {
@@ -58,12 +59,12 @@ static Expr<T> FoldDotProduct(
}
} else if constexpr (T::category == TypeCategory::Logical) {
Expr<T> conjunctions{Fold(context,
- Expr<T>{LogicalOperation<T::kind>{LogicalOperator::And,
+ Expr<T>{LogicalOperation{LogicalOperator::And,
Expr<T>{Constant<T>{*va}}, Expr<T>{Constant<T>{*vb}}}})};
Constant<T> &cConjunctions{DEREF(UnwrapConstantValue<T>(conjunctions))};
for (const Element &x : cConjunctions.values()) {
if (x.IsTrue()) {
- sum = Element{true};
+ sum = Element{kind, true};
break;
}
}
@@ -88,7 +89,7 @@ static Expr<T> FoldDotProduct(
Expr<T> products{
Fold(context, Expr<T>{Constant<T>{*va}} * Expr<T>{Constant<T>{*vb}})};
Constant<T> &cProducts{DEREF(UnwrapConstantValue<T>(products))};
- [[maybe_unused]] Element correction{};
+ [[maybe_unused]] Element correction{Element::Zero(kind)};
const auto &rounding{context.targetCharacteristics().roundingMode()};
for (const Element &x : cProducts.values()) {
if constexpr (useKahanSummation) {
@@ -105,9 +106,9 @@ static Expr<T> FoldDotProduct(
if (overflow) {
context.Warn(common::UsageWarning::FoldingException,
"DOT_PRODUCT of %s data overflowed during computation"_warn_en_US,
- T::AsFortran());
+ T{kind}.AsFortran());
}
- return Expr<T>{Constant<T>{std::move(sum)}};
+ return MakeConstantExpr<T>(kind, std::move(sum));
}
return Expr<T>{std::move(funcRef)};
}
@@ -132,14 +133,14 @@ template <typename T> struct ArrayAndMask {
Constant<LogicalResult> mask;
};
template <typename T>
-static std::optional<ArrayAndMask<T>> ProcessReductionArgs(
+static std::optional<ArrayAndMask<T>> ProcessReductionArgs(int kind,
FoldingContext &context, ActualArguments &arg, std::optional<int> &dim,
int arrayIndex, std::optional<int> dimIndex = std::nullopt,
std::optional<int> maskIndex = std::nullopt) {
if (arg.empty()) {
return std::nullopt;
}
- Constant<T> *folded{Folder<T>{context}.Folding(arg[arrayIndex])};
+ Constant<T> *folded{Folder<T>{kind, context}.Folding(arg[arrayIndex])};
if (!folded || folded->Rank() < 1) {
return std::nullopt;
}
@@ -153,8 +154,8 @@ static std::optional<ArrayAndMask<T>> ProcessReductionArgs(
if (const Constant<LogicalResult> *origMask{
GetReductionMASK(arg[*maskIndex], folded->shape(), context)}) {
if (auto scalarMask{origMask->GetScalarValue()}) {
- maskElement =
- std::vector<Scalar<LogicalResult>>(n, scalarMask->IsTrue());
+ maskElement = std::vector<Scalar<LogicalResult>>(
+ n, Scalar<LogicalResult>{LogicalResultKind, scalarMask->IsTrue()});
} else {
maskElement = origMask->values();
}
@@ -162,11 +163,12 @@ static std::optional<ArrayAndMask<T>> ProcessReductionArgs(
return std::nullopt;
}
} else {
- maskElement = std::vector<Scalar<LogicalResult>>(n, true);
+ maskElement = std::vector<Scalar<LogicalResult>>(
+ n, Scalar<LogicalResult>{LogicalResultKind, true});
}
return ArrayAndMask<T>{Constant<T>(*folded),
- Constant<LogicalResult>{
- std::move(maskElement), ConstantSubscripts{folded->shape()}}};
+ Constant<LogicalResult>{LogicalResultKind, std::move(maskElement),
+ ConstantSubscripts{folded->shape()}}};
}
// Generalized reduction to an array of one dimension fewer (w/ DIM=)
@@ -174,7 +176,7 @@ static std::optional<ArrayAndMask<T>> ProcessReductionArgs(
// operator()(Scalar<T> &, const ConstantSubscripts &, bool first)
// and Done(Scalar<T> &).
template <typename T, typename ACCUMULATOR, typename ARRAY>
-static Constant<T> DoReduction(const Constant<ARRAY> &array,
+static Constant<T> DoReduction(int kind, const Constant<ARRAY> &array,
const Constant<LogicalResult> &mask, std::optional<int> &dim,
const Scalar<T> &identity, ACCUMULATOR &accumulator) {
ConstantSubscripts at{array.lbounds()};
@@ -220,19 +222,21 @@ static Constant<T> DoReduction(const Constant<ARRAY> &array,
accumulator.Done(elements.back());
}
if constexpr (T::category == TypeCategory::Character) {
- return {static_cast<ConstantSubscript>(identity.size()),
+ return {kind, static_cast<ConstantSubscript>(identity.size()),
std::move(elements), std::move(resultShape)};
} else {
- return {std::move(elements), std::move(resultShape)};
+ return {kind, std::move(elements), std::move(resultShape)};
}
}
// MAXVAL & MINVAL
template <typename T, bool ABS = false> class MaxvalMinvalAccumulator {
public:
- MaxvalMinvalAccumulator(
- RelationalOperator opr, FoldingContext &context, const Constant<T> &array)
- : opr_{opr}, context_{context}, array_{array} {};
+ constexpr int kind() const { return kind_; }
+
+ MaxvalMinvalAccumulator(int kind, RelationalOperator opr,
+ FoldingContext &context, const Constant<T> &array)
+ : kind_{kind}, opr_{opr}, context_{context}, array_{array} {};
void operator()(Scalar<T> &element, const ConstantSubscripts &at,
[[maybe_unused]] bool firstUnmasked) const {
auto aAt{array_.At(at)};
@@ -247,8 +251,9 @@ template <typename T, bool ABS = false> class MaxvalMinvalAccumulator {
return;
}
}
- Expr<LogicalResult> test{PackageRelation(
- opr_, Expr<T>{Constant<T>{aAt}}, Expr<T>{Constant<T>{element}})};
+ Expr<LogicalResult> test{
+ PackageRelation(opr_, MakeConstantExpr<T>(kind(), aAt),
+ MakeConstantExpr<T>(kind(), element))};
auto folded{GetScalarConstantValue<LogicalResult>(
test.Rewrite(context_, std::move(test)))};
CHECK(folded.has_value());
@@ -259,25 +264,27 @@ template <typename T, bool ABS = false> class MaxvalMinvalAccumulator {
void Done(Scalar<T> &) const {}
private:
+ int kind_;
RelationalOperator opr_;
FoldingContext &context_;
const Constant<T> &array_;
};
template <typename T>
-static Expr<T> FoldMaxvalMinval(FoldingContext &context, FunctionRef<T> &&ref,
- RelationalOperator opr, const Scalar<T> &identity) {
+static Expr<T> FoldMaxvalMinval(int kind, FoldingContext &context,
+ FunctionRef<T> &&ref, RelationalOperator opr, const Scalar<T> &identity) {
static_assert(T::category == TypeCategory::Integer ||
T::category == TypeCategory::Unsigned ||
T::category == TypeCategory::Real ||
T::category == TypeCategory::Character);
std::optional<int> dim;
- if (std::optional<ArrayAndMask<T>> arrayAndMask{
- ProcessReductionArgs<T>(context, ref.arguments(), dim,
- /*ARRAY=*/0, /*DIM=*/1, /*MASK=*/2)}) {
- MaxvalMinvalAccumulator<T> accumulator{opr, context, arrayAndMask->array};
- return Expr<T>{DoReduction<T>(
- arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)};
+ if (std::optional<ArrayAndMask<T>> arrayAndMask{ProcessReductionArgs<T>(kind,
+ context, ref.arguments(), dim, /*ARRAY=*/0, /*DIM=*/1,
+ /*MASK=*/2)}) {
+ MaxvalMinvalAccumulator<T> accumulator{
+ kind, opr, context, arrayAndMask->array};
+ return Expr<T>{DoReduction<T>(kind, arrayAndMask->array, arrayAndMask->mask,
+ dim, identity, accumulator)};
}
return Expr<T>{std::move(ref)};
}
@@ -315,16 +322,17 @@ static Expr<T> FoldProduct(
T::category == TypeCategory::Unsigned ||
T::category == TypeCategory::Real ||
T::category == TypeCategory::Complex);
+ const int kind{ref.kind()};
std::optional<int> dim;
if (std::optional<ArrayAndMask<T>> arrayAndMask{
- ProcessReductionArgs<T>(context, ref.arguments(), dim,
+ ProcessReductionArgs<T>(kind, context, ref.arguments(), dim,
/*ARRAY=*/0, /*DIM=*/1, /*MASK=*/2)}) {
ProductAccumulator accumulator{arrayAndMask->array};
- auto result{Expr<T>{DoReduction<T>(
- arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)}};
+ auto result{Expr<T>{DoReduction<T>(kind, arrayAndMask->array,
+ arrayAndMask->mask, dim, identity, accumulator)}};
if (accumulator.overflow()) {
context.Warn(common::UsageWarning::FoldingException,
- "PRODUCT() of %s data overflowed"_warn_en_US, T::AsFortran());
+ "PRODUCT() of %s data overflowed"_warn_en_US, T{kind}.AsFortran());
}
return result;
}
@@ -337,7 +345,8 @@ template <typename T> class SumAccumulator {
public:
SumAccumulator(const Constant<T> &array, Rounding rounding)
- : array_{array}, rounding_{rounding} {}
+ : kind_{array.kind()}, array_{array}, rounding_{rounding},
+ correction_{Element::Zero(array.kind())} {}
void operator()(
Element &element, const ConstantSubscripts &at, bool /*first*/) {
if constexpr (T::category == TypeCategory::Integer) {
@@ -358,16 +367,17 @@ template <typename T> class SumAccumulator {
T::category != TypeCategory::Unsigned) {
auto corrected{element.Add(correction_, rounding_)};
overflow_ |= corrected.flags.test(RealFlag::Overflow);
- correction_ = Scalar<T>{};
+ correction_ = Element::Zero(kind_);
element = corrected.value;
}
}
private:
+ int kind_;
const Constant<T> &array_;
Rounding rounding_;
bool overflow_{false};
- Element correction_{};
+ Element correction_;
};
template <typename T>
@@ -377,18 +387,19 @@ static Expr<T> FoldSum(FoldingContext &context, FunctionRef<T> &&ref) {
T::category == TypeCategory::Real ||
T::category == TypeCategory::Complex);
using Element = typename Constant<T>::Element;
+ const int kind{ref.kind()};
std::optional<int> dim;
- Element identity{};
+ Element identity{Element::Zero(kind)};
if (std::optional<ArrayAndMask<T>> arrayAndMask{
- ProcessReductionArgs<T>(context, ref.arguments(), dim,
+ ProcessReductionArgs<T>(kind, context, ref.arguments(), dim,
/*ARRAY=*/0, /*DIM=*/1, /*MASK=*/2)}) {
SumAccumulator accumulator{
arrayAndMask->array, context.targetCharacteristics().roundingMode()};
- auto result{Expr<T>{DoReduction<T>(
- arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)}};
+ auto result{Expr<T>{DoReduction<T>(kind, arrayAndMask->array,
+ arrayAndMask->mask, dim, identity, accumulator)}};
if (accumulator.overflow()) {
context.Warn(common::UsageWarning::FoldingException,
- "SUM() of %s data overflowed"_warn_en_US, T::AsFortran());
+ "SUM() of %s data overflowed"_warn_en_US, T{kind}.AsFortran());
}
return result;
}
diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
index f20d32077602d..7c44fb5e99a12 100644
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -51,10 +51,11 @@ std::optional<Constant<SubscriptInteger>> GetConstantSubscript(
std::vector<SubscriptInteger::Scalar> values;
while ((*stride > 0 && *lbi <= *ubi) ||
(*stride < 0 && *lbi >= *ubi)) {
- values.emplace_back(*lbi);
+ values.emplace_back(SubscriptIntegerKind, *lbi);
*lbi += *stride;
}
- return Constant<SubscriptInteger>{std::move(values),
+ return Constant<SubscriptInteger>{SubscriptIntegerKind,
+ std::move(values),
ConstantSubscripts{
static_cast<ConstantSubscript>(values.size())}};
} else {
@@ -214,7 +215,8 @@ std::optional<std::int64_t> GetInt64ArgOr(
Expr<ImpliedDoIndex::Result> FoldOperation(
FoldingContext &context, ImpliedDoIndex &&iDo) {
if (std::optional<ConstantSubscript> value{context.GetImpliedDo(iDo.name)}) {
- return Expr<ImpliedDoIndex::Result>{*value};
+ return MakeConstantExpr<ImpliedDoIndex::Result>(
+ SubscriptIntegerKind, *value);
} else {
return Expr<ImpliedDoIndex::Result>{std::move(iDo)};
}
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index fcedd15ee1791..7ee14e37baee6 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -73,22 +73,24 @@ llvm::raw_ostream &ConstantBase<RESULT, VALUE>::AsFortran(
o << ',';
}
if constexpr (Result::category == TypeCategory::Integer) {
- o << value.SignedDecimal() << '_' << Result::kind;
+ o << value.SignedDecimal() << '_' << kind_;
} else if constexpr (Result::category == TypeCategory::Unsigned) {
- o << value.UnsignedDecimal() << "U_" << Result::kind;
+ o << value.UnsignedDecimal() << "U_" << kind_;
} else if constexpr (Result::category == TypeCategory::Real ||
Result::category == TypeCategory::Complex) {
- value.AsFortran(o, Result::kind);
+ value.AsFortran(o, kind_);
} else if constexpr (Result::category == TypeCategory::Character) {
- o << Result::kind << '_' << parser::QuoteCharacterLiteral(value, true);
+ o << value.kind() << '_';
+ value.withStdString(
+ [&o](const auto &s) { o << parser::QuoteCharacterLiteral(s, true); });
} else if constexpr (Result::category == TypeCategory::Logical) {
if (!value.IsCanonical()) {
- o << "transfer(" << value.word().ToInt64() << "_8,.false._"
- << Result::kind << ')';
+ o << "transfer(" << value.word().ToInt64() << "_8,.false._" << kind_
+ << ')';
} else if (value.IsTrue()) {
- o << ".true." << '_' << Result::kind;
+ o << ".true." << '_' << kind_;
} else {
- o << ".false." << '_' << Result::kind;
+ o << ".false." << '_' << kind_;
}
} else {
StructureConstructor{result_.derivedTypeSpec(), value}.AsFortran(o);
@@ -109,8 +111,7 @@ std::string ConstantBase<RESULT, VALUE>::AsFortran() const {
return result;
}
-template <int KIND>
-llvm::raw_ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran(
+llvm::raw_ostream &Constant<Type<TypeCategory::Character>>::AsFortran(
llvm::raw_ostream &o) const {
bool hasNonDefaultLowerBound{printLbounds && HasNonDefaultLowerBound()};
if (Rank() > 1 || hasNonDefaultLowerBound) {
@@ -125,10 +126,11 @@ llvm::raw_ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran(
if (j > 0) {
o << ',';
}
- if (Result::kind != 1) {
- o << Result::kind << '_';
+ if (kind_ != 1) {
+ o << kind_ << '_';
}
- o << parser::QuoteCharacterLiteral(value);
+ value.withStdString(
+ [&o](const auto &s) { o << parser::QuoteCharacterLiteral(s); });
}
if (Rank() > 0) {
o << ']';
@@ -137,8 +139,7 @@ llvm::raw_ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran(
return o;
}
-template <int KIND>
-std::string Constant<Type<TypeCategory::Character, KIND>>::AsFortran() const {
+std::string Constant<Type<TypeCategory::Character>>::AsFortran() const {
std::string result;
llvm::raw_string_ostream sstream(result);
AsFortran(sstream);
@@ -353,8 +354,7 @@ enum class Precedence { // in increasing order for sane comparisons
template <typename A> constexpr Precedence ToPrecedence(const A &) {
return Precedence::Top;
}
-template <int KIND>
-static Precedence ToPrecedence(const LogicalOperation<KIND> &x) {
+static Precedence ToPrecedence(const LogicalOperation &x) {
switch (x.logicalOperator) {
SWITCH_COVERS_ALL_CASES
case LogicalOperator::And:
@@ -368,9 +368,7 @@ static Precedence ToPrecedence(const LogicalOperation<KIND> &x) {
return Precedence::Equivalence;
}
}
-template <int KIND> constexpr Precedence ToPrecedence(const Not<KIND> &) {
- return Precedence::Not;
-}
+inline Precedence ToPrecedence(const Not &) { return Precedence::Not; }
template <typename T> constexpr Precedence ToPrecedence(const Relational<T> &) {
return Precedence::Relational;
}
@@ -380,9 +378,7 @@ template <typename T> constexpr Precedence ToPrecedence(const Add<T> &) {
template <typename T> constexpr Precedence ToPrecedence(const Subtract<T> &) {
return Precedence::Additive;
}
-template <int KIND> constexpr Precedence ToPrecedence(const Concat<KIND> &) {
- return Precedence::Additive;
-}
+inline Precedence ToPrecedence(const Concat &) { return Precedence::Additive; }
template <typename T> constexpr Precedence ToPrecedence(const Negate<T> &) {
return Precedence::Negate;
}
@@ -445,20 +441,16 @@ template <typename A>
constexpr OperatorSpelling SpellOperator(const Parentheses<A> &) {
return OperatorSpelling{"(", "", ")"};
}
-template <int KIND>
-static OperatorSpelling SpellOperator(const ComplexComponent<KIND> &x) {
+static OperatorSpelling SpellOperator(const ComplexComponent &x) {
return {x.isImaginaryPart ? "aimag(" : "real(", "", ")"};
}
-template <int KIND>
-constexpr OperatorSpelling SpellOperator(const Not<KIND> &) {
+constexpr OperatorSpelling SpellOperator(const Not &) {
return OperatorSpelling{".NOT.", "", ""};
}
-template <int KIND>
-constexpr OperatorSpelling SpellOperator(const SetLength<KIND> &) {
+constexpr OperatorSpelling SpellOperator(const SetLength &) {
return OperatorSpelling{"%SET_LENGTH(", ",", ")"};
}
-template <int KIND>
-constexpr OperatorSpelling SpellOperator(const ComplexConstructor<KIND> &) {
+constexpr OperatorSpelling SpellOperator(const ComplexConstructor &) {
return OperatorSpelling{"(", ",", ")"};
}
template <typename A> constexpr OperatorSpelling SpellOperator(const Add<A> &) {
@@ -489,12 +481,10 @@ static OperatorSpelling SpellOperator(const Extremum<A> &x) {
return OperatorSpelling{
x.ordering == Ordering::Less ? "min(" : "max(", ",", ")"};
}
-template <int KIND>
-constexpr OperatorSpelling SpellOperator(const Concat<KIND> &) {
+constexpr OperatorSpelling SpellOperator(const Concat &) {
return OperatorSpelling{"", "//", ""};
}
-template <int KIND>
-static OperatorSpelling SpellOperator(const LogicalOperation<KIND> &x) {
+static OperatorSpelling SpellOperator(const LogicalOperation &x) {
return OperatorSpelling{"", AsFortran(x.logicalOperator), ""};
}
template <typename T>
@@ -556,7 +546,7 @@ llvm::raw_ostream &Convert<TO, FROMCAT>::AsFortran(llvm::raw_ostream &o) const {
} else {
this->left().AsFortran(o << "uint(");
}
- return o << ",kind=" << TO::kind << ')';
+ return o << ",kind=" << kind() << ')';
}
llvm::raw_ostream &Relational<SomeType>::AsFortran(llvm::raw_ostream &o) const {
@@ -577,7 +567,8 @@ template <typename T>
llvm::raw_ostream &EmitArray(llvm::raw_ostream &o, const ImpliedDo<T> &implDo) {
o << '(';
EmitArray(o, implDo.values());
- o << ',' << ImpliedDoIndex::Result::AsFortran()
+ o << ','
+ << DynamicType{TypeCategory::Integer, SubscriptIntegerKind}.AsFortran()
<< "::" << implDo.name().ToString() << '=';
implDo.lower().AsFortran(o) << ',';
implDo.upper().AsFortran(o) << ',';
@@ -604,9 +595,7 @@ llvm::raw_ostream &ArrayConstructor<T>::AsFortran(llvm::raw_ostream &o) const {
return o << ']';
}
-template <int KIND>
-llvm::raw_ostream &
-ArrayConstructor<Type<TypeCategory::Character, KIND>>::AsFortran(
+llvm::raw_ostream &ArrayConstructor<Type<TypeCategory::Character>>::AsFortran(
llvm::raw_ostream &o) const {
o << '[';
if (const auto *len{LEN()}) {
@@ -891,7 +880,7 @@ llvm::raw_ostream &DescriptorInquiry::AsFortran(llvm::raw_ostream &o) const {
o << ",dim=" << (dimension_ + 1);
}
}
- return o << ",kind=" << DescriptorInquiry::Result::kind << ")";
+ return o << ",kind=" << DescriptorInquiry::kind() << ")";
}
llvm::raw_ostream &RankOneBoundElement::AsFortran(llvm::raw_ostream &o) const {
diff --git a/flang/lib/Evaluate/host.h b/flang/lib/Evaluate/host.h
index 7f6bf76bb5c53..e6756de68c36b 100644
--- a/flang/lib/Evaluate/host.h
+++ b/flang/lib/Evaluate/host.h
@@ -55,6 +55,34 @@ class HostFloatingPointEnvironment {
// Type mapping from F18 types to host types
struct UnsupportedType {}; // There is no host type for the F18 type
+/// Because HostType<T> depends on the type's kind as well, KIND must be part of
+/// the template as well where Type<CAT> does not.
+template <common::TypeCategory CAT, int KIND> struct TypeKind {
+ using FortranType = Fortran::evaluate::Type<CAT>;
+ using Scalar = Fortran::evaluate::Scalar<FortranType>;
+ static constexpr common::TypeCategory category{CAT};
+ static constexpr int kind{KIND};
+
+ static constexpr DynamicType GetType() { return DynamicType{CAT, KIND}; }
+
+ // Meaningful for COMPLEX only: the real component's (category, kind) tag.
+ using Part = TypeKind<common::TypeCategory::Real, KIND>;
+};
+
+using AllHostKindTypes = std::tuple<TypeKind<TypeCategory::Integer, 1>,
+ TypeKind<TypeCategory::Integer, 2>, TypeKind<TypeCategory::Integer, 4>,
+ TypeKind<TypeCategory::Integer, 8>, TypeKind<TypeCategory::Integer, 16>,
+ TypeKind<TypeCategory::Real, 2>, TypeKind<TypeCategory::Real, 3>,
+ TypeKind<TypeCategory::Real, 4>, TypeKind<TypeCategory::Real, 8>,
+ TypeKind<TypeCategory::Real, 10>, TypeKind<TypeCategory::Real, 16>,
+ TypeKind<TypeCategory::Complex, 2>, TypeKind<TypeCategory::Complex, 3>,
+ TypeKind<TypeCategory::Complex, 4>, TypeKind<TypeCategory::Complex, 8>,
+ TypeKind<TypeCategory::Complex, 10>, TypeKind<TypeCategory::Complex, 16>,
+ TypeKind<TypeCategory::Logical, 1>, TypeKind<TypeCategory::Logical, 2>,
+ TypeKind<TypeCategory::Logical, 4>, TypeKind<TypeCategory::Logical, 8>,
+ TypeKind<TypeCategory::Character, 1>, TypeKind<TypeCategory::Character, 2>,
+ TypeKind<TypeCategory::Character, 4>>;
+
template <typename FTN_T> struct HostTypeHelper {
using Type = UnsupportedType;
};
@@ -64,6 +92,19 @@ template <typename... T> constexpr inline bool HostTypeExists() {
return (... && (!std::is_same_v<HostType<T>, UnsupportedType>));
}
+#if 0
+template <typename, typename = void> struct HasValueMethod : std::false_type {};
+template <typename T>
+struct HasValueMethod<T,
+ std::void_t<decltype(std::declval<const T &>().value())>> : std::true_type {
+};
+
+template <typename, typename = void> struct HasRawBits : std::false_type {};
+template <typename T>
+struct HasRawBits<T, std::void_t<decltype(std::declval<const T &>().RawBits())>>
+ : std::true_type {};
+#endif
+
// Type mapping from host types to F18 types FortranType<HOST_T> is defined
// after all HosTypeHelper definition because it reverses them to avoid
// duplication.
@@ -73,13 +114,13 @@ template <typename FTN_T>
inline constexpr Scalar<FTN_T> CastHostToFortran(const HostType<FTN_T> &x) {
static_assert(HostTypeExists<FTN_T>());
if constexpr (FTN_T::category == TypeCategory::Complex &&
- sizeof(Scalar<FTN_T>) != sizeof(HostType<FTN_T>)) {
+ 2 * sizeof(HostType<typename FTN_T::Part>) != sizeof(HostType<FTN_T>)) {
// X87 is usually padded to 12 or 16bytes. Need to cast piecewise for
// complex
return Scalar<FTN_T>{CastHostToFortran<typename FTN_T::Part>(std::real(x)),
CastHostToFortran<typename FTN_T::Part>(std::imag(x))};
} else {
- return *reinterpret_cast<const Scalar<FTN_T> *>(&x);
+ return Scalar<FTN_T>::FromRawBytes(FTN_T::kind, &x, sizeof(x));
}
}
@@ -91,36 +132,32 @@ inline constexpr HostType<FTN_T> CastFortranToHost(const Scalar<FTN_T> &x) {
using FortranPartType = typename FTN_T::Part;
return HostType<FTN_T>{CastFortranToHost<FortranPartType>(x.REAL()),
CastFortranToHost<FortranPartType>(x.AIMAG())};
- } else if constexpr (std::is_same_v<FTN_T, Type<TypeCategory::Real, 10>>) {
- // x87 80-bit floating-point occupies 16 bytes as a C "long double";
- // copy the data to avoid a legitimate (but benign due to little-endianness)
- // warning from GCC >= 11.2.0.
- HostType<FTN_T> y;
- std::memcpy(&y, &x, sizeof x);
- return y;
} else {
- static_assert(sizeof x == sizeof(HostType<FTN_T>));
- return *reinterpret_cast<const HostType<FTN_T> *>(&x);
+ CHECK(x.bytesStored() == sizeof(HostType<FTN_T>));
+ HostType<FTN_T> result;
+ CHECK(x.kind() == FTN_T::kind);
+ x.StoreRawBytes(&result, sizeof(result));
+ return result;
}
}
-template <> struct HostTypeHelper<Type<TypeCategory::Integer, 1>> {
+template <> struct HostTypeHelper<TypeKind<TypeCategory::Integer, 1>> {
using Type = std::int8_t;
};
-template <> struct HostTypeHelper<Type<TypeCategory::Integer, 2>> {
+template <> struct HostTypeHelper<TypeKind<TypeCategory::Integer, 2>> {
using Type = std::int16_t;
};
-template <> struct HostTypeHelper<Type<TypeCategory::Integer, 4>> {
+template <> struct HostTypeHelper<TypeKind<TypeCategory::Integer, 4>> {
using Type = std::int32_t;
};
-template <> struct HostTypeHelper<Type<TypeCategory::Integer, 8>> {
+template <> struct HostTypeHelper<TypeKind<TypeCategory::Integer, 8>> {
using Type = std::int64_t;
};
-template <> struct HostTypeHelper<Type<TypeCategory::Integer, 16>> {
+template <> struct HostTypeHelper<TypeKind<TypeCategory::Integer, 16>> {
#if (defined(__GNUC__) || defined(__clang__)) && defined(__SIZEOF_INT128__)
using Type = __int128_t;
#else
@@ -133,7 +170,7 @@ template <> struct HostTypeHelper<Type<TypeCategory::Integer, 16>> {
template <>
struct HostTypeHelper<
- Type<TypeCategory::Real, common::RealKindForPrecision(24)>> {
+ TypeKind<TypeCategory::Real, common::RealKindForPrecision(24)>> {
// IEEE 754 32bits
using Type = std::conditional_t<sizeof(float) == 4 &&
std::numeric_limits<float>::is_iec559,
@@ -142,7 +179,7 @@ struct HostTypeHelper<
template <>
struct HostTypeHelper<
- Type<TypeCategory::Real, common::RealKindForPrecision(53)>> {
+ TypeKind<TypeCategory::Real, common::RealKindForPrecision(53)>> {
// IEEE 754 64bits
using Type = std::conditional_t<sizeof(double) == 8 &&
std::numeric_limits<double>::is_iec559,
@@ -151,7 +188,7 @@ struct HostTypeHelper<
template <>
struct HostTypeHelper<
- Type<TypeCategory::Real, common::RealKindForPrecision(64)>> {
+ TypeKind<TypeCategory::Real, common::RealKindForPrecision(64)>> {
// X87 80bits
using Type = std::conditional_t<sizeof(long double) >= 10 &&
std::numeric_limits<long double>::digits == 64 &&
@@ -160,12 +197,12 @@ struct HostTypeHelper<
};
#if HAS_QUADMATHLIB
-template <> struct HostTypeHelper<Type<TypeCategory::Real, 16>> {
+template <> struct HostTypeHelper<TypeKind<TypeCategory::Real, 16>> {
// IEEE 754 128bits
using Type = __float128;
};
#else
-template <> struct HostTypeHelper<Type<TypeCategory::Real, 16>> {
+template <> struct HostTypeHelper<TypeKind<TypeCategory::Real, 16>> {
// IEEE 754 128bits
using Type = std::conditional_t<sizeof(long double) == 16 &&
std::numeric_limits<long double>::digits == 113 &&
@@ -174,26 +211,28 @@ template <> struct HostTypeHelper<Type<TypeCategory::Real, 16>> {
};
#endif
-template <int KIND> struct HostTypeHelper<Type<TypeCategory::Complex, KIND>> {
- using RealT = Fortran::evaluate::Type<TypeCategory::Real, KIND>;
+template <int KIND>
+struct HostTypeHelper<TypeKind<TypeCategory::Complex, KIND>> {
+ using RealT = TypeKind<TypeCategory::Real, KIND>;
using Type = std::conditional_t<HostTypeExists<RealT>(),
std::complex<HostType<RealT>>, UnsupportedType>;
};
#if HAS_QUADMATHLIB
-template <> struct HostTypeHelper<Type<TypeCategory::Complex, 16>> {
- using RealT = Fortran::evaluate::Type<TypeCategory::Real, 16>;
+template <> struct HostTypeHelper<TypeKind<TypeCategory::Complex, 16>> {
+ using RealT = TypeKind<TypeCategory::Real, 16>;
using Type = __complex128;
};
#endif
-template <int KIND> struct HostTypeHelper<Type<TypeCategory::Logical, KIND>> {
+template <int KIND>
+struct HostTypeHelper<TypeKind<TypeCategory::Logical, KIND>> {
using Type = std::conditional_t<KIND <= 8, std::uint8_t, UnsupportedType>;
};
-template <int KIND> struct HostTypeHelper<Type<TypeCategory::Character, KIND>> {
- using Type =
- Scalar<typename Fortran::evaluate::Type<TypeCategory::Character, KIND>>;
+template <int KIND>
+struct HostTypeHelper<TypeKind<TypeCategory::Character, KIND>> {
+ using Type = typename TypeKind<TypeCategory::Character, KIND>::Scalar;
};
// Type mapping from host types to F18 types. This need to be placed after all
@@ -206,13 +245,13 @@ struct IndexInTupleHelper<T, std::tuple<TT...>> {
struct UnknownType {}; // the host type does not match any F18 types
template <typename HOST_T> struct FortranTypeHelper {
using HostTypeMapping =
- common::MapTemplate<HostType, AllIntrinsicTypes, std::tuple>;
+ common::MapTemplate<HostType, AllHostKindTypes, std::tuple>;
static constexpr int index{
IndexInTupleHelper<HOST_T, HostTypeMapping>::value};
// Both conditional types are "instantiated", so a valid type must be
// created for invalid index even if not used.
using Type = std::conditional_t<index >= 0,
- std::tuple_element_t<(index >= 0) ? index : 0, AllIntrinsicTypes>,
+ std::tuple_element_t<(index >= 0) ? index : 0, AllHostKindTypes>,
UnknownType>;
};
diff --git a/flang/lib/Evaluate/initial-image.cpp b/flang/lib/Evaluate/initial-image.cpp
index 050c55e399b57..672b88f3d954e 100644
--- a/flang/lib/Evaluate/initial-image.cpp
+++ b/flang/lib/Evaluate/initial-image.cpp
@@ -96,15 +96,16 @@ class AsConstantHelper {
extents_{extents}, padWithZero_{padWithZero}, offset_{offset} {
CHECK(!type.IsPolymorphic());
}
- template <typename T> Result Test() {
+ template <typename T> Result Test(int kind) {
if (T::category != type_.category()) {
return std::nullopt;
}
if constexpr (T::category != TypeCategory::Derived) {
- if (T::kind != type_.kind()) {
+ if (kind != type_.kind()) {
return std::nullopt;
}
}
+ CHECK_KIND(kind, T);
using Const = Constant<T>;
using Scalar = typename Const::Element;
std::optional<uint64_t> optElements{TotalElementCount(extents_)};
@@ -159,53 +160,54 @@ class AsConstantHelper {
return AsGenericExpr(
Const{derived, std::move(typedValue), std::move(extents_)});
} else if constexpr (T::category == TypeCategory::Character) {
- auto length{static_cast<ConstantSubscript>(stride) / T::kind};
+ auto length{static_cast<ConstantSubscript>(stride) / kind};
+ llvm::SmallVector<char, 256> buffer;
+ const char *data{GetTailPaddedData(offset_, elements * stride, buffer)};
for (std::size_t j{0}; j < elements; ++j) {
- using Char = typename Scalar::value_type;
- auto at{static_cast<std::size_t>(offset_ + j * stride)};
- auto chunk{length};
- if (at + chunk > image_.data_.size()) {
- CHECK(padWithZero_);
- if (at >= image_.data_.size()) {
- chunk = 0;
- } else {
- chunk = image_.data_.size() - at;
- }
- }
- if (chunk > 0) {
- const Char *data{reinterpret_cast<const Char *>(&image_.data_[at])};
- typedValue[j].assign(data, chunk);
- }
- if (chunk < length && padWithZero_) {
- typedValue[j].append(length - chunk, Char{});
- }
+ typedValue[j] = evaluate::Scalar<T>::FromRawBytes(
+ kind, data + j * stride, length * kind);
}
return AsGenericExpr(
- Const{length, std::move(typedValue), std::move(extents_)});
+ Const{kind, length, std::move(typedValue), std::move(extents_)});
} else {
// Lengthless intrinsic type
- CHECK(sizeof(Scalar) <= stride);
- for (std::size_t j{0}; j < elements; ++j) {
- auto at{static_cast<std::size_t>(offset_ + j * stride)};
- std::size_t chunk{sizeof(Scalar)};
- if (at + chunk > image_.data_.size()) {
- CHECK(padWithZero_);
- if (at >= image_.data_.size()) {
- chunk = 0;
- } else {
- chunk = image_.data_.size() - at;
- }
- }
- // TODO endianness
- if (chunk > 0) {
- std::memcpy(&typedValue[j], &image_.data_[at], chunk);
- }
- }
- return AsGenericExpr(Const{std::move(typedValue), std::move(extents_)});
+ llvm::SmallVector<char, 256> buffer;
+ const char *data{GetTailPaddedData(offset_,
+ elements == 0 ? 0
+ : (elements - 1) * stride +
+ evaluate::Scalar<T>::bytesStored(kind),
+ buffer)};
+ // TODO endianness
+ LoadSerialValues(kind, data,
+ llvm::MutableArrayRef<evaluate::Scalar<T>>(typedValue), stride);
+ return AsGenericExpr(
+ Const{kind, std::move(typedValue), std::move(extents_)});
}
}
private:
+ /// Returns the image's bytes, extended with zero bytes when a value is being
+ /// built whose representation reaches past the end of the image. That
+ /// happens when TRANSFER() is folded with a MOLD= whose representation is
+ /// longer than SOURCE=, and when deserializing a scalar accesses more bytes
+ /// than its element size because its host representation is padded (e.g.,
+ /// REAL(10)). F2023 16.9.212 leaves the bytes beyond SOURCE= processor
+ /// dependent; flang zero-fills them, as the runtime does.
+ const char *GetTailPaddedData(std::size_t offset, std::size_t bytes,
+ llvm::SmallVectorImpl<char> &buffer) const {
+ if (bytes + offset <= image_.data_.size()) {
+ // If no padding is needed, use original data without copy
+ return image_.data_.data() + offset;
+ }
+ CHECK(padWithZero_);
+ buffer.assign(bytes, 0);
+ if (offset < image_.data_.size()) {
+ std::memcpy(buffer.data(), image_.data_.data() + offset,
+ image_.data_.size() - offset);
+ }
+ return buffer.data();
+ }
+
FoldingContext &context_;
const DynamicType &type_;
std::optional<std::int64_t> charLength_;
@@ -219,7 +221,7 @@ std::optional<Expr<SomeType>> InitialImage::AsConstant(FoldingContext &context,
const DynamicType &type, std::optional<std::int64_t> charLength,
const ConstantSubscripts &extents, bool padWithZero,
ConstantSubscript offset) const {
- return common::SearchTypes(AsConstantHelper{
+ return SearchTypes(AsConstantHelper{
context, type, charLength, extents, *this, padWithZero, offset});
}
diff --git a/flang/lib/Evaluate/int-power.h b/flang/lib/Evaluate/int-power.h
index 2ee012ceb77a3..3acdec06286f7 100644
--- a/flang/lib/Evaluate/int-power.h
+++ b/flang/lib/Evaluate/int-power.h
@@ -19,9 +19,11 @@ template <typename REAL, typename INT>
ValueWithRealFlags<REAL> TimesIntPowerOf(const REAL &factor, const REAL &base,
const INT &power,
Rounding rounding = TargetCharacteristics::defaultRounding) {
+ const int realKind{base.kind()};
+ CHECK(factor.kind() == base.kind());
ValueWithRealFlags<REAL> result{factor};
if (base.IsNotANumber()) {
- result.value = REAL::NotANumber();
+ result.value = REAL::NotANumber(realKind);
result.flags.set(RealFlag::InvalidArgument);
} else if (power.IsZero()) {
if (base.IsZero() || base.IsInfinite()) {
@@ -31,7 +33,7 @@ ValueWithRealFlags<REAL> TimesIntPowerOf(const REAL &factor, const REAL &base,
bool negativePower{power.IsNegative()};
INT absPower{power.ABS().value};
REAL squares{base};
- int nbits{INT::bits - absPower.LEADZ()};
+ int nbits{absPower.bits() - absPower.LEADZ()};
for (int j{0}; j < nbits; ++j) {
if (j > 0) { // avoid spurious overflow on last iteration
squares =
@@ -54,7 +56,9 @@ ValueWithRealFlags<REAL> TimesIntPowerOf(const REAL &factor, const REAL &base,
template <typename REAL, typename INT>
ValueWithRealFlags<REAL> IntPower(const REAL &base, const INT &power,
Rounding rounding = TargetCharacteristics::defaultRounding) {
- REAL one{REAL::FromInteger(INT{1}).value};
+ const int realKind{base.kind()};
+ const int intKind{power.kind()};
+ REAL one{REAL::FromInteger(realKind, INT{intKind, 1}).value};
return TimesIntPowerOf(one, base, power, rounding);
}
} // namespace Fortran::evaluate
diff --git a/flang/lib/Evaluate/integer-value-impl.cpp b/flang/lib/Evaluate/integer-value-impl.cpp
new file mode 100644
index 0000000000000..a1f8708423998
--- /dev/null
+++ b/flang/lib/Evaluate/integer-value-impl.cpp
@@ -0,0 +1,583 @@
+//===-- lib/Evaluate/integer-value.cpp ------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "integer-value-impl.h"
+#include "flang/Evaluate/integer-value.h"
+#include <new>
+
+namespace Fortran::evaluate::value {
+
+IntegerValueImpl IntegerValueImpl::Zero(int kind) {
+ return withWordProto(kind, [](auto proto) {
+ using T = decltype(proto);
+ return FromWord(T{});
+ });
+}
+
+IntegerValueImpl IntegerValueImpl::FromRawBytes(
+ int kind, const void *raw, std::size_t expectedSize) {
+ CHECK(expectedSize == IntegerValue::bytesStored(kind));
+
+ return withWordProto(kind, [&](auto proto) {
+ assert(IntegerValue::bytesStored(kind) == sizeof(proto));
+ std::decay_t<decltype(proto)> t{};
+ memcpy(&t, raw, sizeof(proto));
+ return FromWord(t);
+ });
+}
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+LLVM_DUMP_METHOD void IntegerValueImpl::dump() const {
+ llvm::errs() << SignedDecimal() << '_' << kind() << '\n';
+}
+#endif
+
+int IntegerValueImpl::kind() const {
+ if (IsMonostate()) {
+ llvm_unreachable("default-initialized value representing 0 with unknown "
+ "width does not know its kind");
+ return 0;
+ }
+ return withWord(
+ [](const auto &x) -> int { return std::decay_t<decltype(x)>::bits / 8; });
+}
+
+int IntegerValueImpl::bits() const {
+ if (IsMonostate()) {
+ return 0;
+ }
+ return withWord(
+ [](const auto &x) -> int { return std::decay_t<decltype(x)>::bits; });
+}
+
+bool IntegerValueImpl::IsZero() const {
+ if (IsMonostate()) {
+ return true; // uninitialized int representing 0 is zero
+ }
+ return withWord([](const auto &x) { return x.IsZero(); });
+}
+
+bool IntegerValueImpl::operator==(const IntegerValueImpl &y) const {
+ if (IsMonostate() && y.IsMonostate()) {
+ return true;
+ }
+ if (IsMonostate() != y.IsMonostate() || bits() != y.bits()) {
+ llvm_unreachable("uncomparable integers");
+ return false;
+ }
+ return withWord([&](const auto &x) -> bool {
+ using T = std::decay_t<decltype(x)>;
+ return x == std::get<T>(y.storage_);
+ });
+}
+
+IntegerValueImpl IntegerValueImpl::MASKL(int kind, int places) {
+ return withWordProto(kind, [&](auto proto) {
+ using T = decltype(proto);
+ return FromWord(T::MASKL(places));
+ });
+}
+
+IntegerValueImpl IntegerValueImpl::MASKR(int kind, int places) {
+ return withWordProto(kind, [&](auto proto) {
+ using T = decltype(proto);
+ return FromWord(T::MASKR(places));
+ });
+}
+
+IntegerValueImpl IntegerValueImpl::HUGE(int kind) {
+ return withWordProto(kind, [&](auto proto) {
+ using T = decltype(proto);
+ return FromWord(T::HUGE());
+ });
+}
+
+IntegerValueImpl IntegerValueImpl::Least(int kind) {
+ return withWordProto(kind, [&](auto proto) {
+ using T = decltype(proto);
+ return FromWord(T::Least());
+ });
+}
+
+bool IntegerValueImpl::IsNegative() const {
+ if (IsMonostate()) {
+ return false; // uninitialized int representing 0 is not negative
+ }
+ return withWord([](const auto &x) { return x.IsNegative(); });
+}
+
+std::uint64_t IntegerValueImpl::ToUInt64() const {
+ if (IsMonostate()) {
+ return 0;
+ }
+ return withWord([](const auto &x) { return x.ToUInt64(); });
+}
+
+std::int64_t IntegerValueImpl::ToInt64() const {
+ if (IsMonostate()) {
+ return 0;
+ }
+ return withWord([](const auto &x) { return x.ToInt64(); });
+}
+
+Ordering IntegerValueImpl::CompareSigned(const IntegerValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("uncomparable ints");
+ return Ordering::Equal;
+ }
+ return withWord([&](const auto &x) -> Ordering {
+ using T = std::decay_t<decltype(x)>;
+ return x.CompareSigned(Coerce<T>(y));
+ });
+}
+
+Ordering IntegerValueImpl::CompareUnsigned(const IntegerValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("uncomparable ints; cast bitwidth first");
+ return Ordering::Equal;
+ }
+ return withWord([&](const auto &x) -> Ordering {
+ using T = std::decay_t<decltype(x)>;
+ return x.CompareUnsigned(Coerce<T>(y));
+ });
+}
+
+Ordering IntegerValueImpl::CompareToZeroSigned() const {
+ if (IsMonostate()) {
+ llvm_unreachable("uncomparable ints");
+ return Ordering::Equal;
+ }
+ return withWord([](const auto &x) { return x.CompareToZeroSigned(); });
+}
+
+typename IntegerValueImpl::ValueWithOverflow IntegerValueImpl::Negate() const {
+ if (IsMonostate()) {
+ return ValueWithOverflow{}; // negation of uninitialized int 0 is zero
+ }
+ return withWord([](const auto &x) -> ValueWithOverflow {
+ auto r{x.Negate()};
+ return {FromWord(r.value), r.overflow};
+ });
+}
+
+typename IntegerValueImpl::ValueWithOverflow IntegerValueImpl::ABS() const {
+ if (IsMonostate()) {
+ return ValueWithOverflow{}; // absolute of uninitialized int 0 is zero
+ }
+ return withWord([](const auto &x) -> ValueWithOverflow {
+ auto r{x.ABS()};
+ return {FromWord(r.value), r.overflow};
+ });
+}
+
+typename IntegerValueImpl::ValueWithCarry IntegerValueImpl::AddUnsigned(
+ const IntegerValueImpl &y, bool carryIn) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatiable ints");
+ return ValueWithCarry{};
+ }
+ return withWord([&](const auto &x) -> ValueWithCarry {
+ using T = std::decay_t<decltype(x)>;
+ auto r{x.AddUnsigned(Coerce<T>(y), carryIn)};
+ return {FromWord(r.value), r.carry};
+ });
+}
+
+typename IntegerValueImpl::ValueWithOverflow IntegerValueImpl::AddSigned(
+ const IntegerValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return ValueWithOverflow{};
+ }
+ return withWord([&](const auto &x) -> ValueWithOverflow {
+ using T = std::decay_t<decltype(x)>;
+ auto r{x.AddSigned(Coerce<T>(y))};
+ return {FromWord(r.value), r.overflow};
+ });
+}
+
+typename IntegerValueImpl::ValueWithOverflow IntegerValueImpl::SubtractSigned(
+ const IntegerValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatiable ints");
+ return ValueWithOverflow{};
+ }
+ return withWord([&](const auto &x) -> ValueWithOverflow {
+ using T = std::decay_t<decltype(x)>;
+ auto r{x.SubtractSigned(Coerce<T>(y))};
+ return {FromWord(r.value), r.overflow};
+ });
+}
+
+typename IntegerValueImpl::ValueWithOverflow IntegerValueImpl::DIM(
+ const IntegerValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatiable ints");
+ return ValueWithOverflow{};
+ }
+ // DIM(X,Y) = MAX(X-Y, 0)
+ if (CompareSigned(y) != Ordering::Greater) {
+ return {Zero(kind()), false};
+ }
+ return SubtractSigned(y);
+}
+
+typename IntegerValueImpl::ValueWithOverflow IntegerValueImpl::SIGN(
+ const IntegerValueImpl &sign) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatiable ints");
+ return ValueWithOverflow{};
+ }
+ bool toNegative{sign.IsNegative()};
+ if (toNegative == IsNegative()) {
+ return {*this, false};
+ }
+ if (toNegative) {
+ return Negate();
+ }
+ return ABS();
+}
+
+typename IntegerValueImpl::Product IntegerValueImpl::MultiplySigned(
+ const IntegerValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatiable ints");
+ return Product{};
+ }
+ return withWord([&](const auto &x) -> Product {
+ using T = std::decay_t<decltype(x)>;
+ auto r{x.MultiplySigned(Coerce<T>(y))};
+ return {FromWord(r.upper), FromWord(r.lower),
+ r.SignedMultiplicationOverflowed()};
+ });
+}
+
+typename IntegerValueImpl::Product IntegerValueImpl::MultiplyUnsigned(
+ const IntegerValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatiable ints");
+ return Product{};
+ }
+ return withWord([&](const auto &x) -> Product {
+ using T = std::decay_t<decltype(x)>;
+ auto r{x.MultiplyUnsigned(Coerce<T>(y))};
+ return {FromWord(r.upper), FromWord(r.lower), false};
+ });
+}
+
+typename IntegerValueImpl::QuotientWithRemainder IntegerValueImpl::DivideSigned(
+ const IntegerValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatiable ints");
+ return QuotientWithRemainder{};
+ }
+ return withWord([&](const auto &x) -> QuotientWithRemainder {
+ using T = std::decay_t<decltype(x)>;
+ auto r{x.DivideSigned(Coerce<T>(y))};
+ return {FromWord(r.quotient), FromWord(r.remainder), r.divisionByZero,
+ r.overflow};
+ });
+}
+
+typename IntegerValueImpl::QuotientWithRemainder
+IntegerValueImpl::DivideUnsigned(const IntegerValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatiable ints");
+ return QuotientWithRemainder{};
+ }
+ return withWord([&](const auto &x) -> QuotientWithRemainder {
+ using T = std::decay_t<decltype(x)>;
+ auto r{x.DivideUnsigned(Coerce<T>(y))};
+ return {FromWord(r.quotient), FromWord(r.remainder), r.divisionByZero,
+ r.overflow};
+ });
+}
+
+typename IntegerValueImpl::ValueWithOverflow IntegerValueImpl::MODULO(
+ const IntegerValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatiable ints");
+ return ValueWithOverflow{};
+ }
+ return withWord([&](const auto &x) -> ValueWithOverflow {
+ using T = std::decay_t<decltype(x)>;
+ auto r{x.MODULO(Coerce<T>(y))};
+ return {FromWord(r.value), r.overflow};
+ });
+}
+
+typename IntegerValueImpl::PowerWithErrors IntegerValueImpl::Power(
+ const IntegerValueImpl &e) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatiable ints");
+ return PowerWithErrors{};
+ }
+ return withWord([&](const auto &x) -> PowerWithErrors {
+ using T = std::decay_t<decltype(x)>;
+ auto r{x.Power(Coerce<T>(e))};
+ return {FromWord(r.power), r.divisionByZero, r.overflow, r.zeroToZero};
+ });
+}
+
+IntegerValueImpl IntegerValueImpl::NOT() const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return IntegerValueImpl{};
+ }
+ return withWord([](const auto &x) { return FromWord(x.NOT()); });
+}
+
+IntegerValueImpl IntegerValueImpl::IAND(const IntegerValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatiable ints");
+ return IntegerValueImpl{};
+ }
+ return withWord([&](const auto &x) {
+ using T = std::decay_t<decltype(x)>;
+ return FromWord(x.IAND(Coerce<T>(y)));
+ });
+}
+
+IntegerValueImpl IntegerValueImpl::IOR(const IntegerValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return IntegerValueImpl{};
+ }
+ return withWord([&](const auto &x) {
+ using T = std::decay_t<decltype(x)>;
+ return FromWord(x.IOR(Coerce<T>(y)));
+ });
+}
+
+IntegerValueImpl IntegerValueImpl::IEOR(const IntegerValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return IntegerValueImpl{};
+ }
+ return withWord([&](const auto &x) {
+ using T = std::decay_t<decltype(x)>;
+ return FromWord(x.IEOR(Coerce<T>(y)));
+ });
+}
+
+IntegerValueImpl IntegerValueImpl::MERGE_BITS(
+ const IntegerValueImpl &y, const IntegerValueImpl &mask) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return IntegerValueImpl{};
+ }
+ return withWord([&](const auto &x) {
+ using T = std::decay_t<decltype(x)>;
+ return FromWord(x.MERGE_BITS(Coerce<T>(y), Coerce<T>(mask)));
+ });
+}
+
+IntegerValueImpl IntegerValueImpl::SHIFTL(int count) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return IntegerValueImpl{};
+ }
+ return withWord([&](const auto &x) { return FromWord(x.SHIFTL(count)); });
+}
+
+IntegerValueImpl IntegerValueImpl::SHIFTR(int count) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return IntegerValueImpl{};
+ }
+ return withWord([&](const auto &x) { return FromWord(x.SHIFTR(count)); });
+}
+
+IntegerValueImpl IntegerValueImpl::SHIFTA(int count) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return IntegerValueImpl{};
+ }
+ return withWord([&](const auto &x) { return FromWord(x.SHIFTA(count)); });
+}
+
+IntegerValueImpl IntegerValueImpl::ISHFTC(int count, int size) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return IntegerValueImpl{};
+ }
+ return withWord([&](const auto &x) {
+ using T = std::decay_t<decltype(x)>;
+ return FromWord(x.ISHFTC(count, size <= 0 ? T::bits : size));
+ });
+}
+
+IntegerValueImpl IntegerValueImpl::IBITS(int pos, int size) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return IntegerValueImpl{};
+ }
+ return withWord([&](const auto &x) { return FromWord(x.IBITS(pos, size)); });
+}
+
+IntegerValueImpl IntegerValueImpl::IBSET(int pos) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return IntegerValueImpl{};
+ }
+ return withWord([&](const auto &x) { return FromWord(x.IBSET(pos)); });
+}
+
+IntegerValueImpl IntegerValueImpl::IBCLR(int pos) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return IntegerValueImpl{};
+ }
+ return withWord([&](const auto &x) { return FromWord(x.IBCLR(pos)); });
+}
+
+IntegerValueImpl IntegerValueImpl::DSHIFTL(
+ const IntegerValueImpl &fill, int count) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return IntegerValueImpl{};
+ }
+ // DSHIFTL(I,J) shifts I:J left; the second argument is the right fill.
+ return withWord([&](const auto &x) {
+ using T = std::decay_t<decltype(x)>;
+ return FromWord(x.SHIFTLWithFill(Coerce<T>(fill), count));
+ });
+}
+
+IntegerValueImpl IntegerValueImpl::DSHIFTR(
+ const IntegerValueImpl &v2, int count) const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return IntegerValueImpl{};
+ }
+ // DSHIFTR(I,J) shifts I:J right; the *first* argument (this) is the left
+ // fill, and the receiver of the shift is v2 (mirrors value::Integer's
+ // DSHIFTR, whose *this is the shifted operand and whose argument is the
+ // fill).
+ return v2.withWord([&](const auto &x2) {
+ using T = std::decay_t<decltype(x2)>;
+ return FromWord(x2.SHIFTRWithFill(Coerce<T>(*this), count));
+ });
+}
+
+bool IntegerValueImpl::BTEST(int pos) const {
+ if (IsMonostate()) {
+ return false; // uninitialized int representing 0 has no bits set
+ }
+ return withWord([&](const auto &x) { return x.BTEST(pos); });
+}
+
+int IntegerValueImpl::LEADZ() const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return 0;
+ }
+ return withWord([](const auto &x) { return x.LEADZ(); });
+}
+
+int IntegerValueImpl::TRAILZ() const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return 0;
+ }
+ return withWord([](const auto &x) { return x.TRAILZ(); });
+}
+
+int IntegerValueImpl::POPCNT() const {
+ if (IsMonostate()) {
+ return 0; // uninitialized int representing 0 has no bits set
+ }
+ return withWord([](const auto &x) { return x.POPCNT(); });
+}
+
+bool IntegerValueImpl::POPPAR() const {
+ if (IsMonostate()) {
+ llvm_unreachable("incompatible ints");
+ return false;
+ }
+ return withWord([](const auto &x) { return x.POPPAR(); });
+}
+
+typename IntegerValueImpl::ValueWithOverflow IntegerValueImpl::ConvertSigned(
+ const IntegerValueImpl &from, int toBits) {
+ if (from.IsMonostate()) {
+ return {};
+ }
+ return from.withWord([&](const auto &x) -> ValueWithOverflow {
+ using S = std::decay_t<decltype(x)>;
+ return withWordProto(toBits / 8, [&](auto proto) -> ValueWithOverflow {
+ using T = decltype(proto);
+ auto r{T::template ConvertSigned<S>(x)};
+ return {FromWord(r.value), r.overflow};
+ });
+ });
+}
+
+typename IntegerValueImpl::ValueWithOverflow IntegerValueImpl::ConvertUnsigned(
+ const IntegerValueImpl &from, int toBits) {
+ if (from.IsMonostate()) {
+ return {};
+ }
+ return from.withWord([&](const auto &x) -> ValueWithOverflow {
+ using S = std::decay_t<decltype(x)>;
+ return withWordProto(toBits / 8, [&](auto proto) -> ValueWithOverflow {
+ using T = decltype(proto);
+ auto r{T::template ConvertUnsigned<S>(x)};
+ return {FromWord(r.value), r.overflow};
+ });
+ });
+}
+
+typename IntegerValueImpl::ValueWithOverflow IntegerValueImpl::Read(
+ int kind, const char *&pp, int base, bool isSigned) {
+ return withWordProto(kind, [&](auto proto) -> ValueWithOverflow {
+ using T = decltype(proto);
+ auto r{T::Read(pp, base, isSigned)};
+ return {FromWord(r.value), r.overflow};
+ });
+}
+
+std::string IntegerValueImpl::SignedDecimal() const {
+ if (IsMonostate()) {
+ return "0";
+ }
+ return withWord([](const auto &x) { return x.SignedDecimal(); });
+}
+
+std::string IntegerValueImpl::UnsignedDecimal() const {
+ if (IsMonostate()) {
+ return "0";
+ }
+ return withWord([](const auto &x) { return x.UnsignedDecimal(); });
+}
+
+std::string IntegerValueImpl::Hexadecimal() const {
+ if (IsMonostate()) {
+ return "0";
+ }
+ return withWord([](const auto &x) { return x.Hexadecimal(); });
+}
+
+void IntegerValueImpl::StoreRawBytes(
+ void *dst, size_t expectedSize, bool *changed) const {
+ CHECK(expectedSize == bytesStored());
+
+ withWord([dst, changed, bytesStored = bytesStored()](auto w) {
+ assert(bytesStored == sizeof(w));
+
+ if (changed) {
+ if (std::memcmp(dst, &w, bytesStored) == 0) {
+ return;
+ }
+ *changed = true;
+ }
+ std::memcpy(dst, &w, bytesStored);
+ });
+}
+
+} // namespace Fortran::evaluate::value
diff --git a/flang/lib/Evaluate/integer-value-impl.h b/flang/lib/Evaluate/integer-value-impl.h
new file mode 100644
index 0000000000000..d05ef8a485519
--- /dev/null
+++ b/flang/lib/Evaluate/integer-value-impl.h
@@ -0,0 +1,308 @@
+//===-- lib/Evaluate/integer-value-impl.h ----------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_EVALUATE_INTEGER_VALUE_IMPL_H_
+#define FORTRAN_EVALUATE_INTEGER_VALUE_IMPL_H_
+
+#include "flang/Evaluate/integer.h"
+#include "llvm/Support/ErrorHandling.h"
+#include <cstdint>
+#include <cstring>
+#include <string>
+#include <type_traits>
+#include <variant>
+
+// Some environments, viz. glibc 2.17 and *BSD, allow the macro HUGE
+// to leak out of <math.h>.
+#undef HUGE
+
+namespace Fortran::evaluate::value {
+
+class IntegerValueImpl {
+public:
+ // Per-KIND fixed-width backing formats. I80 (X87IntegerContainer) is not
+ // itself a Fortran INTEGER kind, but used as REAL(10) storage. While
+ // RealValue has its own RealValueImpl, IntegerValue still needs to able to
+ // hold it with conversions such as RealValue::IntegerValue().
+ using I8 = Integer<8>;
+ using I16 = Integer<16>;
+ using I32 = Integer<32>;
+ using I64 = Integer<64>;
+ using I80 = X87IntegerContainer;
+ using I128 = Integer<128>;
+ using Storage = std::variant<std::monostate, I8, I16, I32, I64, I80, I128>;
+
+ struct ValueWithOverflow;
+ struct ValueWithCarry;
+ struct Product;
+ struct QuotientWithRemainder;
+ struct PowerWithErrors;
+
+ // rule-of-five
+ ~IntegerValueImpl() = default;
+ IntegerValueImpl(const IntegerValueImpl &) = default;
+ IntegerValueImpl(IntegerValueImpl &&) = default;
+ IntegerValueImpl &operator=(const IntegerValueImpl &) = default;
+ IntegerValueImpl &operator=(IntegerValueImpl &&) = default;
+
+ IntegerValueImpl() = default;
+ IntegerValueImpl(int kind, const IntegerValueImpl &x) : IntegerValueImpl(x) {
+ CHECK(x.kind() == kind);
+ }
+
+ static IntegerValueImpl Zero(int kind);
+
+ template <typename INT, typename = std::enable_if_t<std::is_integral_v<INT>>>
+ IntegerValueImpl(int kind, INT n) {
+ withWordProto(kind, [&](auto proto) {
+ using T = decltype(proto);
+ storage_ = T{n};
+ });
+ }
+
+ template <typename T> static IntegerValueImpl FromWord(const T &n) {
+ IntegerValueImpl v;
+ v.storage_ = n;
+ return v;
+ }
+
+ static IntegerValueImpl FromRawBytes(
+ int kind, const void *raw, std::size_t expectedSize);
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+ LLVM_DUMP_METHOD void dump() const;
+#endif
+
+ bool IsMonostate() const { return storage_.index() == 0; }
+ int kind() const;
+
+ int bits() const;
+
+ std::size_t bytesStored() const { return bytesStored(kind()); }
+ static constexpr std::size_t bytesStored(int kind) {
+ switch (kind) {
+ case 3:
+ return 2;
+ case 10:
+ return 16;
+ default:
+ return kind;
+ }
+ }
+
+ bool IsZero() const;
+
+ // Comparison operators
+ bool operator<(const IntegerValueImpl &y) const {
+ return CompareSigned(y) == Ordering::Less;
+ }
+ bool operator<=(const IntegerValueImpl &y) const { return !(y < *this); }
+ bool operator==(const IntegerValueImpl &y) const;
+ bool operator!=(const IntegerValueImpl &y) const { return !(*this == y); }
+ bool operator>=(const IntegerValueImpl &y) const { return !(*this < y); }
+ bool operator>(const IntegerValueImpl &y) const { return y < *this; }
+
+ /// Left-justified mask (e.g., MASKL(1) has only its sign bit set)
+ static IntegerValueImpl MASKL(int kind, int places);
+ /// Right-justified mask (e.g., MASKR(1) == 1, MASKR(2) == 3, &c.)
+ static IntegerValueImpl MASKR(int kind, int places);
+ static IntegerValueImpl HUGE(int kind);
+ static IntegerValueImpl Least(int kind);
+
+ bool IsNegative() const;
+
+ std::uint64_t ToUInt64() const;
+ std::int64_t ToInt64() const;
+
+ // Signed/unsigned comparisons
+ Ordering CompareSigned(const IntegerValueImpl &y) const;
+ Ordering CompareUnsigned(const IntegerValueImpl &y) const;
+ Ordering CompareToZeroSigned() const;
+
+ // Arithmetic
+ ValueWithOverflow Negate() const;
+ ValueWithOverflow ABS() const;
+
+ ValueWithCarry AddUnsigned(
+ const IntegerValueImpl &y, bool carryIn = false) const;
+ ValueWithOverflow AddSigned(const IntegerValueImpl &y) const;
+ ValueWithOverflow SubtractSigned(const IntegerValueImpl &y) const;
+ ValueWithOverflow DIM(const IntegerValueImpl &y) const;
+ ValueWithOverflow SIGN(const IntegerValueImpl &sign) const;
+
+ Product MultiplySigned(const IntegerValueImpl &y) const;
+ Product MultiplyUnsigned(const IntegerValueImpl &y) const;
+ QuotientWithRemainder DivideSigned(const IntegerValueImpl &y) const;
+ QuotientWithRemainder DivideUnsigned(const IntegerValueImpl &y) const;
+ ValueWithOverflow MODULO(const IntegerValueImpl &y) const;
+ PowerWithErrors Power(const IntegerValueImpl &e) const;
+
+ // Bitwise operations
+ IntegerValueImpl NOT() const;
+ IntegerValueImpl IAND(const IntegerValueImpl &y) const;
+ IntegerValueImpl IOR(const IntegerValueImpl &y) const;
+ IntegerValueImpl IEOR(const IntegerValueImpl &y) const;
+ IntegerValueImpl MERGE_BITS(
+ const IntegerValueImpl &y, const IntegerValueImpl &mask) const;
+ IntegerValueImpl MAX(const IntegerValueImpl &y) const {
+ return CompareSigned(y) == Ordering::Less ? y : *this;
+ }
+ IntegerValueImpl MIN(const IntegerValueImpl &y) const {
+ return CompareSigned(y) == Ordering::Less ? *this : y;
+ }
+
+ // Shift operations
+ IntegerValueImpl ISHFT(int count) const {
+ return count < 0 ? SHIFTR(-count) : SHIFTL(count);
+ }
+ IntegerValueImpl SHIFTL(int count) const;
+ IntegerValueImpl SHIFTR(int count) const;
+ IntegerValueImpl SHIFTA(int count) const;
+ IntegerValueImpl ISHFTC(int count, int size) const;
+ IntegerValueImpl ISHFTC(int count) const { return ISHFTC(count, bits()); }
+ IntegerValueImpl IBITS(int pos, int size) const;
+ IntegerValueImpl IBSET(int pos) const;
+ IntegerValueImpl IBCLR(int pos) const;
+ IntegerValueImpl DSHIFTL(const IntegerValueImpl &fill, int count) const;
+ IntegerValueImpl DSHIFTR(const IntegerValueImpl &v2, int count) const;
+ bool BTEST(int pos) const;
+ int LEADZ() const;
+ int TRAILZ() const;
+ int POPCNT() const;
+ bool POPPAR() const;
+
+ static ValueWithOverflow ConvertSigned(
+ const IntegerValueImpl &from, int toBits);
+ static ValueWithOverflow ConvertUnsigned(
+ const IntegerValueImpl &from, int toBits);
+
+ static ValueWithOverflow Read(
+ int kind, const char *&pp, int base, bool isSigned);
+
+ // Formatting
+ std::string SignedDecimal() const;
+ std::string UnsignedDecimal() const;
+ std::string Hexadecimal() const;
+
+ // y converted (sign-preserving) to T, so that binary operations operate on
+ // operands of equal width. A monostate operand is treated as a zero of
+ // that width.
+ template <typename T> static T Coerce(const IntegerValueImpl &y) {
+ if (y.IsMonostate()) {
+ return T{};
+ }
+ return y.withWord([](const auto &yv) -> T {
+ using S = std::decay_t<decltype(yv)>;
+ if constexpr (std::is_same_v<S, T>) {
+ return yv;
+ } else {
+ return T::template ConvertSigned<S>(yv).value;
+ }
+ });
+ }
+
+ // Same as Coerce, but zero-extending rather than sign-extending.
+ template <typename T> static T CoerceUnsigned(const IntegerValueImpl &y) {
+ if (y.IsMonostate()) {
+ return T{};
+ }
+ return y.withWord([](const auto &yv) -> T {
+ using S = std::decay_t<decltype(yv)>;
+ if constexpr (std::is_same_v<S, T>) {
+ return yv;
+ } else {
+ return T::template ConvertUnsigned<S>(yv).value;
+ }
+ });
+ }
+
+ void StoreRawBytes(void *dst, size_t size, bool *changed) const;
+
+ // Compile-time dispatchers to current/specified kind
+
+ template <typename F>
+ auto withWordProto(F &&f) const
+ -> decltype(std::declval<F>()(std::declval<I64>())) {
+ return withWordProto(kind(), std::forward<F>(f));
+ }
+
+ template <typename F>
+ static auto withWordProto(int kind, F &&f)
+ -> decltype(std::declval<F>()(std::declval<I64>())) {
+ switch (kind) {
+ case 1:
+ return f(I8{});
+ case 2:
+ case 3:
+ return f(I16{});
+ case 4:
+ return f(I32{});
+ case 8:
+ return f(I64{});
+ case 10:
+ return f(I80{});
+ case 16:
+ return f(I128{});
+ default:
+ llvm_unreachable("unsupported integer width");
+ }
+ }
+
+ template <typename F>
+ auto withWord(F &&f) const
+ -> decltype(std::declval<F>()(std::declval<I64>())) {
+ switch (storage_.index()) {
+ case 1:
+ return f(std::get<I8>(storage_));
+ case 2:
+ return f(std::get<I16>(storage_));
+ case 3:
+ return f(std::get<I32>(storage_));
+ case 4:
+ return f(std::get<I64>(storage_));
+ case 5:
+ return f(std::get<I80>(storage_));
+ case 6:
+ return f(std::get<I128>(storage_));
+ default:
+ llvm_unreachable("operation on uninitialized IntegerValueImpl");
+ }
+ }
+
+private:
+ Storage storage_;
+};
+
+struct IntegerValueImpl::ValueWithOverflow {
+ IntegerValueImpl value;
+ bool overflow{false};
+};
+
+struct IntegerValueImpl::ValueWithCarry {
+ IntegerValueImpl value;
+ bool carry{false};
+};
+
+struct IntegerValueImpl::Product {
+ IntegerValueImpl upper, lower;
+ bool SignedMultiplicationOverflowed() const { return overflow; }
+ bool overflow{false};
+};
+
+struct IntegerValueImpl::QuotientWithRemainder {
+ IntegerValueImpl quotient, remainder;
+ bool divisionByZero{false}, overflow{false};
+};
+
+struct IntegerValueImpl::PowerWithErrors {
+ IntegerValueImpl power;
+ bool divisionByZero{false}, overflow{false}, zeroToZero{false};
+};
+
+} // namespace Fortran::evaluate::value
+#endif // FORTRAN_EVALUATE_INTEGER_VALUE_IMPL_H_
diff --git a/flang/lib/Evaluate/integer-value.cpp b/flang/lib/Evaluate/integer-value.cpp
new file mode 100644
index 0000000000000..e0a0031af3bfc
--- /dev/null
+++ b/flang/lib/Evaluate/integer-value.cpp
@@ -0,0 +1,304 @@
+//===-- lib/Evaluate/integer-value.cpp ------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Evaluate/integer-value.h"
+#include "integer-value-impl.h"
+#include <new>
+
+namespace Fortran::evaluate::value {
+static_assert(sizeof(IntegerValueImpl) == detail::kIntegerObjectSize);
+static_assert(alignof(IntegerValueImpl) == detail::kIntegerObjectAlign);
+static_assert(sizeof(IntegerValue) == sizeof(IntegerValueImpl));
+static_assert(alignof(IntegerValue) == alignof(IntegerValueImpl));
+
+IntegerValue::IntegerValue() { new (this) IntegerValueImpl(); }
+
+IntegerValue::~IntegerValue() { impl().~IntegerValueImpl(); }
+
+IntegerValue::IntegerValue(const IntegerValue &x) {
+ new (this) IntegerValueImpl(x.impl());
+}
+
+IntegerValue::IntegerValue(IntegerValue &&x) {
+ new (this) IntegerValueImpl(std::move(x.impl()));
+}
+
+IntegerValue &IntegerValue::operator=(const IntegerValue &x) {
+ impl() = x.impl();
+ return *this;
+}
+
+IntegerValue &IntegerValue::operator=(IntegerValue &&x) {
+ impl() = std::move(x.impl());
+ return *this;
+}
+
+IntegerValue IntegerValue::Zero(int kind) {
+ return FromImpl(IntegerValueImpl::Zero(kind));
+}
+
+bool IntegerValue::IsMonostate() const { return impl().IsMonostate(); }
+
+int IntegerValue::kind() const { return impl().kind(); }
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+LLVM_DUMP_METHOD void IntegerValue::dump() const { impl().dump(); }
+#endif
+
+bool IntegerValue::operator==(const IntegerValue &y) const {
+ return impl() == y.impl();
+}
+
+IntegerValue IntegerValue::MASKL(int kind, int places) {
+ return FromImpl(IntegerValueImpl::MASKL(kind, places));
+}
+
+IntegerValue IntegerValue::MASKR(int kind, int places) {
+ return FromImpl(IntegerValueImpl::MASKR(kind, places));
+}
+
+IntegerValue::ValueWithOverflow IntegerValue::Read(
+ int kind, const char *&pp, int base, bool isSigned) {
+ auto r{IntegerValueImpl::Read(kind, pp, base, isSigned)};
+ return {FromImpl(std::move(r.value)), r.overflow};
+}
+
+IntegerValue::ValueWithOverflow IntegerValue::ConvertUnsigned(
+ const IntegerValue &from, int toBits) {
+ auto r{IntegerValueImpl::ConvertUnsigned(from.impl(), toBits)};
+ return {FromImpl(std::move(r.value)), r.overflow};
+}
+
+typename IntegerValue::ValueWithOverflow IntegerValue::ConvertSigned(
+ const IntegerValue &from, int toBits) {
+ auto r{IntegerValueImpl::ConvertSigned(from.impl(), toBits)};
+ return {FromImpl(std::move(r.value)), r.overflow};
+}
+
+std::string IntegerValue::UnsignedDecimal() const {
+ return impl().UnsignedDecimal();
+}
+
+std::string IntegerValue::SignedDecimal() const {
+ return impl().SignedDecimal();
+}
+
+std::string IntegerValue::Hexadecimal() const { return impl().Hexadecimal(); }
+
+IntegerValue IntegerValue::HUGE(int kind) {
+ return FromImpl(IntegerValueImpl::HUGE(kind));
+}
+
+IntegerValue IntegerValue::Least(int kind) {
+ return FromImpl(IntegerValueImpl::Least(kind));
+}
+
+int IntegerValue::RANGE(int kind) { return DecimalRange(kind * 8 - 1); }
+
+int IntegerValue::UnsignedRANGE(int kind) { return DecimalRange(kind * 8); }
+
+bool IntegerValue::IsZero() const { return impl().IsZero(); }
+
+bool IntegerValue::IsNegative() const { return impl().IsNegative(); }
+
+Ordering IntegerValue::CompareToZeroSigned() const {
+ return impl().CompareToZeroSigned();
+}
+
+int IntegerValue::LEADZ() const { return impl().LEADZ(); }
+
+int IntegerValue::POPCNT() const { return impl().POPCNT(); }
+
+bool IntegerValue::POPPAR() const { return impl().POPPAR(); }
+
+int IntegerValue::TRAILZ() const { return impl().TRAILZ(); }
+
+bool IntegerValue::BTEST(int pos) const { return impl().BTEST(pos); }
+
+Ordering IntegerValue::CompareUnsigned(const IntegerValue &y) const {
+ return impl().CompareUnsigned(y.impl());
+}
+
+Ordering IntegerValue::CompareSigned(const IntegerValue &y) const {
+ return impl().CompareSigned(y.impl());
+}
+
+std::uint64_t IntegerValue::ToUInt64() const { return impl().ToUInt64(); }
+
+std::int64_t IntegerValue::ToInt64() const { return impl().ToInt64(); }
+
+IntegerValue IntegerValue::NOT() const { return FromImpl(impl().NOT()); }
+
+typename IntegerValue::ValueWithOverflow IntegerValue::Negate() const {
+ auto r{impl().Negate()};
+ return {FromImpl(std::move(r.value)), r.overflow};
+}
+typename IntegerValue::ValueWithOverflow IntegerValue::ABS() const {
+ auto r{impl().ABS()};
+ return {FromImpl(std::move(r.value)), r.overflow};
+}
+
+IntegerValue IntegerValue::SHIFTL(int count) const {
+ return FromImpl(impl().SHIFTL(count));
+}
+
+IntegerValue IntegerValue::ISHFTC(int count, int size) const {
+ return FromImpl(impl().ISHFTC(count, size));
+}
+
+IntegerValue IntegerValue::ISHFTC(int count) const {
+ return FromImpl(impl().ISHFTC(count));
+}
+
+IntegerValue IntegerValue::DSHIFTL(const IntegerValue &fill, int count) const {
+ return FromImpl(impl().DSHIFTL(fill.impl(), count));
+}
+
+IntegerValue IntegerValue::DSHIFTR(const IntegerValue &v2, int count) const {
+ return FromImpl(impl().DSHIFTR(v2.impl(), count));
+}
+
+IntegerValue IntegerValue::SHIFTR(int count) const {
+ return FromImpl(impl().SHIFTR(count));
+}
+
+IntegerValue IntegerValue::SHIFTA(int count) const {
+ return FromImpl(impl().SHIFTA(count));
+}
+
+IntegerValue IntegerValue::IBCLR(int pos) const {
+ return FromImpl(impl().IBCLR(pos));
+}
+
+IntegerValue IntegerValue::IBSET(int pos) const {
+ return FromImpl(impl().IBSET(pos));
+}
+
+IntegerValue IntegerValue::IBITS(int pos, int size) const {
+ return FromImpl(impl().IBITS(pos, size));
+}
+
+IntegerValue IntegerValue::IAND(const IntegerValue &y) const {
+ return FromImpl(impl().IAND(y.impl()));
+}
+
+IntegerValue IntegerValue::IOR(const IntegerValue &y) const {
+ return FromImpl(impl().IOR(y.impl()));
+}
+
+IntegerValue IntegerValue::IEOR(const IntegerValue &y) const {
+ return FromImpl(impl().IEOR(y.impl()));
+}
+
+IntegerValue IntegerValue::MERGE_BITS(
+ const IntegerValue &y, const IntegerValue &mask) const {
+ return FromImpl(impl().MERGE_BITS(y.impl(), mask.impl()));
+}
+
+typename IntegerValue::ValueWithCarry IntegerValue::AddUnsigned(
+ const IntegerValue &y, bool carryIn) const {
+ auto r{impl().AddUnsigned(y.impl(), carryIn)};
+ return {FromImpl(std::move(r.value)), r.carry};
+}
+
+typename IntegerValue::ValueWithOverflow IntegerValue::AddSigned(
+ const IntegerValue &y) const {
+ auto r{impl().AddSigned(y.impl())};
+ return {FromImpl(std::move(r.value)), r.overflow};
+}
+
+typename IntegerValue::ValueWithOverflow IntegerValue::SubtractSigned(
+ const IntegerValue &y) const {
+ auto r{impl().SubtractSigned(y.impl())};
+ return {FromImpl(std::move(r.value)), r.overflow};
+}
+
+typename IntegerValue::ValueWithOverflow IntegerValue::DIM(
+ const IntegerValue &y) const {
+ auto r{impl().DIM(y.impl())};
+ return {FromImpl(std::move(r.value)), r.overflow};
+}
+
+typename IntegerValue::ValueWithOverflow IntegerValue::SIGN(
+ const IntegerValue &sign) const {
+ auto r{impl().SIGN(sign.impl())};
+ return {FromImpl(std::move(r.value)), r.overflow};
+}
+
+typename IntegerValue::Product IntegerValue::MultiplyUnsigned(
+ const IntegerValue &y) const {
+ auto r{impl().MultiplyUnsigned(y.impl())};
+ return {
+ FromImpl(std::move(r.upper)), FromImpl(std::move(r.lower)), r.overflow};
+}
+
+typename IntegerValue::Product IntegerValue::MultiplySigned(
+ const IntegerValue &y) const {
+ auto r{impl().MultiplySigned(y.impl())};
+ return {
+ FromImpl(std::move(r.upper)), FromImpl(std::move(r.lower)), r.overflow};
+}
+
+typename IntegerValue::QuotientWithRemainder IntegerValue::DivideUnsigned(
+ const IntegerValue &y) const {
+ auto r{impl().DivideUnsigned(y.impl())};
+ return {FromImpl(std::move(r.quotient)), FromImpl(std::move(r.remainder)),
+ r.divisionByZero, r.overflow};
+}
+
+typename IntegerValue::QuotientWithRemainder IntegerValue::DivideSigned(
+ const IntegerValue &y) const {
+ auto r{impl().DivideSigned(y.impl())};
+ return {FromImpl(std::move(r.quotient)), FromImpl(std::move(r.remainder)),
+ r.divisionByZero, r.overflow};
+}
+
+typename IntegerValue::ValueWithOverflow IntegerValue::MODULO(
+ const IntegerValue &y) const {
+ auto r{impl().MODULO(y.impl())};
+ return {FromImpl(std::move(r.value)), r.overflow};
+}
+
+typename IntegerValue::PowerWithErrors IntegerValue::Power(
+ const IntegerValue &e) const {
+ auto r{impl().Power(e.impl())};
+ return {
+ FromImpl(std::move(r.power)), r.divisionByZero, r.overflow, r.zeroToZero};
+}
+
+IntegerValue IntegerValue::FromRawBytes(
+ int kind, const void *raw, std::size_t expectedSize) {
+ return FromImpl(IntegerValueImpl::FromRawBytes(kind, raw, expectedSize));
+}
+
+void IntegerValue::StoreRawBytes(void *dst, size_t size, bool *changed) const {
+ impl().StoreRawBytes(dst, size, changed);
+}
+
+void IntegerValue::ConstructFromIntegral(
+ int kind, std::uint64_t n, bool isSigned) {
+ if (isSigned) {
+ new (this) IntegerValueImpl(kind, static_cast<std::int64_t>(n));
+ } else {
+ new (this) IntegerValueImpl(kind, n);
+ }
+}
+
+IntegerValue IntegerValue::FromImpl(const IntegerValueImpl &x) {
+ IntegerValue r;
+ r.impl() = x;
+ return r;
+}
+
+IntegerValue IntegerValue::FromImpl(IntegerValueImpl &&x) {
+ IntegerValue r;
+ r.impl() = std::move(x);
+ return r;
+}
+
+} // namespace Fortran::evaluate::value
diff --git a/flang/lib/Evaluate/intrinsics-library.cpp b/flang/lib/Evaluate/intrinsics-library.cpp
index f2c1a7bfaf50b..adfc295b97a2c 100644
--- a/flang/lib/Evaluate/intrinsics-library.cpp
+++ b/flang/lib/Evaluate/intrinsics-library.cpp
@@ -152,12 +152,13 @@ template <typename FuncType, typename TR, typename... TA, size_t... I>
static Expr<SomeType> ApplyHostFunctionHelper(FuncType func,
FoldingContext &context, std::vector<Expr<SomeType>> &&args,
std::index_sequence<I...>) {
+ const int kind{TR::kind};
host::HostFloatingPointEnvironment hostFPE;
hostFPE.SetUpHostFloatingPointEnvironment(context);
host::HostType<TR> hostResult{};
Scalar<TR> result{};
std::tuple<Scalar<TA>...> scalarArgs{
- GetScalarConstantValue<TA>(args[I]).value()...};
+ GetScalarConstantValue<typename TA::FortranType>(args[I]).value()...};
if (context.targetCharacteristics().areSubnormalsFlushedToZero() &&
!hostFPE.hasSubnormalFlushingHardwareControl()) {
hostResult = func(host::CastFortranToHost<TA>(
@@ -171,7 +172,8 @@ static Expr<SomeType> ApplyHostFunctionHelper(FuncType func,
CheckFloatingPointIssues<TR>(hostFPE, result);
}
hostFPE.CheckAndRestoreFloatingPointEnvironment(context);
- return AsGenericExpr(Constant<TR>(std::move(result)));
+ return AsGenericExpr(
+ Constant<typename TR::FortranType>(kind, std::move(result)));
}
template <typename HostTR, typename... HostTA>
Expr<SomeType> ApplyHostFunction(FuncPointer<HostTR, HostTA...> func,
@@ -823,9 +825,12 @@ static const Expr<SomeType> &GetArg(
template <typename T>
static bool IsInRange(const Expr<T> &expr, int lb, int ub) {
+ const int kind{expr.kind()};
if (auto scalar{GetScalarConstantValue<T>(expr)}) {
- auto lbValue{Scalar<T>::FromInteger(value::Integer<8>{lb}).value};
- auto ubValue{Scalar<T>::FromInteger(value::Integer<8>{ub}).value};
+ auto lbValue{
+ Scalar<T>::FromInteger(kind, value::IntegerValue{1, lb}).value};
+ auto ubValue{
+ Scalar<T>::FromInteger(kind, value::IntegerValue{1, ub}).value};
return Satisfies(RelationalOperator::LE, lbValue.Compare(*scalar)) &&
Satisfies(RelationalOperator::LE, scalar->Compare(ubValue));
}
@@ -859,9 +864,10 @@ static bool VerifyStrictlyPositiveIfReal(
const bool isStrictlyPositive{std::visit(
[&](const auto &x) -> bool {
using T = typename std::decay_t<decltype(x)>::Result;
+ const int kind{x.kind()};
auto scalar{GetScalarConstantValue<T>(x)};
return Satisfies(
- RelationalOperator::LT, Scalar<T>{}.Compare(*scalar));
+ RelationalOperator::LT, Scalar<T>::Zero(kind).Compare(*scalar));
},
someReal->u)};
if (!isStrictlyPositive) {
diff --git a/flang/lib/Evaluate/logical-value.cpp b/flang/lib/Evaluate/logical-value.cpp
new file mode 100644
index 0000000000000..1b15ae502b26c
--- /dev/null
+++ b/flang/lib/Evaluate/logical-value.cpp
@@ -0,0 +1,25 @@
+//===-- lib/Evaluate/logical-value.cpp ------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Evaluate/logical-value.h"
+
+namespace Fortran::evaluate::value {
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+LLVM_DUMP_METHOD void LogicalValue::dump() const {
+ if (!IsCanonical()) {
+ llvm::errs() << "transfer(" << word().ToInt64() << "_8,.false._" << kind()
+ << ")\n";
+ } else if (IsTrue()) {
+ llvm::errs() << ".true." << '_' << kind() << '\n';
+ } else {
+ llvm::errs() << ".false." << '_' << kind() << '\n';
+ }
+}
+#endif
+
+} // namespace Fortran::evaluate::value
diff --git a/flang/lib/Evaluate/logical.cpp b/flang/lib/Evaluate/logical.cpp
deleted file mode 100644
index 520d11fb967f4..0000000000000
--- a/flang/lib/Evaluate/logical.cpp
+++ /dev/null
@@ -1,17 +0,0 @@
-//===-- lib/Evaluate/logical.cpp ------------------------------------------===//
-//
-// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
-// See https://llvm.org/LICENSE.txt for license information.
-// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-//
-//===----------------------------------------------------------------------===//
-
-#include "flang/Evaluate/logical.h"
-
-namespace Fortran::evaluate::value {
-
-template class Logical<8>;
-template class Logical<16>;
-template class Logical<32>;
-template class Logical<64>;
-} // namespace Fortran::evaluate::value
diff --git a/flang/lib/Evaluate/real-value-impl.cpp b/flang/lib/Evaluate/real-value-impl.cpp
new file mode 100644
index 0000000000000..88847352fa6bf
--- /dev/null
+++ b/flang/lib/Evaluate/real-value-impl.cpp
@@ -0,0 +1,538 @@
+//===-- lib/Evaluate/real-value-impl.cpp ----------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "real-value-impl.h"
+#include "integer-value-impl.h"
+#include "flang/Common/idioms.h"
+#include "flang/Decimal/decimal.h"
+#include "flang/Evaluate/real-value.h"
+#include "flang/Evaluate/rounding-bits.h"
+#include "llvm/Support/raw_ostream.h"
+#include <cstring>
+#include <new>
+#include <string>
+
+namespace Fortran::evaluate::value {
+
+RealValueImpl::RealValueImpl(int kind, const Word &w) {
+ withWordProto(kind, [&](auto proto) {
+ using R = decltype(proto);
+ if (w.IsMonostate()) {
+ storage_ = R{};
+ } else {
+ storage_ = R{FixedIntegerFromValue<typename R::Word>(w)};
+ }
+ });
+}
+
+RealValueImpl RealValueImpl::Zero(int kind) {
+ RealValueImpl result;
+ withWordProto(kind, [&](auto proto) { result.storage_ = decltype(proto){}; });
+ return result;
+}
+
+RealValueImpl RealValueImpl::FromRawBytes(
+ int kind, const void *raw, std::size_t expectedSize) {
+ return RealValueImpl{
+ kind, IntegerValue::FromRawBytes(kind, raw, expectedSize)};
+}
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+LLVM_DUMP_METHOD void RealValueImpl::dump() const {
+ AsFortran(llvm::errs(), kind()) << '\n';
+}
+#endif
+
+int RealValueImpl::kind() const {
+ if (IsMonostate()) {
+ llvm_unreachable("uninitialized value has not a defined kind");
+ }
+
+ return withWord([](const auto &v) -> int {
+ using R = std::decay_t<decltype(v)>;
+ if constexpr (std::is_same_v<R, R3>) {
+ return 3;
+ }
+ return R::bits / 8;
+ });
+}
+
+int RealValueImpl::bits() const {
+ if (IsMonostate()) {
+ return 0;
+ }
+
+ return withWord(
+ [](const auto &v) -> int { return std::decay_t<decltype(v)>::bits; });
+}
+
+bool RealValueImpl::IsZero() const {
+ if (IsMonostate()) {
+ return true;
+ }
+ return withWord([](const auto &v) { return v.IsZero(); });
+}
+
+bool RealValueImpl::operator==(const RealValueImpl &y) const {
+ return withWord([&y](const auto &v1) -> bool {
+ return y.withWord([&v1](const auto &v2) -> bool {
+ if constexpr (std::is_same_v<std::decay_t<decltype(v1)>,
+ std::decay_t<decltype(v2)>>) {
+ return v1 == v2;
+ }
+ llvm_unreachable("Uncomparable reals");
+ });
+ });
+}
+
+int RealValueImpl::DIGITS(int kind) {
+ return withWordProto(kind, [](auto p) { return decltype(p)::DIGITS; });
+}
+
+int RealValueImpl::PRECISION(int kind) {
+ return withWordProto(kind, [](auto p) { return decltype(p)::PRECISION; });
+}
+
+int RealValueImpl::RANGE(int kind) {
+ return withWordProto(kind, [](auto p) { return decltype(p)::RANGE; });
+}
+
+int RealValueImpl::MAXEXPONENT(int kind) {
+ return withWordProto(kind, [](auto p) { return decltype(p)::MAXEXPONENT; });
+}
+
+int RealValueImpl::MINEXPONENT(int kind) {
+ return withWordProto(kind, [](auto p) { return decltype(p)::MINEXPONENT; });
+}
+
+RealValueImpl RealValueImpl::HUGE(int kind) {
+ return withWordProto(
+ kind, [](auto p) { return FromWord(decltype(p)::HUGE()); });
+}
+
+RealValueImpl RealValueImpl::EPSILON(int kind) {
+ return withWordProto(
+ kind, [](auto p) { return FromWord(decltype(p)::EPSILON()); });
+}
+
+RealValueImpl RealValueImpl::TINY(int kind) {
+ return withWordProto(
+ kind, [](auto p) { return FromWord(decltype(p)::TINY()); });
+}
+
+RealValueImpl RealValueImpl::NotANumber(int kind) {
+ return withWordProto(
+ kind, [](auto p) { return FromWord(decltype(p)::NotANumber()); });
+}
+
+bool RealValueImpl::IsNegative() const {
+ if (IsMonostate()) {
+ return false;
+ }
+ return withWord([](const auto &v) { return v.IsNegative(); });
+}
+
+bool RealValueImpl::IsNotANumber() const {
+ if (IsMonostate()) {
+ return false;
+ }
+ return withWord([](const auto &v) { return v.IsNotANumber(); });
+}
+
+bool RealValueImpl::IsSignalingNaN() const {
+ if (IsMonostate()) {
+ return false;
+ }
+ return withWord([](const auto &v) { return v.IsSignalingNaN(); });
+}
+
+bool RealValueImpl::IsInfinite() const {
+ if (IsMonostate()) {
+ return false;
+ }
+ return withWord([](const auto &v) { return v.IsInfinite(); });
+}
+
+bool RealValueImpl::IsFinite() const {
+ if (IsMonostate()) {
+ return true;
+ }
+ return withWord([](const auto &v) { return v.IsFinite(); });
+}
+
+bool RealValueImpl::IsNormal() const {
+ if (IsMonostate()) {
+ return true;
+ }
+ return withWord([](const auto &v) { return v.IsNormal(); });
+}
+
+int RealValueImpl::Exponent() const {
+ if (IsMonostate()) {
+ return 0;
+ }
+ return withWord([](const auto &v) { return v.Exponent(); });
+}
+
+void RealValueImpl::StoreRawBytes(
+ void *dst, size_t expectedSize, bool *changed) const {
+ CHECK(bytesStored() == expectedSize);
+ withWord([=](const auto &v) {
+ auto data{v.RawBits()};
+ CHECK(sizeof(data) == expectedSize);
+ if (std::memcmp(dst, &data, sizeof(data))) {
+ std::memcpy(dst, &data, sizeof(data));
+ if (changed)
+ *changed = true;
+ }
+ });
+}
+
+IntegerValue RealValueImpl::RawBits() const {
+ if (IsMonostate()) {
+ return {};
+ }
+
+ return withWord(
+ [](const auto &v) { return IntegerValueFromFixed(v.RawBits()); });
+}
+
+Relation RealValueImpl::Compare(const RealValueImpl &y) const {
+ if (IsMonostate()) {
+ llvm_unreachable("uncomparable value");
+ }
+ return withWord([&](const auto &v) {
+ using R = std::decay_t<decltype(v)>;
+ return v.Compare(AsWord<R>(y));
+ });
+}
+
+RealValueImpl RealValueImpl::ABS() const {
+ if (IsMonostate()) {
+ return RealValueImpl{};
+ }
+ return withWord([](const auto &v) { return FromWord(v.ABS()); });
+}
+
+RealValueImpl RealValueImpl::Negate() const {
+ if (IsMonostate()) {
+ return RealValueImpl{};
+ }
+ return withWord([](const auto &v) { return FromWord(v.Negate()); });
+}
+
+RealValueImpl RealValueImpl::SIGN(const RealValueImpl &x) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) {
+ using R = std::decay_t<decltype(v)>;
+ return FromWord(v.SIGN(AsWord<R>(x)));
+ });
+}
+
+RealValueImpl RealValueImpl::SetSign(bool toNegative) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord(
+ [&](const auto &v) { return FromWord(v.SetSign(toNegative)); });
+}
+
+RealValueImpl RealValueImpl::FlushSubnormalToZero() const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord(
+ [](const auto &v) { return FromWord(v.FlushSubnormalToZero()); });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::Add(
+ const RealValueImpl &y, Rounding rounding) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) {
+ using R = std::decay_t<decltype(v)>;
+ return FromWord(v.Add(AsWord<R>(y), rounding));
+ });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::Subtract(
+ const RealValueImpl &y, Rounding rounding) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) {
+ using R = std::decay_t<decltype(v)>;
+ return FromWord(v.Subtract(AsWord<R>(y), rounding));
+ });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::Multiply(
+ const RealValueImpl &y, Rounding rounding) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) {
+ using R = std::decay_t<decltype(v)>;
+ return FromWord(v.Multiply(AsWord<R>(y), rounding));
+ });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::Divide(
+ const RealValueImpl &y, Rounding rounding) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) {
+ using R = std::decay_t<decltype(v)>;
+ return FromWord(v.Divide(AsWord<R>(y), rounding));
+ });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::SQRT(Rounding rounding) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) { return FromWord(v.SQRT(rounding)); });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::HYPOT(
+ const RealValueImpl &y, Rounding rounding) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) {
+ using R = std::decay_t<decltype(v)>;
+ return FromWord(v.HYPOT(AsWord<R>(y), rounding));
+ });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::MOD(
+ const RealValueImpl &y, Rounding rounding) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) {
+ using R = std::decay_t<decltype(v)>;
+ return FromWord(v.MOD(AsWord<R>(y), rounding));
+ });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::MODULO(
+ const RealValueImpl &y, Rounding rounding) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) {
+ using R = std::decay_t<decltype(v)>;
+ return FromWord(v.MODULO(AsWord<R>(y), rounding));
+ });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::DIM(
+ const RealValueImpl &y, Rounding rounding) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) {
+ using R = std::decay_t<decltype(v)>;
+ return FromWord(v.DIM(AsWord<R>(y), rounding));
+ });
+}
+
+RealValueImpl RealValueImpl::FRACTION() const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([](const auto &v) { return FromWord(v.FRACTION()); });
+}
+
+RealValueImpl RealValueImpl::RRSPACING() const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([](const auto &v) { return FromWord(v.RRSPACING()); });
+}
+
+RealValueImpl RealValueImpl::SPACING() const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([](const auto &v) { return FromWord(v.SPACING()); });
+}
+
+RealValueImpl RealValueImpl::SET_EXPONENT(std::int64_t e) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) { return FromWord(v.SET_EXPONENT(e)); });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::NEAREST(bool upward) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) { return FromWord(v.NEAREST(upward)); });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::ToWholeNumber(
+ common::RoundingMode mode) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord(
+ [&](const auto &v) { return FromWord(v.ToWholeNumber(mode)); });
+}
+
+ValueWithRealFlags<IntegerValue> RealValueImpl::ToInteger(
+ common::RoundingMode mode, int toBits) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) -> ValueWithRealFlags<IntegerValue> {
+ auto pick{[&](auto target) -> ValueWithRealFlags<IntegerValue> {
+ using W = decltype(target);
+ auto r{v.template ToInteger<W>(mode)};
+ ValueWithRealFlags<IntegerValue> result;
+ result.value = IntegerValueFromFixed(r.value);
+ result.flags = r.flags;
+ return result;
+ }};
+ switch (toBits) {
+ case 8:
+ return pick(Integer<8>{});
+ case 16:
+ return pick(Integer<16>{});
+ case 32:
+ return pick(Integer<32>{});
+ case 64:
+ return pick(Integer<64>{});
+ case 128:
+ return pick(Integer<128>{});
+ default:
+ return pick(Integer<64>{});
+ }
+ });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::SCALE(
+ const IntegerValue &by, Rounding rounding) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) -> ValueWithRealFlags<RealValueImpl> {
+ return FromWord(v.SCALE(Integer<64>{by.ToInt64()}, rounding));
+ });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::KahanSummation(
+ const RealValueImpl &y, RealValueImpl &correction,
+ Rounding rounding) const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([&](const auto &v) {
+ using R = std::decay_t<decltype(v)>;
+ R corr{AsWord<R>(correction)};
+ auto r{v.KahanSummation(AsWord<R>(y), corr, rounding)};
+ correction = FromWord(corr);
+ return FromWord(r);
+ });
+}
+
+IntegerValue RealValueImpl::EXPONENT() const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([](const auto &v) -> IntegerValue {
+ return IntegerValueFromFixed(v.template EXPONENT<Integer<32>>());
+ });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::FromInteger(
+ int kind, const IntegerValue &n, bool isUnsigned, Rounding rounding) {
+ if (n.IsMonostate()) {
+ return ValueWithRealFlags<RealValueImpl>{};
+ }
+ return withWordProto(
+ kind, [&](auto proto) -> ValueWithRealFlags<RealValueImpl> {
+ auto r{FromIntegerValue<decltype(proto)>(n, isUnsigned, rounding)};
+ return {FromWord(r.value), r.flags};
+ });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::Convert(
+ int kind, const RealValueImpl &from, Rounding rounding) {
+ return withWordProto(
+ kind, [&](auto proto) -> ValueWithRealFlags<RealValueImpl> {
+ using R = decltype(proto);
+ if (from.IsMonostate()) {
+ return FromWord(R::Convert(R{}, rounding));
+ }
+ return from.withWord(
+ [&](const auto &v) -> ValueWithRealFlags<RealValueImpl> {
+ return FromWord(R::Convert(v, rounding));
+ });
+ });
+}
+
+ValueWithRealFlags<RealValueImpl> RealValueImpl::Read(
+ int kind, const char *&pp, Rounding rounding) {
+ return withWordProto(
+ kind, [&](auto proto) -> ValueWithRealFlags<RealValueImpl> {
+ auto r{decltype(proto)::Read(pp, rounding)};
+ ValueWithRealFlags<RealValueImpl> result;
+ result.value = FromWord(r.value);
+ result.flags = r.flags;
+ return result;
+ });
+}
+
+std::string RealValueImpl::DumpHexadecimal() const {
+ if (IsMonostate()) {
+ llvm_unreachable("unsupported operation over uninitialized value");
+ }
+ return withWord([](const auto &v) { return v.DumpHexadecimal(); });
+}
+
+llvm::raw_ostream &RealValueImpl::AsFortran(
+ llvm::raw_ostream &o, int kind, bool minimal) const {
+ if (IsMonostate()) {
+ o << "0";
+ return o;
+ }
+ withWord([&](const auto &v) {
+ v.AsFortran(o, kind, minimal);
+ return 0;
+ });
+ return o;
+}
+
+template <typename INT>
+IntegerValue RealValueImpl::IntegerValueFromFixed(const INT &n) {
+ IntegerValue result;
+ result.impl() = IntegerValueImpl::FromWord(n);
+ return result;
+}
+
+template <typename INT>
+INT RealValueImpl::FixedIntegerFromValue(const IntegerValue &v) {
+ return IntegerValueImpl::CoerceUnsigned<INT>(v.impl());
+}
+
+template <typename R>
+ValueWithRealFlags<R> RealValueImpl::FromIntegerValue(
+ const IntegerValue &n, bool isUnsigned, Rounding rounding) {
+ return n.impl().withWord([&](const auto &concrete) {
+ return R::FromInteger(concrete, isUnsigned, rounding);
+ });
+}
+
+} // namespace Fortran::evaluate::value
diff --git a/flang/lib/Evaluate/real-value-impl.h b/flang/lib/Evaluate/real-value-impl.h
new file mode 100644
index 0000000000000..be56259cdb4e0
--- /dev/null
+++ b/flang/lib/Evaluate/real-value-impl.h
@@ -0,0 +1,266 @@
+//===-- lib/Evaluate/real-value-impl.h ------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_EVALUATE_REAL_VALUE_IMPL_H_
+#define FORTRAN_EVALUATE_REAL_VALUE_IMPL_H_
+
+#include "flang/Evaluate/real.h"
+#include "llvm/Support/ErrorHandling.h"
+#include <type_traits>
+#include <utility>
+#include <variant>
+
+// Some environments, viz. glibc 2.17 and *BSD, allow the macro HUGE
+// to leak out of <math.h>.
+#undef HUGE
+
+namespace llvm {
+class raw_ostream;
+}
+
+namespace Fortran::evaluate::value {
+class IntegerValue;
+
+class RealValueImpl {
+public:
+ using R2 = Real<Integer<16>, 11>; // IEEE half
+ using R3 = Real<Integer<16>, 8>; // bfloat16
+ using R4 = Real<Integer<32>, 24>; // IEEE single
+ using R8 = Real<Integer<64>, 53>; // IEEE double
+ using R10 = Real<X87IntegerContainer, 64>; // 80387 extended precision
+ using R16 = Real<Integer<128>, 113>; // IEEE quad
+ using Storage = std::variant<std::monostate, R2, R3, R4, R8, R10, R16>;
+ using Word = IntegerValue;
+
+ // rule-of-five
+ ~RealValueImpl() = default;
+ RealValueImpl(const RealValueImpl &) = default;
+ RealValueImpl(RealValueImpl &&) = default;
+ RealValueImpl &operator=(const RealValueImpl &) = default;
+ RealValueImpl &operator=(RealValueImpl &&) = default;
+
+ RealValueImpl() = default;
+
+ // Interpret w as the raw bit pattern of a value of the given runtime kind.
+ RealValueImpl(int kind, const Word &w);
+
+ static RealValueImpl Zero(int kind);
+
+ template <typename T> static RealValueImpl FromWord(const T &r) {
+ RealValueImpl v;
+ v.storage_ = r;
+ return v;
+ }
+
+ template <typename T>
+ static ValueWithRealFlags<RealValueImpl> FromWord(
+ const ValueWithRealFlags<T> &x) {
+ ValueWithRealFlags<RealValueImpl> r;
+ r.value = FromWord(x.value);
+ r.flags = x.flags;
+ return r;
+ }
+
+ static RealValueImpl FromRawBytes(
+ int kind, const void *raw, std::size_t expectedSize);
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+ LLVM_DUMP_METHOD void dump() const;
+#endif
+
+ bool IsMonostate() const { return storage_.index() == 0; }
+ int kind() const;
+
+ int bits() const;
+
+ std::size_t bytesStored() const { return bytesStored(kind()); }
+ static constexpr std::size_t bytesStored(int kind) {
+ switch (kind) {
+ case 3:
+ return 2;
+ case 10:
+ return 16;
+ default:
+ return kind;
+ }
+ }
+
+ bool IsZero() const;
+
+ // Comparison operators
+ bool operator==(const RealValueImpl &y) const;
+ bool operator!=(const RealValueImpl &y) const { return !(*this == y); }
+
+ // Kind-property inquiries, formerly compile-time constants derived from the
+ // PREC template parameter; now selected by the runtime KIND.
+ static int DIGITS(int kind);
+ static int PRECISION(int kind);
+ static int RANGE(int kind);
+ static int MAXEXPONENT(int kind);
+ static int MINEXPONENT(int kind);
+
+ static RealValueImpl HUGE(int kind);
+ static RealValueImpl EPSILON(int kind);
+ static RealValueImpl TINY(int kind);
+ static RealValueImpl NotANumber(int kind);
+
+ // Runtime kind / width accessors
+ bool IsNegative() const;
+ bool IsNotANumber() const;
+ bool IsSignalingNaN() const;
+ bool IsInfinite() const;
+ bool IsFinite() const;
+ bool IsNormal() const;
+ int Exponent() const;
+ void StoreRawBytes(void *dst, size_t size, bool *changed) const;
+
+ // The raw bit pattern at the value's runtime width.
+ IntegerValue RawBits() const;
+
+ // Comparisons
+ Relation Compare(const RealValueImpl &y) const;
+
+ // Unary operations
+ RealValueImpl ABS() const;
+ RealValueImpl Negate() const;
+ RealValueImpl SIGN(const RealValueImpl &x) const;
+ RealValueImpl SetSign(bool toNegative) const;
+ RealValueImpl FlushSubnormalToZero() const;
+
+ // Binary arithmetic
+ ValueWithRealFlags<RealValueImpl> Add(const RealValueImpl &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<RealValueImpl> Subtract(const RealValueImpl &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<RealValueImpl> Multiply(const RealValueImpl &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<RealValueImpl> Divide(const RealValueImpl &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<RealValueImpl> SQRT(
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<RealValueImpl> HYPOT(const RealValueImpl &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<RealValueImpl> MOD(const RealValueImpl &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<RealValueImpl> MODULO(const RealValueImpl &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<RealValueImpl> DIM(const RealValueImpl &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ RealValueImpl FRACTION() const;
+ RealValueImpl RRSPACING() const;
+ RealValueImpl SPACING() const;
+ RealValueImpl SET_EXPONENT(std::int64_t e) const;
+
+ ValueWithRealFlags<RealValueImpl> NEAREST(bool upward) const;
+ ValueWithRealFlags<RealValueImpl> ToWholeNumber(
+ common::RoundingMode mode = common::RoundingMode::ToZero) const;
+ // Convert this real to an integer of the given bit width.
+ ValueWithRealFlags<IntegerValue> ToInteger(
+ common::RoundingMode mode = common::RoundingMode::ToZero,
+ int toBits = 0) const;
+
+ ValueWithRealFlags<RealValueImpl> SCALE(const IntegerValue &by,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ ValueWithRealFlags<RealValueImpl> KahanSummation(const RealValueImpl &y,
+ RealValueImpl &correction,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+
+ IntegerValue EXPONENT() const;
+
+ // Conversion from an integer facade (REAL()).
+ static ValueWithRealFlags<RealValueImpl> FromInteger(int kind,
+ const IntegerValue &n, bool isUnsigned = false,
+ Rounding rounding = TargetCharacteristics::defaultRounding);
+
+ // Conversion between real kinds.
+ static ValueWithRealFlags<RealValueImpl> Convert(int kind,
+ const RealValueImpl &from,
+ Rounding rounding = TargetCharacteristics::defaultRounding);
+
+ static ValueWithRealFlags<RealValueImpl> Read(int kind, const char *&pp,
+ Rounding rounding = TargetCharacteristics::defaultRounding);
+
+ std::string DumpHexadecimal() const;
+ llvm::raw_ostream &AsFortran(
+ llvm::raw_ostream &o, int kind, bool minimal = false) const;
+
+ template <typename V> static std::decay_t<V> AsWord(const RealValueImpl &y) {
+ using R = std::decay_t<V>;
+ if (y.IsMonostate()) {
+ return R{};
+ }
+
+ return y.withWord([](const auto &yv) -> R {
+ using YR = std::decay_t<decltype(yv)>;
+ if constexpr (std::is_same_v<YR, R>) {
+ return yv;
+ } else {
+ return R::Convert(yv).value;
+ }
+ });
+ }
+
+ // Compile-time dispatchers to current/specified kind
+
+ template <typename F> static inline auto withWordProto(int kind, F &&f) {
+ using namespace Fortran::evaluate::value;
+ switch (kind) {
+ case 2:
+ return f(RealValueImpl::R2{});
+ case 3:
+ return f(RealValueImpl::R3{});
+ case 4:
+ return f(RealValueImpl::R4{});
+ case 8:
+ return f(RealValueImpl::R8{});
+ case 10:
+ return f(RealValueImpl::R10{});
+ case 16:
+ return f(RealValueImpl::R16{});
+ default:
+ llvm_unreachable("arbitrary bits not yet supported");
+ }
+ }
+
+ template <typename F> auto withWord(F &&f) const {
+ switch (storage_.index()) {
+ case 1:
+ return f(std::get<R2>(storage_));
+ case 2:
+ return f(std::get<R3>(storage_));
+ case 3:
+ return f(std::get<R4>(storage_));
+ case 4:
+ return f(std::get<R8>(storage_));
+ case 5:
+ return f(std::get<R10>(storage_));
+ case 6:
+ return f(std::get<R16>(storage_));
+ default:
+ llvm_unreachable("operation on uninitialized RealValueImpl");
+ }
+ }
+
+private:
+ template <typename INT>
+ static IntegerValue IntegerValueFromFixed(const INT &);
+
+ template <typename INT>
+ static INT FixedIntegerFromValue(const IntegerValue &);
+
+ template <typename R>
+ static ValueWithRealFlags<R> FromIntegerValue(
+ const IntegerValue &v, bool isUnsigned, Rounding rounding);
+
+ Storage storage_;
+};
+
+} // namespace Fortran::evaluate::value
+#endif // FORTRAN_EVALUATE_REAL_VALUE_IMPL_H_
diff --git a/flang/lib/Evaluate/real-value.cpp b/flang/lib/Evaluate/real-value.cpp
new file mode 100644
index 0000000000000..b6bbdad9170ab
--- /dev/null
+++ b/flang/lib/Evaluate/real-value.cpp
@@ -0,0 +1,264 @@
+//===-- lib/Evaluate/real-value.cpp ---------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Evaluate/real-value.h"
+#include "integer-value-impl.h"
+#include "real-value-impl.h"
+#include "flang/Common/idioms.h"
+#include "flang/Decimal/decimal.h"
+#include "flang/Evaluate/rounding-bits.h"
+#include "llvm/Support/raw_ostream.h"
+#include <cstring>
+#include <new>
+#include <string>
+
+namespace Fortran::evaluate::value {
+static_assert(sizeof(RealValueImpl) == detail::kRealObjectSize);
+static_assert(alignof(RealValueImpl) == detail::kRealObjectAlign);
+static_assert(sizeof(RealValue) == sizeof(RealValueImpl));
+static_assert(alignof(RealValue) == alignof(RealValueImpl));
+
+RealValue::RealValue() { new (this) RealValueImpl(); }
+
+RealValue::~RealValue() { impl().~RealValueImpl(); }
+
+RealValue::RealValue(const RealValue &x) { new (this) RealValueImpl(x.impl()); }
+
+RealValue::RealValue(RealValue &&x) {
+ new (this) RealValueImpl(std::move(x.impl()));
+}
+
+RealValue &RealValue::operator=(const RealValue &x) {
+ impl() = x.impl();
+ return *this;
+}
+
+RealValue &RealValue::operator=(RealValue &&x) {
+ impl() = std::move(x.impl());
+ return *this;
+}
+
+RealValue::RealValue(int kind, const Word &w) {
+ new (this) RealValueImpl(kind, w);
+}
+
+RealValue RealValue::Zero(int kind) {
+ return FromImpl(RealValueImpl::Zero(kind));
+}
+
+bool RealValue::IsMonostate() const { return impl().IsMonostate(); }
+
+int RealValue::kind() const { return impl().kind(); }
+
+#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
+LLVM_DUMP_METHOD void RealValue::dump() const { impl().dump(); }
+#endif
+
+bool RealValue::operator==(const RealValue &y) const {
+ return impl() == y.impl();
+}
+
+bool RealValue::IsNegative() const { return impl().IsNegative(); }
+
+bool RealValue::IsNotANumber() const { return impl().IsNotANumber(); }
+
+bool RealValue::IsSignalingNaN() const { return impl().IsSignalingNaN(); }
+
+bool RealValue::IsInfinite() const { return impl().IsInfinite(); }
+
+bool RealValue::IsFinite() const { return impl().IsFinite(); }
+
+bool RealValue::IsZero() const { return impl().IsZero(); }
+
+bool RealValue::IsNormal() const { return impl().IsNormal(); }
+
+RealValue RealValue::ABS() const { return FromImpl(impl().ABS()); }
+
+RealValue RealValue::SetSign(bool toNegative) const {
+ return FromImpl(impl().SetSign(toNegative));
+}
+
+RealValue RealValue::SIGN(const RealValue &x) const {
+ return FromImpl(impl().SIGN(x.impl()));
+}
+
+RealValue RealValue::Negate() const { return FromImpl(impl().Negate()); }
+
+Relation RealValue::Compare(const RealValue &y) const {
+ return impl().Compare(y.impl());
+}
+
+ValueWithRealFlags<RealValue> RealValue::Add(
+ const RealValue &y, Rounding rounding) const {
+ return FromImpl(impl().Add(y.impl(), rounding));
+}
+ValueWithRealFlags<RealValue> RealValue::Subtract(
+ const RealValue &y, Rounding rounding) const {
+ return FromImpl(impl().Subtract(y.impl(), rounding));
+}
+ValueWithRealFlags<RealValue> RealValue::Multiply(
+ const RealValue &y, Rounding rounding) const {
+ return FromImpl(impl().Multiply(y.impl(), rounding));
+}
+ValueWithRealFlags<RealValue> RealValue::Divide(
+ const RealValue &y, Rounding rounding) const {
+ return FromImpl(impl().Divide(y.impl(), rounding));
+}
+ValueWithRealFlags<RealValue> RealValue::SQRT(Rounding rounding) const {
+ return FromImpl(impl().SQRT(rounding));
+}
+ValueWithRealFlags<RealValue> RealValue::NEAREST(bool upward) const {
+ return FromImpl(impl().NEAREST(upward));
+}
+ValueWithRealFlags<RealValue> RealValue::HYPOT(
+ const RealValue &y, Rounding rounding) const {
+ return FromImpl(impl().HYPOT(y.impl(), rounding));
+}
+ValueWithRealFlags<RealValue> RealValue::DIM(
+ const RealValue &y, Rounding rounding) const {
+ return FromImpl(impl().DIM(y.impl(), rounding));
+}
+ValueWithRealFlags<RealValue> RealValue::MOD(
+ const RealValue &y, Rounding rounding) const {
+ return FromImpl(impl().MOD(y.impl(), rounding));
+}
+ValueWithRealFlags<RealValue> RealValue::MODULO(
+ const RealValue &y, Rounding rounding) const {
+ return FromImpl(impl().MODULO(y.impl(), rounding));
+}
+ValueWithRealFlags<RealValue> RealValue::KahanSummation(
+ const RealValue &y, RealValue &correction, Rounding rounding) const {
+ return FromImpl(impl().KahanSummation(y.impl(), correction.impl(), rounding));
+}
+
+IntegerValue RealValue::EXPONENT() const { return impl().EXPONENT(); }
+
+RealValue RealValue::EPSILON(int kind) {
+ return FromImpl(RealValueImpl::EPSILON(kind));
+}
+
+RealValue RealValue::HUGE(int kind) {
+ return FromImpl(RealValueImpl::HUGE(kind));
+}
+
+RealValue RealValue::TINY(int kind) {
+ return FromImpl(RealValueImpl::TINY(kind));
+}
+
+int RealValue::DIGITS(int kind) { return RealValueImpl::DIGITS(kind); }
+
+int RealValue::PRECISION(int kind) { return RealValueImpl::PRECISION(kind); }
+
+int RealValue::RANGE(int kind) { return RealValueImpl::RANGE(kind); }
+
+int RealValue::MAXEXPONENT(int kind) {
+ return RealValueImpl::MAXEXPONENT(kind);
+}
+
+int RealValue::MINEXPONENT(int kind) {
+ return RealValueImpl::MINEXPONENT(kind);
+}
+
+RealValue RealValue::RRSPACING() const { return FromImpl(impl().RRSPACING()); }
+
+RealValue RealValue::SPACING() const { return FromImpl(impl().SPACING()); }
+
+RealValue RealValue::SET_EXPONENT(std::int64_t e) const {
+ return FromImpl(impl().SET_EXPONENT(e));
+}
+
+RealValue RealValue::FRACTION() const { return FromImpl(impl().FRACTION()); }
+
+ValueWithRealFlags<RealValue> RealValue::SCALE(
+ const IntegerValue &by, Rounding rounding) const {
+ return FromImpl(impl().SCALE(by, rounding));
+}
+
+RealValue RealValue::FlushSubnormalToZero() const {
+ return FromImpl(impl().FlushSubnormalToZero());
+}
+
+RealValue RealValue::NotANumber(int kind) {
+ return FromImpl(RealValueImpl::NotANumber(kind));
+}
+
+ValueWithRealFlags<RealValue> RealValue::FromInteger(
+ int kind, const IntegerValue &n, bool isUnsigned, Rounding rounding) {
+ return FromImpl(RealValueImpl::FromInteger(kind, n, isUnsigned, rounding));
+}
+
+ValueWithRealFlags<RealValue> RealValue::ToWholeNumber(
+ common::RoundingMode mode) const {
+ return FromImpl(impl().ToWholeNumber(mode));
+}
+ValueWithRealFlags<IntegerValue> RealValue::ToInteger(
+ common::RoundingMode mode, int toBits) const {
+ return impl().ToInteger(mode, toBits);
+}
+
+ValueWithRealFlags<RealValue> RealValue::Convert(
+ int kind, const RealValue &from, Rounding rounding) {
+ return FromImpl(RealValueImpl::Convert(kind, from.impl(), rounding));
+}
+
+IntegerValue RealValue::RawBits() const { return impl().RawBits(); }
+
+int RealValue::Exponent() const { return impl().Exponent(); }
+
+ValueWithRealFlags<RealValue> RealValue::Read(
+ int kind, const char *&pp, Rounding rounding) {
+ return FromImpl(RealValueImpl::Read(kind, pp, rounding));
+}
+
+std::string RealValue::DumpHexadecimal() const {
+ return impl().DumpHexadecimal();
+}
+
+llvm::raw_ostream &RealValue::AsFortran(
+ llvm::raw_ostream &o, int kind, bool minimal) const {
+ return impl().AsFortran(o, kind, minimal);
+}
+
+RealValue RealValue::FromRawBytes(
+ int kind, const void *raw, std::size_t expectedSize) {
+ return FromImpl(RealValueImpl::FromRawBytes(kind, raw, expectedSize));
+}
+
+void RealValue::StoreRawBytes(void *dst, size_t size, bool *changed) const {
+ impl().StoreRawBytes(dst, size, changed);
+}
+
+RealValue RealValue::FromImpl(const RealValueImpl &x) {
+ RealValue r;
+ r.impl() = x;
+ return r;
+}
+
+RealValue RealValue::FromImpl(RealValueImpl &&x) {
+ RealValue r;
+ r.impl() = std::move(x);
+ return r;
+}
+
+ValueWithRealFlags<RealValue> RealValue::FromImpl(
+ const ValueWithRealFlags<RealValueImpl> &x) {
+ ValueWithRealFlags<RealValue> r;
+ r.value.impl() = std::move(x.value);
+ r.flags = x.flags;
+ return r;
+}
+
+ValueWithRealFlags<RealValue> RealValue::FromImpl(
+ ValueWithRealFlags<RealValueImpl> &&x) {
+ ValueWithRealFlags<RealValue> r;
+ r.value.impl() = x.value;
+ r.flags = x.flags;
+ return r;
+}
+
+} // namespace Fortran::evaluate::value
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index 924b6cbdddd5e..4d10951fe6501 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -53,7 +53,7 @@ Shape GetShapeHelper::ConstantShape(const Constant<ExtentType> &arrayConstant) {
std::size_t dimensions{arrayConstant.size()};
for (std::size_t j{0}; j < dimensions; ++j) {
Scalar<ExtentType> extent{arrayConstant.values().at(j)};
- result.emplace_back(MaybeExtentExpr{ExtentExpr{std::move(extent)}});
+ result.emplace_back(MakeExtentExpr(std::move(extent)));
}
return result;
}
@@ -98,7 +98,8 @@ std::optional<ExtentExpr> AsExtentArrayExpr(const Shape &shape) {
return std::nullopt;
}
}
- return ExtentExpr{ArrayConstructor<ExtentType>{std::move(values)}};
+ return ExtentExpr{
+ ArrayConstructor<ExtentType>{SubscriptIntegerKind, std::move(values)}};
}
std::optional<Constant<ExtentType>> AsConstantShape(
@@ -116,9 +117,10 @@ Constant<SubscriptInteger> AsConstantShape(const ConstantSubscripts &shape) {
using IntType = Scalar<SubscriptInteger>;
std::vector<IntType> result;
for (auto dim : shape) {
- result.emplace_back(dim);
+ result.emplace_back(SubscriptIntegerKind, dim);
}
- return {std::move(result), ConstantSubscripts{GetRank(shape)}};
+ return {SubscriptIntegerKind, std::move(result),
+ ConstantSubscripts{GetRank(shape)}};
}
ConstantSubscripts AsConstantExtents(const Constant<ExtentType> &shape) {
@@ -141,7 +143,7 @@ std::optional<ConstantSubscripts> AsConstantExtents(
Shape AsShape(const ConstantSubscripts &shape) {
Shape result;
for (const auto &extent : shape) {
- result.emplace_back(ExtentExpr{extent});
+ result.emplace_back(MakeExtentExpr(extent));
}
return result;
}
@@ -176,8 +178,8 @@ static ExtentExpr ComputeTripCount(
ExtentExpr span{
(std::move(upper) - std::move(lower) + std::move(strideCopy)) /
std::move(stride)};
- return ExtentExpr{
- Extremum<ExtentType>{Ordering::Greater, std::move(span), ExtentExpr{0}}};
+ return ExtentExpr{Extremum<ExtentType>{
+ Ordering::Greater, std::move(span), MakeExtentExpr(0)}};
}
ExtentExpr CountTrips(
@@ -201,7 +203,7 @@ MaybeExtentExpr CountTrips(MaybeExtentExpr &&lower, MaybeExtentExpr &&upper,
}
MaybeExtentExpr GetSize(Shape &&shape) {
- ExtentExpr extent{1};
+ ExtentExpr extent{MakeExtentExpr(1)};
for (auto &&dim : std::move(shape)) {
if (dim) {
extent = std::move(extent) * std::move(*dim);
@@ -245,10 +247,10 @@ class GetLowerBoundHelper
int d, FoldingContext *context, bool invariantOnly)
: Base{*this}, dimension_{d}, context_{context},
invariantOnly_{invariantOnly} {}
- static Result Default() { return Result{1}; }
+ static Result Default() { return Result{MakeExtentExpr(1)}; }
static Result Combine(Result &&, Result &&) {
// Operator results and array references always have lower bounds == 1
- return Result{1};
+ return MakeExtentExpr(1);
}
Result GetLowerBound(const Symbol &symbol0, NamedEntity &&base) const {
@@ -281,10 +283,10 @@ class GetLowerBoundHelper
if (context_) {
auto extent{ToInt64(Fold(*context_,
ExtentExpr{*ubound} - ExtentExpr{*lbound} +
- ExtentExpr{1}))};
+ MakeExtentExpr(1)))};
if (extent) {
if (extent <= 0) {
- return Result{1};
+ return MakeExtentExpr(1);
}
ok = true;
} else {
@@ -294,7 +296,7 @@ class GetLowerBoundHelper
auto ubValue{ToInt64(*ubound)};
if (lbValue && ubValue) {
if (*lbValue > *ubValue) {
- return Result{1};
+ return MakeExtentExpr(1);
}
ok = true;
} else {
@@ -307,7 +309,7 @@ class GetLowerBoundHelper
return *lbound;
}
} else {
- return Result{1};
+ return MakeExtentExpr(1);
}
}
if (IsDescriptor(symbol)) {
@@ -318,7 +320,7 @@ class GetLowerBoundHelper
} else if (const auto *assoc{
symbol.detailsIf<semantics::AssocEntityDetails>()}) {
if (assoc->IsAssumedSize()) { // RANK(*)
- return Result{1};
+ return MakeExtentExpr(1);
} else if (assoc->IsAssumedRank()) { // RANK DEFAULT
} else if (assoc->rank()) { // RANK(n)
const Symbol &resolved{ResolveAssociations(symbol)};
@@ -343,7 +345,7 @@ class GetLowerBoundHelper
if constexpr (LBOUND_SEMANTICS) {
return Result{};
} else {
- return Result{1};
+ return MakeExtentExpr(1);
}
}
@@ -356,7 +358,7 @@ class GetLowerBoundHelper
return GetLowerBound(
component.GetLastSymbol(), NamedEntity{common::Clone(component)});
}
- return Result{1};
+ return MakeExtentExpr(1);
}
template <typename T> Result operator()(const Expr<T> &expr) const {
@@ -366,10 +368,10 @@ class GetLowerBoundHelper
if (const auto *con{std::get_if<Constant<T>>(&expr.u)}) {
ConstantSubscripts lb{con->lbounds()};
if (dimension_ < GetRank(lb)) {
- return Result{lb[dimension_]};
+ return MakeExtentExpr(lb[dimension_]);
}
} else { // operation
- return Result{1};
+ return MakeExtentExpr(1);
}
} else {
return (*this)(expr.u);
@@ -377,7 +379,7 @@ class GetLowerBoundHelper
if constexpr (LBOUND_SEMANTICS) {
return Result{};
} else {
- return Result{1};
+ return MakeExtentExpr(1);
}
}
@@ -462,9 +464,9 @@ static MaybeExtentExpr GetNonNegativeExtent(
std::optional<ConstantSubscript> lval{ToInt64(lbound)};
if (uval && lval) {
if (*uval < *lval) {
- return ExtentExpr{0};
+ return MakeExtentExpr(0);
} else {
- return ExtentExpr{*uval - *lval + 1};
+ return MakeExtentExpr(*uval - *lval + 1);
}
} else if (lbound && ubound && lbound->Rank() == 0 && ubound->Rank() == 0 &&
(!invariantOnly ||
@@ -473,11 +475,11 @@ static MaybeExtentExpr GetNonNegativeExtent(
// result is never negative
if (lval.value_or(0) == 1) {
return ExtentExpr{Extremum<SubscriptInteger>{
- Ordering::Greater, ExtentExpr{0}, common::Clone(*ubound)}};
+ Ordering::Greater, MakeExtentExpr(0), common::Clone(*ubound)}};
} else {
- return ExtentExpr{
- Extremum<SubscriptInteger>{Ordering::Greater, ExtentExpr{0},
- common::Clone(*ubound) - common::Clone(*lbound) + ExtentExpr{1}}};
+ return ExtentExpr{Extremum<SubscriptInteger>{Ordering::Greater,
+ MakeExtentExpr(0),
+ common::Clone(*ubound) - common::Clone(*lbound) + MakeExtentExpr(1)}};
}
} else {
return std::nullopt;
@@ -598,7 +600,7 @@ MaybeExtentExpr ComputeUpperBound(
if (ToInt64(lower).value_or(0) == 1) {
return std::move(*extent);
} else {
- return std::move(*extent) + std::move(lower) - ExtentExpr{1};
+ return std::move(*extent) + std::move(lower) - MakeExtentExpr(1);
}
} else {
return std::nullopt;
@@ -658,7 +660,7 @@ static MaybeExtentExpr GetExplicitUBOUND(FoldingContext *context,
if (cstExtent > 0) {
return *ubound;
} else if (cstExtent == 0) {
- return ExtentExpr{0};
+ return MakeExtentExpr(0);
}
}
}
@@ -992,8 +994,7 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
if (semantics::IsAssumedRank(*call.arguments().front())) {
return Shape{MaybeExtentExpr{}};
} else {
- return Shape{
- MaybeExtentExpr{ExtentExpr{call.arguments().front()->Rank()}}};
+ return Shape{MakeExtentExpr(call.arguments().front()->Rank())};
}
}
} else if (intrinsic->name == "all" || intrinsic->name == "any" ||
@@ -1033,7 +1034,7 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
}
} else {
// xxxLOC(no DIM=) result is vector(1:RANK(ARRAY=))
- return Shape{ExtentExpr{rank}};
+ return Shape{MakeExtentExpr(rank)};
}
}
}
@@ -1043,7 +1044,7 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
}
} else if (intrinsic->name == "lcobound" || intrinsic->name == "ucobound") {
if (call.arguments().size() == 3 && !call.arguments().at(1).has_value()) {
- return Shape(1, ExtentExpr{GetCorank(call.arguments().at(0))});
+ return Shape(1, MakeExtentExpr(GetCorank(call.arguments().at(0))));
}
} else if (intrinsic->name == "matmul") {
if (call.arguments().size() == 2) {
@@ -1074,12 +1075,12 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
if (auto arraySize{GetSize(std::move(*arrayShape))}) {
ActualArguments toMerge{
ActualArgument{AsGenericExpr(std::move(*arraySize))},
- ActualArgument{AsGenericExpr(ExtentExpr{0})},
+ ActualArgument{AsGenericExpr(MakeExtentExpr(0))},
common::Clone(call.arguments().at(1))};
auto specific{context_->intrinsics().Probe(
CallCharacteristics{"merge"}, toMerge, *context_)};
CHECK(specific);
- return Shape{ExtentExpr{FunctionRef<ExtentType>{
+ return Shape{ExtentExpr{FunctionRef<ExtentType>{ExtentIntKind,
ProcedureDesignator{std::move(specific->specificIntrinsic)},
std::move(specific->arguments)}}};
}
@@ -1087,7 +1088,7 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
} else {
// Non-scalar MASK= -> [COUNT(mask, KIND=extent_kind)]
ActualArgument kindArg{
- AsGenericExpr(Constant<ExtentType>{ExtentType::kind})};
+ AsGenericExpr(MakeExtentConstant(ExtentIntKind))};
kindArg.set_keyword(context_->SaveTempName("kind"));
ActualArguments toCount{
ActualArgument{common::Clone(
@@ -1096,7 +1097,7 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
auto specific{context_->intrinsics().Probe(
CallCharacteristics{"count"}, toCount, *context_)};
CHECK(specific);
- return Shape{ExtentExpr{FunctionRef<ExtentType>{
+ return Shape{ExtentExpr{FunctionRef<ExtentType>{ExtentIntKind,
ProcedureDesignator{std::move(specific->specificIntrinsic)},
std::move(specific->arguments)}}};
}
@@ -1108,8 +1109,8 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
if (const auto *shapeExpr{
call.arguments().at(1).value().UnwrapExpr()}) {
auto shapeArg{std::get<Expr<SomeInteger>>(shapeExpr->u)};
- if (auto result{AsShapeResult(
- ConvertToType<ExtentType>(std::move(shapeArg)))}) {
+ if (auto result{AsShapeResult(ConvertToType<ExtentType>(
+ ExtentIntKind, std::move(shapeArg)))}) {
return result;
}
}
@@ -1128,8 +1129,10 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
if (*dim >= 1 &&
static_cast<std::size_t>(*dim) <= arrayShape->size() + 1) {
arrayShape->emplace(arrayShape->begin() + *dim - 1,
- Extremum<SubscriptInteger>{Ordering::Greater, ExtentExpr{0},
- ConvertToType<ExtentType>(common::Clone(*nCopies))});
+ Extremum<SubscriptInteger>{Ordering::Greater,
+ MakeExtentExpr(0),
+ ConvertToType<ExtentType>(
+ ExtentIntKind, common::Clone(*nCopies))});
return std::move(*arrayShape);
}
}
@@ -1140,8 +1143,8 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
// SIZE= is present; shape is vector [SIZE=]
if (const auto *size{
UnwrapExpr<Expr<SomeInteger>>(call.arguments().at(2))}) {
- return Shape{
- MaybeExtentExpr{ConvertToType<ExtentType>(common::Clone(*size))}};
+ return Shape{MaybeExtentExpr{
+ ConvertToType<ExtentType>(ExtentIntKind, common::Clone(*size))}};
}
} else if (context_) {
if (auto moldTypeAndShape{characteristics::TypeAndShape::Characterize(
@@ -1163,7 +1166,7 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
*sourceBytes = Fold(*context_, std::move(*sourceBytes));
if (auto sourceBytesConst{ToInt64(*sourceBytes)}) {
if (*sourceBytesConst == 0) {
- return Shape{ExtentExpr{0}};
+ return Shape{MakeExtentExpr(0)};
}
}
if (auto moldElementBytes{
@@ -1175,7 +1178,8 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
if (moldElementBytesConst && *moldElementBytesConst != 0) {
ExtentExpr extent{Fold(*context_,
(std::move(*sourceBytes) +
- common::Clone(*moldElementBytes) - ExtentExpr{1}) /
+ common::Clone(*moldElementBytes) -
+ MakeExtentExpr(1)) /
common::Clone(*moldElementBytes))};
return Shape{MaybeExtentExpr{std::move(extent)}};
}
@@ -1188,7 +1192,7 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
} else if (intrinsic->name == "this_image") {
if (call.arguments().size() == 2) {
// THIS_IMAGE(coarray, no DIM, [TEAM])
- return Shape(1, ExtentExpr{GetCorank(call.arguments().at(0))});
+ return Shape(1, MakeExtentExpr(GetCorank(call.arguments().at(0))));
}
} else if (intrinsic->name == "transpose") {
if (call.arguments().size() >= 1) {
diff --git a/flang/lib/Evaluate/static-data.cpp b/flang/lib/Evaluate/static-data.cpp
index 9063de0f3a938..bcc19913bd543 100644
--- a/flang/lib/Evaluate/static-data.cpp
+++ b/flang/lib/Evaluate/static-data.cpp
@@ -54,6 +54,12 @@ StaticDataObject &StaticDataObject::Push(
return *this;
}
+StaticDataObject &StaticDataObject::Push(
+ const value::CharacterValue &v, bool bigEndian) {
+ return v.withStdString(
+ [&](const auto &s) -> StaticDataObject & { return Push(s, bigEndian); });
+}
+
std::optional<std::string> StaticDataObject::AsString() const {
if (itemBytes_ <= 1) {
std::string result;
diff --git a/flang/lib/Evaluate/target.cpp b/flang/lib/Evaluate/target.cpp
index c443278148304..47442634355c2 100644
--- a/flang/lib/Evaluate/target.cpp
+++ b/flang/lib/Evaluate/target.cpp
@@ -162,10 +162,10 @@ class SelectedIntKindVisitor {
: targetCharacteristics_{targetCharacteristics}, precision_{p} {}
using Result = std::optional<int>;
using Types = IntegerTypes;
- template <typename T> Result Test() const {
- if (Scalar<T>::RANGE >= precision_ &&
- targetCharacteristics_.IsTypeEnabled(T::category, T::kind)) {
- return T::kind;
+ template <typename T> Result Test(int kind) const {
+ if (Scalar<T>::RANGE(kind) >= precision_ &&
+ targetCharacteristics_.IsTypeEnabled(T::category, kind)) {
+ return kind;
} else {
return std::nullopt;
}
@@ -177,8 +177,7 @@ class SelectedIntKindVisitor {
};
int TargetCharacteristics::SelectedIntKind(std::int64_t precision) const {
- if (auto kind{
- common::SearchTypes(SelectedIntKindVisitor{*this, precision})}) {
+ if (auto kind{SearchTypes(SelectedIntKindVisitor{*this, precision})}) {
return *kind;
} else {
return -1;
@@ -193,10 +192,10 @@ class SelectedLogicalKindVisitor {
: targetCharacteristics_{targetCharacteristics}, bits_{bits} {}
using Result = std::optional<int>;
using Types = LogicalTypes;
- template <typename T> Result Test() const {
- if (Scalar<T>::bits >= bits_ &&
- targetCharacteristics_.IsTypeEnabled(T::category, T::kind)) {
- return T::kind;
+ template <typename T> Result Test(int kind) const {
+ if (Scalar<T>::bits(kind) >= bits_ &&
+ targetCharacteristics_.IsTypeEnabled(T::category, kind)) {
+ return kind;
} else {
return std::nullopt;
}
@@ -208,7 +207,7 @@ class SelectedLogicalKindVisitor {
};
int TargetCharacteristics::SelectedLogicalKind(std::int64_t bits) const {
- if (auto kind{common::SearchTypes(SelectedLogicalKindVisitor{*this, bits})}) {
+ if (auto kind{SearchTypes(SelectedLogicalKindVisitor{*this, bits})}) {
return *kind;
} else {
return -1;
@@ -224,10 +223,11 @@ class SelectedRealKindVisitor {
r} {}
using Result = std::optional<int>;
using Types = RealTypes;
- template <typename T> Result Test() const {
- if (Scalar<T>::PRECISION >= precision_ && Scalar<T>::RANGE >= range_ &&
- targetCharacteristics_.IsTypeEnabled(T::category, T::kind)) {
- return {T::kind};
+ template <typename T> Result Test(int kind) const {
+ if (Scalar<T>::PRECISION(kind) >= precision_ &&
+ Scalar<T>::RANGE(kind) >= range_ &&
+ targetCharacteristics_.IsTypeEnabled(T::category, kind)) {
+ return {kind};
} else {
return std::nullopt;
}
@@ -243,15 +243,15 @@ int TargetCharacteristics::SelectedRealKind(
if (radix != 2) {
return -5;
}
- if (auto kind{common::SearchTypes(
- SelectedRealKindVisitor{*this, precision, range})}) {
+ if (auto kind{
+ SearchTypes(SelectedRealKindVisitor{*this, precision, range})}) {
return *kind;
}
// No kind has both sufficient precision and sufficient range.
// The negative return value encodes whether any kinds exist that
// could satisfy either constraint independently.
- bool pOK{common::SearchTypes(SelectedRealKindVisitor{*this, precision, 0})};
- bool rOK{common::SearchTypes(SelectedRealKindVisitor{*this, 0, range})};
+ bool pOK{SearchTypes(SelectedRealKindVisitor{*this, precision, 0})};
+ bool rOK{SearchTypes(SelectedRealKindVisitor{*this, 0, range})};
if (pOK) {
if (rOK) {
return -4;
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 589aab5132a65..5e2cfd474fb19 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -155,23 +155,27 @@ ConvertRealOperandsResult ConvertRealOperands(
},
[&](Expr<SomeInteger> &&ix,
Expr<SomeReal> &&ry) -> ConvertRealOperandsResult {
+ auto converted{ConvertTo(ry, std::move(ix))};
return {AsSameKindExprs<TypeCategory::Real>(
- ConvertTo(ry, std::move(ix)), std::move(ry))};
+ std::move(converted), std::move(ry))};
},
[&](Expr<SomeUnsigned> &&ix,
Expr<SomeReal> &&ry) -> ConvertRealOperandsResult {
+ auto converted{ConvertTo(ry, std::move(ix))};
return {AsSameKindExprs<TypeCategory::Real>(
- ConvertTo(ry, std::move(ix)), std::move(ry))};
+ std::move(converted), std::move(ry))};
},
[&](Expr<SomeReal> &&rx,
Expr<SomeInteger> &&iy) -> ConvertRealOperandsResult {
+ auto converted{ConvertTo(rx, std::move(iy))};
return {AsSameKindExprs<TypeCategory::Real>(
- std::move(rx), ConvertTo(rx, std::move(iy)))};
+ std::move(rx), std::move(converted))};
},
[&](Expr<SomeReal> &&rx,
Expr<SomeUnsigned> &&iy) -> ConvertRealOperandsResult {
+ auto converted{ConvertTo(rx, std::move(iy))};
return {AsSameKindExprs<TypeCategory::Real>(
- std::move(rx), ConvertTo(rx, std::move(iy)))};
+ std::move(rx), std::move(converted))};
},
[&](Expr<SomeReal> &&rx,
Expr<SomeReal> &&ry) -> ConvertRealOperandsResult {
@@ -212,13 +216,15 @@ ConvertRealOperandsResult ConvertRealOperands(
},
[&](Expr<SomeReal> &&rx,
BOZLiteralConstant &&by) -> ConvertRealOperandsResult {
+ auto converted{ConvertTo(rx, std::move(by))};
return {AsSameKindExprs<TypeCategory::Real>(
- std::move(rx), ConvertTo(rx, std::move(by)))};
+ std::move(rx), std::move(converted))};
},
[&](BOZLiteralConstant &&bx,
Expr<SomeReal> &&ry) -> ConvertRealOperandsResult {
+ auto converted{ConvertTo(ry, std::move(bx))};
return {AsSameKindExprs<TypeCategory::Real>(
- ConvertTo(ry, std::move(bx)), std::move(ry))};
+ std::move(converted), std::move(ry))};
},
[&](BOZLiteralConstant &&,
BOZLiteralConstant &&) -> ConvertRealOperandsResult {
@@ -259,22 +265,23 @@ std::optional<Expr<SomeType>> MixedRealLeft(
return Package(common::visit(
[&](auto &&rxk) -> Expr<SomeReal> {
using resultType = ResultType<decltype(rxk)>;
+ const int resultKind = rxk.kind();
if constexpr (std::is_same_v<OPR<resultType>, Power<resultType>>) {
- return AsCategoryExpr(
- RealToIntPower<resultType>{std::move(rxk), std::move(iy)});
+ return AsCategoryExpr(RealToIntPower<resultType>{
+ resultKind, std::move(rxk), std::move(iy)});
}
// G++ 8.1.0 emits bogus warnings about missing return statements if
// this statement is wrapped in an "else", as it should be.
- return AsCategoryExpr(OPR<resultType>{
- std::move(rxk), ConvertToType<resultType>(std::move(iy))});
+ auto converted{ConvertToType<resultType>(resultKind, std::move(iy))};
+ return AsCategoryExpr(
+ OPR<resultType>{resultKind, std::move(rxk), std::move(converted)});
},
std::move(rx.u)));
}
-template <int KIND>
-Expr<SomeComplex> MakeComplex(Expr<Type<TypeCategory::Real, KIND>> &&re,
- Expr<Type<TypeCategory::Real, KIND>> &&im) {
- return AsCategoryExpr(ComplexConstructor<KIND>{std::move(re), std::move(im)});
+static Expr<SomeComplex> MakeComplex(
+ Expr<Type<TypeCategory::Real>> &&re, Expr<Type<TypeCategory::Real>> &&im) {
+ return AsCategoryExpr(ComplexConstructor{std::move(re), std::move(im)});
}
std::optional<Expr<SomeComplex>> ConstructComplex(
@@ -304,83 +311,17 @@ std::optional<Expr<SomeComplex>> ConstructComplex(
// Extracts the real or imaginary part of the result of a COMPLEX
// expression, when that expression is simple enough to be duplicated.
template <bool GET_IMAGINARY> struct ComplexPartExtractor {
+ // NOTE: The the code in this class was dead code; a std/common::withStdString
+ // was forgotten such that the overload resolution was looking for a
+ // std::variant<...> overload instead for the runtime content of the
+ // std::variant. There was no specialization for std::variant so this fallback
+ // overload was matched unconditionally. The intended overloads were broken
+ // due to never been checked by the compiler, because they were never
+ // instantiated. As a result, the complex expression is just never considered
+ // "simple enough".
template <typename A> static std::optional<Expr<SomeReal>> Get(const A &) {
return std::nullopt;
}
-
- template <int KIND>
- static std::optional<Expr<SomeReal>> Get(
- const Parentheses<Type<TypeCategory::Complex, KIND>> &kz) {
- if (auto x{Get(kz.left())}) {
- return AsGenericExpr(AsSpecificExpr(
- Parentheses<Type<TypeCategory::Real, KIND>>{std::move(*x)}));
- } else {
- return std::nullopt;
- }
- }
-
- template <int KIND>
- static std::optional<Expr<SomeReal>> Get(
- const Negate<Type<TypeCategory::Complex, KIND>> &kz) {
- if (auto x{Get(kz.left())}) {
- return AsGenericExpr(AsSpecificExpr(
- Negate<Type<TypeCategory::Real, KIND>>{std::move(*x)}));
- } else {
- return std::nullopt;
- }
- }
-
- template <int KIND>
- static std::optional<Expr<SomeReal>> Get(
- const Convert<Type<TypeCategory::Complex, KIND>, TypeCategory::Complex>
- &kz) {
- if (auto x{Get(kz.left())}) {
- return AsGenericExpr(AsSpecificExpr(
- Convert<Type<TypeCategory::Real, KIND>, TypeCategory::Real>{
- AsGenericExpr(std::move(*x))}));
- } else {
- return std::nullopt;
- }
- }
-
- template <int KIND>
- static std::optional<Expr<SomeReal>> Get(const ComplexConstructor<KIND> &kz) {
- return GET_IMAGINARY ? Get(kz.right()) : Get(kz.left());
- }
-
- template <int KIND>
- static std::optional<Expr<SomeReal>> Get(
- const Constant<Type<TypeCategory::Complex, KIND>> &kz) {
- if (auto cz{kz.GetScalarValue()}) {
- return AsGenericExpr(
- AsSpecificExpr(GET_IMAGINARY ? cz->AIMAG() : cz->REAL()));
- } else {
- return std::nullopt;
- }
- }
-
- template <int KIND>
- static std::optional<Expr<SomeReal>> Get(
- const Designator<Type<TypeCategory::Complex, KIND>> &kz) {
- if (const auto *symbolRef{std::get_if<SymbolRef>(&kz.u)}) {
- return AsGenericExpr(AsSpecificExpr(
- Designator<Type<TypeCategory::Complex, KIND>>{ComplexPart{
- DataRef{*symbolRef},
- GET_IMAGINARY ? ComplexPart::Part::IM : ComplexPart::Part::RE}}));
- } else {
- return std::nullopt;
- }
- }
-
- template <int KIND>
- static std::optional<Expr<SomeReal>> Get(
- const Expr<Type<TypeCategory::Complex, KIND>> &kz) {
- return Get(kz.u);
- }
-
- static std::optional<Expr<SomeReal>> Get(const Expr<SomeComplex> &z) {
- return Get(z.u);
- }
};
// Convert REAL to COMPLEX of the same kind. Preserving the real operand kind
@@ -391,8 +332,10 @@ Expr<SomeComplex> PromoteRealToComplex(Expr<SomeReal> &&someX) {
return common::visit(
[](auto &&x) {
using RT = ResultType<decltype(x)>;
- return AsCategoryExpr(ComplexConstructor<RT::kind>{
- std::move(x), AsExpr(Constant<RT>{Scalar<RT>{}})});
+ int rtKind{x.kind()};
+ return AsCategoryExpr(ComplexConstructor{std::move(x),
+ AsExpr(
+ Constant<RT>{rtKind, Scalar<RT>::Zero(rtKind), RT{rtKind}})});
},
std::move(someX.u));
}
@@ -409,9 +352,10 @@ std::optional<Expr<SomeType>> MixedComplexLeft(
// COMPLEX**INTEGER is a special case that doesn't convert the exponent.
return Package(common::visit(
[&](const auto &zxk) {
+ const int zxkKind{zxk.kind()};
using Ty = ResultType<decltype(zxk)>;
- return AsCategoryExpr(AsExpr(
- RealToIntPower<Ty>{common::Clone(zxk), common::Clone(iry)}));
+ return AsCategoryExpr(AsExpr(RealToIntPower<Ty>{
+ zxkKind, common::Clone(zxk), common::Clone(iry)}));
},
zx.u));
}
@@ -488,12 +432,12 @@ Expr<SomeComplex> PromoteMixedComplexReal(
static_assert(XCAT == TypeCategory::Real || YCAT == TypeCategory::Real);
return common::visit(
[&](const auto &kx, const auto &ky) {
- constexpr int maxKind{std::max(
- ResultType<decltype(kx)>::kind, ResultType<decltype(ky)>::kind)};
- using ZTy = Type<TypeCategory::Complex, maxKind>;
+ int maxKind{std::max(kx.kind(), ky.kind())};
+ using ZTy = Type<TypeCategory::Complex>;
+ auto cx{ConvertToType<ZTy>(maxKind, std::move(x))};
+ auto cy{ConvertToType<ZTy>(maxKind, std::move(y))};
return Expr<SomeComplex>{
- Expr<ZTy>{OPR<ZTy>{ConvertToType<ZTy>(std::move(x)),
- ConvertToType<ZTy>(std::move(y))}}};
+ Expr<ZTy>{OPR<ZTy>{maxKind, std::move(cx), std::move(cy)}}};
},
x.u, y.u);
}
@@ -527,9 +471,11 @@ std::optional<Expr<SomeType>> NumericOperation(
return Package(common::visit(
[&](auto &&ryk) -> Expr<SomeReal> {
using resultType = ResultType<decltype(ryk)>;
- return AsCategoryExpr(
- OPR<resultType>{ConvertToType<resultType>(std::move(ix)),
- std::move(ryk)});
+ const int resultKind{ryk.kind()};
+ auto converted{
+ ConvertToType<resultType>(resultKind, std::move(ix))};
+ return AsCategoryExpr(OPR<resultType>{
+ resultKind, std::move(converted), std::move(ryk)});
},
std::move(ry.u)));
},
@@ -543,8 +489,9 @@ std::optional<Expr<SomeType>> NumericOperation(
MixedComplexLeft<OPR>(messages, zx, iy, defaultRealKind)}) {
return result;
} else {
+ auto converted{ConvertTo(zx, std::move(iy))};
return Package(PromoteAndCombine<OPR, TypeCategory::Complex>(
- std::move(zx), ConvertTo(zx, std::move(iy))));
+ std::move(zx), std::move(converted)));
}
},
[&](Expr<SomeComplex> &&zx, Expr<SomeReal> &&ry) {
@@ -561,8 +508,9 @@ std::optional<Expr<SomeType>> NumericOperation(
messages, ix, zy, defaultRealKind)}) {
return result;
} else {
+ auto converted{ConvertTo(zy, std::move(ix))};
return Package(PromoteAndCombine<OPR, TypeCategory::Complex>(
- ConvertTo(zy, std::move(ix)), std::move(zy)));
+ std::move(converted), std::move(zy)));
}
},
[&](Expr<SomeReal> &&rx, Expr<SomeComplex> &&zy) {
@@ -576,31 +524,39 @@ std::optional<Expr<SomeType>> NumericOperation(
},
// Operations with one typeless operand
[&](BOZLiteralConstant &&bx, Expr<SomeInteger> &&iy) {
+ // iy aliases y, so sequence the conversion before std::move(y)
+ // (argument order is unspecified)
+ auto converted{ConvertTo(iy, std::move(bx))};
return NumericOperation<OPR>(messages,
- AsGenericExpr(ConvertTo(iy, std::move(bx))), std::move(y),
+ AsGenericExpr(std::move(converted)), std::move(y),
defaultRealKind);
},
[&](BOZLiteralConstant &&bx, Expr<SomeUnsigned> &&iy) {
+ auto converted{ConvertTo(iy, std::move(bx))};
return NumericOperation<OPR>(messages,
- AsGenericExpr(ConvertTo(iy, std::move(bx))), std::move(y),
+ AsGenericExpr(std::move(converted)), std::move(y),
defaultRealKind);
},
[&](BOZLiteralConstant &&bx, Expr<SomeReal> &&ry) {
+ auto converted{ConvertTo(ry, std::move(bx))};
return NumericOperation<OPR>(messages,
- AsGenericExpr(ConvertTo(ry, std::move(bx))), std::move(y),
+ AsGenericExpr(std::move(converted)), std::move(y),
defaultRealKind);
},
[&](Expr<SomeInteger> &&ix, BOZLiteralConstant &&by) {
+ auto cvt{ConvertTo(ix, std::move(by))};
return NumericOperation<OPR>(messages, std::move(x),
- AsGenericExpr(ConvertTo(ix, std::move(by))), defaultRealKind);
+ AsGenericExpr(std::move(cvt)), defaultRealKind);
},
[&](Expr<SomeUnsigned> &&ix, BOZLiteralConstant &&by) {
+ auto converted{ConvertTo(ix, std::move(by))};
return NumericOperation<OPR>(messages, std::move(x),
- AsGenericExpr(ConvertTo(ix, std::move(by))), defaultRealKind);
+ AsGenericExpr(std::move(converted)), defaultRealKind);
},
[&](Expr<SomeReal> &&rx, BOZLiteralConstant &&by) {
+ auto converted{ConvertTo(rx, std::move(by))};
return NumericOperation<OPR>(messages, std::move(x),
- AsGenericExpr(ConvertTo(rx, std::move(by))), defaultRealKind);
+ AsGenericExpr(std::move(converted)), defaultRealKind);
},
// Error cases
[&](Expr<SomeUnsigned> &&, auto &&) {
@@ -734,12 +690,16 @@ std::optional<Expr<LogicalResult>> Relate(parser::ContextualMessages &messages,
return PromoteAndRelate(opr, std::move(rx), std::move(ry));
},
[&](Expr<SomeReal> &&rx, Expr<SomeInteger> &&iy) {
+ // rx aliases x, so sequence the conversion before std::move(x)
+ // (argument order is unspecified)
+ auto converted{ConvertTo(rx, std::move(iy))};
return Relate(messages, opr, std::move(x),
- AsGenericExpr(ConvertTo(rx, std::move(iy))));
+ AsGenericExpr(std::move(converted)));
},
[&](Expr<SomeInteger> &&ix, Expr<SomeReal> &&ry) {
- return Relate(messages, opr,
- AsGenericExpr(ConvertTo(ry, std::move(ix))), std::move(y));
+ auto converted{ConvertTo(ry, std::move(ix))};
+ return Relate(messages, opr, AsGenericExpr(std::move(converted)),
+ std::move(y));
},
[&](Expr<SomeComplex> &&zx,
Expr<SomeComplex> &&zy) -> std::optional<Expr<LogicalResult>> {
@@ -753,20 +713,24 @@ std::optional<Expr<LogicalResult>> Relate(parser::ContextualMessages &messages,
}
},
[&](Expr<SomeComplex> &&zx, Expr<SomeInteger> &&iy) {
+ auto converted{ConvertTo(zx, std::move(iy))};
return Relate(messages, opr, std::move(x),
- AsGenericExpr(ConvertTo(zx, std::move(iy))));
+ AsGenericExpr(std::move(converted)));
},
[&](Expr<SomeComplex> &&zx, Expr<SomeReal> &&ry) {
+ auto converted{ConvertTo(zx, std::move(ry))};
return Relate(messages, opr, std::move(x),
- AsGenericExpr(ConvertTo(zx, std::move(ry))));
+ AsGenericExpr(std::move(converted)));
},
[&](Expr<SomeInteger> &&ix, Expr<SomeComplex> &&zy) {
- return Relate(messages, opr,
- AsGenericExpr(ConvertTo(zy, std::move(ix))), std::move(y));
+ auto converted{ConvertTo(zy, std::move(ix))};
+ return Relate(messages, opr, AsGenericExpr(std::move(converted)),
+ std::move(y));
},
[&](Expr<SomeReal> &&rx, Expr<SomeComplex> &&zy) {
- return Relate(messages, opr,
- AsGenericExpr(ConvertTo(zy, std::move(rx))), std::move(y));
+ auto converted{ConvertTo(zy, std::move(rx))};
+ return Relate(messages, opr, AsGenericExpr(std::move(converted)),
+ std::move(y));
},
[&](Expr<SomeCharacter> &&cx, Expr<SomeCharacter> &&cy) {
return common::visit(
@@ -806,7 +770,8 @@ std::optional<Expr<LogicalResult>> Relate(parser::ContextualMessages &messages,
// operand representing INT(enumExpr).
auto makeIntCall =
[&](Expr<SomeDerived> &&operand) -> Expr<SomeType> {
- using IntType = Type<TypeCategory::Integer, 4>;
+ using IntType = Type<TypeCategory::Integer>;
+ constexpr int intKind{4};
DynamicType enumType{*xDerived};
DynamicType intResultType{TypeCategory::Integer, 4};
characteristics::DummyDataObject ddo{
@@ -825,7 +790,7 @@ std::optional<Expr<LogicalResult>> Relate(parser::ContextualMessages &messages,
intArgs.emplace_back(AsGenericExpr(std::move(operand)));
return AsGenericExpr(
Expr<SomeInteger>(Expr<IntType>(FunctionRef<IntType>{
- ProcedureDesignator{std::move(intSpec)},
+ intKind, ProcedureDesignator{std::move(intSpec)},
std::move(intArgs)})));
};
return Relate(messages, opr, makeIntCall(std::move(dx)),
@@ -849,9 +814,8 @@ Expr<SomeLogical> BinaryLogicalOperation(
CHECK(opr != LogicalOperator::Not);
return common::visit(
[=](auto &&xy) {
- using Ty = ResultType<decltype(xy[0])>;
- return Expr<SomeLogical>{BinaryLogicalOperation<Ty::kind>(
- opr, std::move(xy[0]), std::move(xy[1]))};
+ return Expr<SomeLogical>{
+ BinaryLogicalOperation(opr, std::move(xy[0]), std::move(xy[1]))};
},
AsSameKindExprs(std::move(x), std::move(y)));
}
@@ -912,9 +876,9 @@ std::optional<Expr<SomeType>> ConvertToType(
converted = common::visit(
[&](auto &&x) {
using CharacterType = ResultType<decltype(x)>;
- return Expr<SomeCharacter>{
- Expr<CharacterType>{SetLength<CharacterType::kind>{
- std::move(x), std::move(*length)}}};
+ const int characterKind{x.kind()};
+ return Expr<SomeCharacter>{Expr<CharacterType>{
+ SetLength{characterKind, std::move(x), std::move(*length)}}};
},
std::move(converted.u));
}
@@ -1382,79 +1346,84 @@ bool HasVolatileOrAsynchronousSymbol(const Expr<SomeType> &expr) {
namespace {
-template <common::TypeCategory CAT, int KIND> using Numeric = Type<CAT, KIND>;
+template <common::TypeCategory CAT> using Numeric = Type<CAT>;
-template <common::TypeCategory CAT, int KIND>
-using NumericExpr = Expr<Numeric<CAT, KIND>>;
+template <common::TypeCategory CAT> using NumericExpr = Expr<Numeric<CAT>>;
-template <common::TypeCategory CAT, int KIND> struct SignedNumericTerm {
- NumericExpr<CAT, KIND> expr;
+template <common::TypeCategory CAT> struct SignedNumericTerm {
+ int kind() const { return expr.kind(); };
+
+ NumericExpr<CAT> expr;
bool isPositive;
};
-template <common::TypeCategory CAT, int KIND> struct SignedNumericExpr {
- NumericExpr<CAT, KIND> expr;
+template <common::TypeCategory CAT> struct SignedNumericExpr {
+ int kind() const { return expr.kind(); };
+
+ NumericExpr<CAT> expr;
bool isPositive;
};
-template <common::TypeCategory CAT, int KIND>
-static void flattenTopLevelAddSubtract(const NumericExpr<CAT, KIND> &expr,
- llvm::SmallVectorImpl<SignedNumericTerm<CAT, KIND>> &terms,
+template <common::TypeCategory CAT>
+static void flattenTopLevelAddSubtract(const NumericExpr<CAT> &expr,
+ llvm::SmallVectorImpl<SignedNumericTerm<CAT>> &terms,
bool isPositive = true) {
// Only flatten Add and Subtract nodes. Every other node, including
// Parentheses, is one opaque signed term whose tree is preserved.
- if (const auto *add = std::get_if<Add<Numeric<CAT, KIND>>>(&expr.u)) {
+ if (const auto *add = std::get_if<Add<Numeric<CAT>>>(&expr.u)) {
flattenTopLevelAddSubtract(add->left(), terms, isPositive);
flattenTopLevelAddSubtract(add->right(), terms, isPositive);
return;
}
- if (const auto *subtract =
- std::get_if<Subtract<Numeric<CAT, KIND>>>(&expr.u)) {
+ if (const auto *subtract = std::get_if<Subtract<Numeric<CAT>>>(&expr.u)) {
flattenTopLevelAddSubtract(subtract->left(), terms, isPositive);
flattenTopLevelAddSubtract(subtract->right(), terms, !isPositive);
return;
}
- terms.push_back(SignedNumericTerm<CAT, KIND>{expr, isPositive});
+ terms.push_back(SignedNumericTerm<CAT>{expr, isPositive});
}
-template <common::TypeCategory CAT, int KIND>
-static SignedNumericExpr<CAT, KIND> buildRightAssociatedSignedFold(
- llvm::MutableArrayRef<SignedNumericTerm<CAT, KIND>> terms) {
+template <common::TypeCategory CAT>
+static SignedNumericExpr<CAT> buildRightAssociatedSignedFold(
+ llvm::MutableArrayRef<SignedNumericTerm<CAT>> terms) {
assert(!terms.empty() && "cannot build empty signed fold");
+ const int kind{terms.front().kind()};
const bool isPositive{terms.front().isPositive};
- NumericExpr<CAT, KIND> result{std::move(terms.back().expr)};
+ NumericExpr<CAT> result{std::move(terms.back().expr)};
for (std::size_t i{terms.size() - 1}; i > 0; --i) {
- SignedNumericTerm<CAT, KIND> &term{terms[i - 1]};
+ SignedNumericTerm<CAT> &term{terms[i - 1]};
const bool useAdd{term.isPositive == terms[i].isPositive};
if (useAdd)
- result = NumericExpr<CAT, KIND>{
- Add<Numeric<CAT, KIND>>{std::move(term.expr), std::move(result)}};
+ result = NumericExpr<CAT>{
+ Add<Numeric<CAT>>{kind, std::move(term.expr), std::move(result)}};
else
- result = NumericExpr<CAT, KIND>{Subtract<Numeric<CAT, KIND>>{
- std::move(term.expr), std::move(result)}};
+ result = NumericExpr<CAT>{Subtract<Numeric<CAT>>{
+ kind, std::move(term.expr), std::move(result)}};
}
- return SignedNumericExpr<CAT, KIND>{std::move(result), isPositive};
+ return SignedNumericExpr<CAT>{std::move(result), isPositive};
}
-template <common::TypeCategory CAT, int KIND>
-static SignedNumericExpr<CAT, KIND> buildSignedAdd(
- SignedNumericExpr<CAT, KIND> left, SignedNumericExpr<CAT, KIND> right) {
+template <common::TypeCategory CAT>
+static SignedNumericExpr<CAT> buildSignedAdd(
+ SignedNumericExpr<CAT> left, SignedNumericExpr<CAT> right) {
+ CHECK(left.kind() == right.kind());
+ const int kind{left.kind()};
if (left.isPositive == right.isPositive) {
- return SignedNumericExpr<CAT, KIND>{
- NumericExpr<CAT, KIND>{Add<Numeric<CAT, KIND>>{
- std::move(left.expr), std::move(right.expr)}},
+ return SignedNumericExpr<CAT>{
+ NumericExpr<CAT>{Add<Numeric<CAT>>{
+ kind, std::move(left.expr), std::move(right.expr)}},
left.isPositive};
}
if (left.isPositive) {
- return SignedNumericExpr<CAT, KIND>{
- NumericExpr<CAT, KIND>{Subtract<Numeric<CAT, KIND>>{
- std::move(left.expr), std::move(right.expr)}},
+ return SignedNumericExpr<CAT>{
+ NumericExpr<CAT>{Subtract<Numeric<CAT>>{
+ kind, std::move(left.expr), std::move(right.expr)}},
true};
}
// Prefer Y-X to introducing a unary negation for -X+Y.
- return SignedNumericExpr<CAT, KIND>{
- NumericExpr<CAT, KIND>{Subtract<Numeric<CAT, KIND>>{
- std::move(right.expr), std::move(left.expr)}},
+ return SignedNumericExpr<CAT>{
+ NumericExpr<CAT>{Subtract<Numeric<CAT>>{
+ kind, std::move(right.expr), std::move(left.expr)}},
true};
}
@@ -1463,24 +1432,24 @@ static std::optional<Expr<SomeType>> tryBuildSplitSumExpressionTree(const T &) {
return std::nullopt;
}
-template <common::TypeCategory CAT, int KIND>
+template <common::TypeCategory CAT>
static std::optional<Expr<SomeType>> tryBuildSplitSumExpressionTree(
- const NumericExpr<CAT, KIND> &expr) {
- if (!std::get_if<Add<Numeric<CAT, KIND>>>(&expr.u) &&
- !std::get_if<Subtract<Numeric<CAT, KIND>>>(&expr.u))
+ const NumericExpr<CAT> &expr) {
+ if (!std::get_if<Add<Numeric<CAT>>>(&expr.u) &&
+ !std::get_if<Subtract<Numeric<CAT>>>(&expr.u))
return std::nullopt;
- llvm::SmallVector<SignedNumericTerm<CAT, KIND>, 8> terms;
+ llvm::SmallVector<SignedNumericTerm<CAT>, 8> terms;
flattenTopLevelAddSubtract(expr, terms);
if (terms.size() <= 2)
return std::nullopt;
- llvm::MutableArrayRef<SignedNumericTerm<CAT, KIND>> head{terms.data(), 2};
- llvm::MutableArrayRef<SignedNumericTerm<CAT, KIND>> tail{
+ llvm::MutableArrayRef<SignedNumericTerm<CAT>> head{terms.data(), 2};
+ llvm::MutableArrayRef<SignedNumericTerm<CAT>> tail{
terms.data() + 2, terms.size() - 2};
- SignedNumericExpr<CAT, KIND> headExpr = buildRightAssociatedSignedFold(head);
- SignedNumericExpr<CAT, KIND> tailExpr = buildRightAssociatedSignedFold(tail);
- SignedNumericExpr<CAT, KIND> result =
+ SignedNumericExpr<CAT> headExpr = buildRightAssociatedSignedFold(head);
+ SignedNumericExpr<CAT> tailExpr = buildRightAssociatedSignedFold(tail);
+ SignedNumericExpr<CAT> result =
buildSignedAdd(std::move(tailExpr), std::move(headExpr));
assert(result.isPositive &&
"the first flattened term and therefore the split sum are positive");
@@ -1771,11 +1740,10 @@ static std::optional<Expr<SomeType>> DataConstantConversionHelper(
return common::visit(
[](const auto &w) -> std::optional<Expr<SomeType>> {
using FromType = ResultType<decltype(w)>;
- static constexpr int kind{FromType::kind};
- if constexpr (IsValidKindOfIntrinsicType(TO, kind)) {
+ const int kind{w.kind()};
+ if (IsValidKindOfIntrinsicType(TO, kind)) {
if (const auto *fromConst{UnwrapExpr<Constant<FromType>>(w)}) {
- using FromWordType = typename FromType::Scalar;
- using LogicalType = value::Logical<FromWordType::bits>;
+ using LogicalType = value::LogicalValue;
using ElementType =
std::conditional_t<TO == TypeCategory::Logical, LogicalType,
typename LogicalType::Word>;
@@ -1786,13 +1754,13 @@ static std::optional<Expr<SomeType>> DataConstantConversionHelper(
fromConst->IncrementSubscripts(at)) {
auto elt{fromConst->At(at)};
if constexpr (TO == TypeCategory::Logical) {
- values.emplace_back(std::move(elt));
+ values.emplace_back(kind, elt);
} else {
values.emplace_back(elt.word());
}
}
- return {AsGenericExpr(AsExpr(Constant<Type<TO, kind>>{
- std::move(values), std::move(shape)}))};
+ return {AsGenericExpr(AsExpr(Constant<Type<TO>>{kind,
+ std::move(values), std::move(shape), Type<TO>{kind}}))};
}
}
return std::nullopt;
@@ -1851,17 +1819,27 @@ bool MayBePassedAsAbsentOptional(const Expr<SomeType> &expr) {
IsAllocatableOrPointerObject(expr);
}
+static std::optional<std::string> GetScalarConstantValueAsStdString(
+ const Expr<SomeType> &expr) {
+ if (std::optional<value::CharacterValue> chValue{
+ GetScalarConstantValue<Ascii>(expr)}) {
+ return chValue->AsStdString();
+ }
+ return std::nullopt;
+}
+
std::optional<Expr<SomeType>> HollerithToBOZ(FoldingContext &context,
const Expr<SomeType> &expr, const DynamicType &type) {
- if (std::optional<std::string> chValue{GetScalarConstantValue<Ascii>(expr)}) {
+ if (std::optional<std::string> chValue{
+ GetScalarConstantValueAsStdString(expr)}) {
// Pad on the right with spaces when short, truncate the right if long.
auto bytes{static_cast<std::size_t>(
ToInt64(type.MeasureSizeInBytes(context, false)).value())};
- BOZLiteralConstant bits{0};
+ BOZLiteralConstant bits{LargestRealKind, 0};
for (std::size_t j{0}; j < bytes; ++j) {
auto idx{isHostLittleEndian ? j : bytes - j - 1};
char ch{idx >= chValue->size() ? ' ' : chValue->at(idx)};
- BOZLiteralConstant chBOZ{static_cast<unsigned char>(ch)};
+ BOZLiteralConstant chBOZ{LargestRealKind, static_cast<unsigned char>(ch)};
bits = bits.IOR(chBOZ.SHIFTL(8 * j));
}
return ConvertToType(type, Expr<SomeType>{bits});
@@ -1874,10 +1852,9 @@ std::optional<Expr<SomeType>> HollerithToBOZ(FoldingContext &context,
// possibly wrapped with parentheses or MAX(0, ...).
// Works with any integer expression.
template <typename T> const Symbol *GetBoundSymbol(const Expr<T> &);
-template <int KIND>
-const Symbol *GetBoundSymbol(
- const Expr<Type<TypeCategory::Integer, KIND>> &expr) {
- using T = Type<TypeCategory::Integer, KIND>;
+const Symbol *GetBoundSymbol(const Expr<Type<TypeCategory::Integer>> &expr) {
+ using T = Type<TypeCategory::Integer>;
+ const int kind{expr.kind()};
return common::visit(
common::visitors{
[](const Extremum<T> &max) -> const Symbol * {
@@ -1895,12 +1872,11 @@ const Symbol *GetBoundSymbol(
}
return nullptr;
},
- [](const Convert<T, TypeCategory::Integer> &x) {
+ [kind](const Convert<T, TypeCategory::Integer> &x) {
return common::visit(
- [](const auto &y) -> const Symbol * {
- using yType = std::decay_t<decltype(y)>;
- using yResult = typename yType::Result;
- if constexpr (yResult::kind <= KIND) {
+ [kind](const auto &y) -> const Symbol * {
+ int yKind{y.GetType() ? y.GetType()->kind() : 0};
+ if (yKind <= kind) {
return GetBoundSymbol(y);
} else {
return nullptr;
@@ -2007,8 +1983,7 @@ struct ArgumentExtractor
using Base::operator();
- template <int Kind>
- Result operator()(const Constant<Type<Logical, Kind>> &x) const {
+ Result operator()(const Constant<Type<Logical>> &x) const {
if (const auto &val{x.GetScalarValue()}) {
return val->IsTrue()
? std::make_pair(operation::Operator::True, Arguments{})
@@ -2268,24 +2243,18 @@ struct ConvertCollector
}
template <typename T> struct is_convert {
- static constexpr bool value{false};
+ // ComplexComponent is a conversion from complex to real.
+ static constexpr bool value{std::is_same_v<T, ComplexComponent>};
};
template <typename T, common::TypeCategory C>
struct is_convert<Convert<T, C>> {
static constexpr bool value{true};
};
- template <int K> struct is_convert<ComplexComponent<K>> {
- // Conversion from complex to real.
- static constexpr bool value{true};
- };
template <typename T>
static constexpr bool is_convert_v{is_convert<T>::value};
template <typename T> struct is_complex_constructor {
- static constexpr bool value{false};
- };
- template <int K> struct is_complex_constructor<ComplexConstructor<K>> {
- static constexpr bool value{true};
+ static constexpr bool value{std::is_same_v<T, ComplexConstructor>};
};
template <typename T>
static constexpr bool is_complex_constructor_v{
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index 3913bd394fde0..b9ed5305ad75c 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -142,10 +142,11 @@ bool DynamicType::operator==(const DynamicType &that) const {
std::optional<Expr<SubscriptInteger>> DynamicType::GetCharLength() const {
if (category_ == TypeCategory::Character) {
if (knownLength()) {
- return AsExpr(Constant<SubscriptInteger>(*knownLength()));
+ return MakeSubscriptIntExpr(*knownLength());
} else if (charLengthParamValue_) {
if (auto length{charLengthParamValue_->GetExplicit()}) {
- return ConvertToType<SubscriptInteger>(std::move(*length));
+ return ConvertToType<SubscriptInteger>(
+ SubscriptIntegerKind, std::move(*length));
}
}
}
@@ -194,15 +195,14 @@ std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
case TypeCategory::Real:
case TypeCategory::Complex:
case TypeCategory::Logical:
- return Expr<SubscriptInteger>{
- context.targetCharacteristics().GetByteSize(category_, kind())};
+ return MakeSubscriptIntExpr(
+ context.targetCharacteristics().GetByteSize(category_, kind()));
case TypeCategory::Character:
- if (auto len{charLength ? Expr<SubscriptInteger>{Constant<SubscriptInteger>{
- *charLength}}
- : GetCharLength()}) {
+ if (auto len{
+ charLength ? MakeSubscriptIntExpr(*charLength) : GetCharLength()}) {
return Fold(context,
- Expr<SubscriptInteger>{
- context.targetCharacteristics().GetByteSize(category_, kind())} *
+ MakeSubscriptIntExpr(
+ context.targetCharacteristics().GetByteSize(category_, kind())) *
std::move(*len));
}
break;
@@ -218,16 +218,14 @@ std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
auto size{derived_->GetScope()->size()};
auto align{aligned ? derived_->GetScope()->alignment().value_or(0) : 0};
auto alignedSize{align > 0 ? ((size + align - 1) / align) * align : size};
- return Expr<SubscriptInteger>{
- static_cast<ConstantSubscript>(alignedSize)};
+ return MakeSubscriptIntExpr(alignedSize);
}
// Regular derived type path.
if (!IsPolymorphic() && derived_ && derived_->scope()) {
auto size{derived_->scope()->size()};
auto align{aligned ? derived_->scope()->alignment().value_or(0) : 0};
auto alignedSize{align > 0 ? ((size + align - 1) / align) * align : size};
- return Expr<SubscriptInteger>{
- static_cast<ConstantSubscript>(alignedSize)};
+ return MakeSubscriptIntExpr(alignedSize);
}
break;
}
@@ -890,7 +888,7 @@ std::optional<DynamicType> ComparisonType(
case TypeCategory::Logical:
switch (t2.category()) {
case TypeCategory::Logical:
- return DynamicType{TypeCategory::Logical, LogicalResult::kind};
+ return DynamicType{TypeCategory::Logical, LogicalResultKind};
default:
return std::nullopt;
}
diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index 409fd66f81c2b..7ea509efdd5ca 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -22,12 +22,12 @@ namespace Fortran::evaluate {
// Constructors, accessors, mutators
-Triplet::Triplet() : stride_{Expr<SubscriptInteger>{1}} {}
+Triplet::Triplet() : stride_{MakeSubscriptIntExpr(1)} {}
Triplet::Triplet(std::optional<Expr<SubscriptInteger>> &&l,
std::optional<Expr<SubscriptInteger>> &&u,
std::optional<Expr<SubscriptInteger>> &&s)
- : stride_{s ? std::move(*s) : Expr<SubscriptInteger>{1}} {
+ : stride_{s ? std::move(*s) : MakeSubscriptIntExpr(1)} {
if (l) {
lower_.emplace(std::move(*l));
}
@@ -133,7 +133,7 @@ Expr<SubscriptInteger> Substring::lower() const {
if (lower_) {
return lower_.value().value();
} else {
- return AsExpr(Constant<SubscriptInteger>{1});
+ return MakeSubscriptIntExpr(1);
}
}
@@ -151,7 +151,7 @@ std::optional<Expr<SubscriptInteger>> Substring::upper() const {
[](const DataRef &dataRef) { return dataRef.LEN(); },
[](const StaticDataObject::Pointer &object)
-> std::optional<Expr<SubscriptInteger>> {
- return AsExpr(Constant<SubscriptInteger>{object->data().size()});
+ return MakeSubscriptIntExpr(object->data().size());
},
},
parent_);
@@ -176,7 +176,7 @@ std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
return std::nullopt;
}
if (!lower_) {
- lower_ = AsExpr(Constant<SubscriptInteger>{1});
+ lower_ = MakeSubscriptIntExpr(1);
}
lower_.value() = evaluate::Fold(context, std::move(lower_.value().value()));
std::optional<ConstantSubscript> lbi{ToInt64(lower_.value().value())};
@@ -186,16 +186,15 @@ std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
if (*lbi > *ubi) { // empty result; canonicalize
*lbi = 1;
*ubi = 0;
- lower_ = AsExpr(Constant<SubscriptInteger>{*lbi});
- upper_ = AsExpr(Constant<SubscriptInteger>{*ubi});
+ lower_ = MakeSubscriptIntExpr(*lbi);
+ upper_ = MakeSubscriptIntExpr(*ubi);
}
std::optional<ConstantSubscript> length;
std::optional<Expr<SomeCharacter>> strings; // a Constant<Character>
if (const auto *literal{std::get_if<StaticDataObject::Pointer>(&parent_)}) {
length = (*literal)->data().size();
if (auto str{(*literal)->AsString()}) {
- strings =
- Expr<SomeCharacter>(Expr<Ascii>(Constant<Ascii>{std::move(*str)}));
+ strings = Expr<SomeCharacter>(MakeAsciiExpr(*str));
}
} else if (const auto *dataRef{std::get_if<DataRef>(&parent_)}) {
if (auto expr{AsGenericExpr(DataRef{*dataRef})}) {
@@ -227,7 +226,7 @@ std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
"Lower bound (%jd) on substring is less than one"_warn_en_US,
static_cast<std::intmax_t>(*lbi));
*lbi = 1;
- lower_ = AsExpr(Constant<SubscriptInteger>{1});
+ lower_ = MakeSubscriptIntExpr(1);
}
if (length && *ubi > *length) {
context.Warn(common::UsageWarning::Bounds,
@@ -235,7 +234,7 @@ std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
static_cast<std::intmax_t>(*ubi),
static_cast<std::intmax_t>(*length));
*ubi = *length;
- upper_ = AsExpr(Constant<SubscriptInteger>{*ubi});
+ upper_ = MakeSubscriptIntExpr(*ubi);
}
}
return result;
@@ -283,11 +282,11 @@ static std::optional<Expr<SubscriptInteger>> SymbolLEN(const Symbol &symbol) {
}
if (len) {
if (auto constLen{ToInt64(*len)}) {
- return Expr<SubscriptInteger>{std::max<std::int64_t>(*constLen, 0)};
+ return MakeSubscriptIntExpr(std::max<std::int64_t>(*constLen, 0));
} else if (ultimate.owner().IsDerivedType() ||
IsScopeInvariantExpr(*len)) {
return AsExpr(Extremum<SubscriptInteger>{
- Ordering::Greater, Expr<SubscriptInteger>{0}, std::move(*len)});
+ Ordering::Greater, MakeSubscriptIntExpr(0), std::move(*len)});
}
}
}
@@ -304,7 +303,7 @@ std::optional<Expr<SubscriptInteger>> BaseObject::LEN() const {
[](const Symbol &symbol) { return SymbolLEN(symbol); },
[](const StaticDataObject::Pointer &object)
-> std::optional<Expr<SubscriptInteger>> {
- return AsExpr(Constant<SubscriptInteger>{object->data().size()});
+ return MakeSubscriptIntExpr(object->data().size());
},
},
u);
@@ -336,9 +335,9 @@ std::optional<Expr<SubscriptInteger>> DataRef::LEN() const {
std::optional<Expr<SubscriptInteger>> Substring::LEN() const {
if (auto top{upper()}) {
- return AsExpr(Extremum<SubscriptInteger>{Ordering::Greater,
- AsExpr(Constant<SubscriptInteger>{0}),
- *std::move(top) - lower() + AsExpr(Constant<SubscriptInteger>{1})});
+ return AsExpr(
+ Extremum<SubscriptInteger>{Ordering::Greater, MakeSubscriptIntExpr(0),
+ *std::move(top) - lower() + MakeSubscriptIntExpr(1)});
} else {
return std::nullopt;
}
@@ -648,16 +647,16 @@ template <typename T> const Symbol *Designator<T>::GetLastSymbol() const {
template <typename T>
std::optional<DynamicType> Designator<T>::GetType() const {
if constexpr (IsLengthlessIntrinsicType<Result>) {
- return Result::GetType();
+ return DynamicType{Result::category, kind()};
}
if constexpr (Result::category == TypeCategory::Character) {
if (std::holds_alternative<Substring>(u)) {
if (auto len{LEN()}) {
if (auto n{ToInt64(*len)}) {
- return DynamicType{T::kind, *n};
+ return DynamicType{kind(), *n};
}
}
- return DynamicType{TypeCategory::Character, T::kind};
+ return DynamicType{TypeCategory::Character, kind()};
}
}
if (const Symbol * symbol{GetLastSymbol()}) {
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index a8e3e4a0aea1a..a8dddffdbb3a3 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -6721,8 +6721,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
return Fortran::common::visit(
[&](const auto &someKind) -> std::string {
using T = std::decay_t<decltype(someKind)>;
- using TK = Fortran::evaluate::Type<T::Result::category,
- T::Result::kind>;
+ using TK = typename T::Result;
if (const auto *constant =
std::get_if<Fortran::evaluate::Constant<TK>>(
&someKind.u)) {
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 64960b5e09a98..4d1f8c29dc9f7 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -8,6 +8,7 @@
#include "flang/Lower/CallInterface.h"
#include "flang/Evaluate/fold.h"
+#include "flang/Evaluate/shape.h"
#include "flang/Lower/Bridge.h"
#include "flang/Lower/ConvertCall.h"
#include "flang/Lower/Mangler.h"
@@ -426,12 +427,12 @@ static Fortran::evaluate::ExtentExpr
getExtentExpr(const Fortran::semantics::ShapeSpec &shapeSpec) {
if (shapeSpec.ubound().isStar())
// F'2023 18.5.3 point 5.
- return Fortran::evaluate::ExtentExpr{-1};
+ return Fortran::evaluate::MakeExtentExpr(-1);
const auto &ubound = shapeSpec.ubound().GetExplicit();
const auto &lbound = shapeSpec.lbound().GetExplicit();
assert(lbound && ubound && "shape must be explicit");
return Fortran::common::Clone(*ubound) - Fortran::common::Clone(*lbound) +
- Fortran::evaluate::ExtentExpr{1};
+ Fortran::evaluate::MakeExtentExpr(1);
}
static void
diff --git a/flang/lib/Lower/ConvertArrayConstructor.cpp b/flang/lib/Lower/ConvertArrayConstructor.cpp
index 1d22da615ba07..a76527b4e7454 100644
--- a/flang/lib/Lower/ConvertArrayConstructor.cpp
+++ b/flang/lib/Lower/ConvertArrayConstructor.cpp
@@ -503,15 +503,16 @@ namespace {
/// evaluating an ac-value.
template <typename T>
struct LengthAndTypeCollector {
- static mlir::Type collect(mlir::Location,
- Fortran::lower::AbstractConverter &converter,
- const Fortran::evaluate::ArrayConstructor<T> &,
- Fortran::lower::SymMap &,
- Fortran::lower::StatementContext &,
- mlir::SmallVectorImpl<mlir::Value> &) {
+ static mlir::Type
+ collect(mlir::Location, Fortran::lower::AbstractConverter &converter,
+ const Fortran::evaluate::ArrayConstructor<T> &arrayCtorExpr,
+ Fortran::lower::SymMap &, Fortran::lower::StatementContext &,
+ mlir::SmallVectorImpl<mlir::Value> &) {
+ const int kind{arrayCtorExpr.kind()};
// Numerical and Logical types.
return Fortran::lower::getFIRType(&converter.getMLIRContext(), T::category,
- T::kind, /*lenParams*/ {});
+ kind,
+ /*lenParams*/ {});
}
};
@@ -530,16 +531,17 @@ struct LengthAndTypeCollector<Fortran::evaluate::SomeDerived> {
}
};
-template <int Kind>
using Character =
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, Kind>;
-template <int Kind>
-struct LengthAndTypeCollector<Character<Kind>> {
- static mlir::Type collect(
- mlir::Location loc, Fortran::lower::AbstractConverter &converter,
- const Fortran::evaluate::ArrayConstructor<Character<Kind>> &arrayCtorExpr,
- Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
- mlir::SmallVectorImpl<mlir::Value> &lengths) {
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Character>;
+template <>
+struct LengthAndTypeCollector<Character> {
+ static mlir::Type
+ collect(mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ const Fortran::evaluate::ArrayConstructor<Character> &arrayCtorExpr,
+ Fortran::lower::SymMap &symMap,
+ Fortran::lower::StatementContext &stmtCtx,
+ mlir::SmallVectorImpl<mlir::Value> &lengths) {
+ const int kind{arrayCtorExpr.kind()};
llvm::SmallVector<Fortran::lower::LenParameterTy> typeLengths;
if (const Fortran::evaluate::ExtentExpr *lenExpr = arrayCtorExpr.LEN()) {
lengths.push_back(
@@ -550,7 +552,7 @@ struct LengthAndTypeCollector<Character<Kind>> {
}
return Fortran::lower::getFIRType(&converter.getMLIRContext(),
Fortran::common::TypeCategory::Character,
- Kind, typeLengths);
+ kind, typeLengths);
}
};
} // namespace
diff --git a/flang/lib/Lower/ConvertConstant.cpp b/flang/lib/Lower/ConvertConstant.cpp
index 70dc4c77ab869..31f706803de3e 100644
--- a/flang/lib/Lower/ConvertConstant.cpp
+++ b/flang/lib/Lower/ConvertConstant.cpp
@@ -49,18 +49,19 @@ static llvm::APFloat consAPFloat(const llvm::fltSemantics &fsem,
//===----------------------------------------------------------------------===//
/// Generate an mlir attribute from a literal value
-template <Fortran::common::TypeCategory TC, int KIND>
+template <Fortran::common::TypeCategory TC>
static mlir::Attribute convertToAttribute(
fir::FirOpBuilder &builder,
- const Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>> &value,
+ const Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC>> &value,
mlir::Type type) {
+ const int kind{value.kind()};
if constexpr (TC == Fortran::common::TypeCategory::Integer) {
- if constexpr (KIND <= 8)
+ if (kind <= 8)
return builder.getIntegerAttr(type, value.ToInt64());
else {
- static_assert(KIND <= 16, "integers with KIND > 16 are not supported");
+ CHECK_MSG(kind <= 16, "integers with KIND > 16 are not supported");
return builder.getIntegerAttr(
- type, llvm::APInt(KIND * 8,
+ type, llvm::APInt(kind * 8,
{value.ToUInt64(), value.SHIFTR(64).ToUInt64()}));
}
} else if constexpr (TC == Fortran::common::TypeCategory::Logical) {
@@ -72,7 +73,7 @@ static mlir::Attribute convertToAttribute(
auto getFloatAttr = [&](const auto &value, mlir::Type type) {
std::string str = value.DumpHexadecimal();
auto floatVal =
- consAPFloat(builder.getKindMap().getFloatSemantics(KIND), str);
+ consAPFloat(builder.getKindMap().getFloatSemantics(kind), str);
return builder.getFloatAttr(type, floatVal);
};
@@ -127,12 +128,11 @@ class DenseGlobalBuilder {
setDefaultAlignment);
}
- template <Fortran::common::TypeCategory TC, int KIND>
+ template <Fortran::common::TypeCategory TC>
static fir::GlobalOp tryCreating(
fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type symTy,
llvm::StringRef globalName, mlir::StringAttr linkage, bool isConst,
- const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC, KIND>>
- &constant,
+ const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC>> &constant,
cuf::DataAttributeAttr dataAttr, bool setDefaultAlignment = true) {
DenseGlobalBuilder globalBuilder;
globalBuilder.tryConvertingToAttributes(builder, constant);
@@ -145,21 +145,21 @@ class DenseGlobalBuilder {
DenseGlobalBuilder() = default;
/// Try converting an evaluate::Constant to a list of MLIR attributes.
- template <Fortran::common::TypeCategory TC, int KIND>
+ template <Fortran::common::TypeCategory TC>
void tryConvertingToAttributes(
fir::FirOpBuilder &builder,
- const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC, KIND>>
+ const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC>>
&constant) {
- using Element =
- Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>>;
+ using Element = Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC>>;
static_assert(TC != Fortran::common::TypeCategory::Character,
"must be numerical or logical");
+ const int kind = constant.kind();
auto attrTc = TC == Fortran::common::TypeCategory::Logical
? Fortran::common::TypeCategory::Integer
: TC;
attributeElementType =
- Fortran::lower::getFIRType(builder.getContext(), attrTc, KIND, {});
+ Fortran::lower::getFIRType(builder.getContext(), attrTc, kind, {});
const std::vector<Element> &values = constant.values();
auto sameElements = [&]() -> bool {
@@ -171,15 +171,15 @@ class DenseGlobalBuilder {
};
if (sameElements()) {
- auto attr = convertToAttribute<TC, KIND>(builder, values.front(),
- attributeElementType);
+ auto attr =
+ convertToAttribute<TC>(builder, values.front(), attributeElementType);
attributes.assign(values.size(), attr);
return;
}
for (auto element : values)
attributes.push_back(
- convertToAttribute<TC, KIND>(builder, element, attributeElementType));
+ convertToAttribute<TC>(builder, element, attributeElementType));
}
/// Try converting an evaluate::Expr to a list of MLIR attributes.
@@ -191,8 +191,7 @@ class DenseGlobalBuilder {
using TR = Fortran::evaluate::ResultType<decltype(x)>;
if (const auto *constant =
std::get_if<Fortran::evaluate::Constant<TR>>(&x.u))
- tryConvertingToAttributes<TR::category, TR::kind>(builder,
- *constant);
+ tryConvertingToAttributes<TR::category>(builder, *constant);
},
expr.u);
}
@@ -242,25 +241,25 @@ fir::GlobalOp Fortran::lower::tryCreatingDenseGlobal(
//===----------------------------------------------------------------------===//
/// Generate a real constant with a value `value`.
-template <int KIND>
-static mlir::Value genRealConstant(fir::FirOpBuilder &builder,
+static mlir::Value genRealConstant(int kind, fir::FirOpBuilder &builder,
mlir::Location loc,
const llvm::APFloat &value) {
- mlir::Type fltTy = Fortran::lower::convertReal(builder.getContext(), KIND);
+ mlir::Type fltTy = Fortran::lower::convertReal(builder.getContext(), kind);
return builder.createRealConstant(loc, fltTy, value);
}
/// Convert a scalar literal constant to IR.
-template <Fortran::common::TypeCategory TC, int KIND>
+template <Fortran::common::TypeCategory TC>
static mlir::Value genScalarLit(
fir::FirOpBuilder &builder, mlir::Location loc,
- const Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>> &value) {
+ const Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC>> &value) {
+ int kind = value.kind();
if constexpr (TC == Fortran::common::TypeCategory::Integer ||
TC == Fortran::common::TypeCategory::Unsigned) {
// MLIR requires constants to be signless
mlir::Type ty = Fortran::lower::getFIRType(
- builder.getContext(), Fortran::common::TypeCategory::Integer, KIND, {});
- if (KIND == 16) {
+ builder.getContext(), Fortran::common::TypeCategory::Integer, kind, {});
+ if (kind == 16) {
auto bigInt = llvm::APInt(ty.getIntOrFloatBitWidth(),
TC == Fortran::common::TypeCategory::Unsigned
? value.UnsignedDecimal()
@@ -274,38 +273,45 @@ static mlir::Value genScalarLit(
if (value.IsCanonical())
return builder.createBool(loc, value.IsTrue());
mlir::Type logicalType = Fortran::lower::getFIRType(
- builder.getContext(), Fortran::common::TypeCategory::Logical, KIND, {});
+ builder.getContext(), Fortran::common::TypeCategory::Logical, kind, {});
mlir::Type intType = Fortran::lower::getFIRType(
- builder.getContext(), Fortran::common::TypeCategory::Integer, KIND, {});
+ builder.getContext(), Fortran::common::TypeCategory::Integer, kind, {});
mlir::Value integer =
builder.createIntegerConstant(loc, intType, value.word().ToInt64());
return fir::BitcastOp::create(builder, loc, logicalType, integer);
} else if constexpr (TC == Fortran::common::TypeCategory::Real) {
std::string str = value.DumpHexadecimal();
- if constexpr (KIND == 2) {
+ switch (kind) {
+ case 2: {
auto floatVal = consAPFloat(llvm::APFloatBase::IEEEhalf(), str);
- return genRealConstant<KIND>(builder, loc, floatVal);
- } else if constexpr (KIND == 3) {
+ return genRealConstant(kind, builder, loc, floatVal);
+ }
+ case 3: {
auto floatVal = consAPFloat(llvm::APFloatBase::BFloat(), str);
- return genRealConstant<KIND>(builder, loc, floatVal);
- } else if constexpr (KIND == 4) {
+ return genRealConstant(kind, builder, loc, floatVal);
+ }
+ case 4: {
auto floatVal = consAPFloat(llvm::APFloatBase::IEEEsingle(), str);
- return genRealConstant<KIND>(builder, loc, floatVal);
- } else if constexpr (KIND == 10) {
+ return genRealConstant(kind, builder, loc, floatVal);
+ }
+ case 10: {
auto floatVal = consAPFloat(llvm::APFloatBase::x87DoubleExtended(), str);
- return genRealConstant<KIND>(builder, loc, floatVal);
- } else if constexpr (KIND == 16) {
+ return genRealConstant(kind, builder, loc, floatVal);
+ }
+ case 16: {
auto floatVal = consAPFloat(llvm::APFloatBase::IEEEquad(), str);
- return genRealConstant<KIND>(builder, loc, floatVal);
- } else {
+ return genRealConstant(kind, builder, loc, floatVal);
+ }
+ default: {
// convert everything else to double
auto floatVal = consAPFloat(llvm::APFloatBase::IEEEdouble(), str);
- return genRealConstant<KIND>(builder, loc, floatVal);
+ return genRealConstant(kind, builder, loc, floatVal);
+ }
}
} else if constexpr (TC == Fortran::common::TypeCategory::Complex) {
- mlir::Value real = genScalarLit<Fortran::common::TypeCategory::Real, KIND>(
+ mlir::Value real = genScalarLit<Fortran::common::TypeCategory::Real>(
builder, loc, value.REAL());
- mlir::Value imag = genScalarLit<Fortran::common::TypeCategory::Real, KIND>(
+ mlir::Value imag = genScalarLit<Fortran::common::TypeCategory::Real>(
builder, loc, value.AIMAG());
return fir::factory::Complex{builder, loc}.createComplex(real, imag);
} else /*constexpr*/ {
@@ -314,70 +320,72 @@ static mlir::Value genScalarLit(
}
/// Create fir::string_lit from a scalar character constant.
-template <int KIND>
static fir::StringLitOp
createStringLitOp(fir::FirOpBuilder &builder, mlir::Location loc,
const Fortran::evaluate::Scalar<Fortran::evaluate::Type<
- Fortran::common::TypeCategory::Character, KIND>> &value,
+ Fortran::common::TypeCategory::Character>> &value,
[[maybe_unused]] int64_t len) {
- if constexpr (KIND == 1) {
+ int kind = value.kind();
+ if (kind == 1) {
assert(value.size() == static_cast<std::uint64_t>(len));
- return builder.createStringLitOp(loc, value);
+ return builder.createStringLitOp(loc, *value.AsStringRef());
} else {
- using ET = typename std::decay_t<decltype(value)>::value_type;
- fir::CharacterType type =
- fir::CharacterType::get(builder.getContext(), KIND, len);
- mlir::MLIRContext *context = builder.getContext();
- std::int64_t size = static_cast<std::int64_t>(value.size());
- mlir::ShapedType shape = mlir::RankedTensorType::get(
- llvm::ArrayRef<std::int64_t>{size},
- mlir::IntegerType::get(builder.getContext(), sizeof(ET) * 8));
- auto denseAttr = mlir::DenseElementsAttr::get(
- shape, llvm::ArrayRef<ET>{value.data(), value.size()});
- auto denseTag = mlir::StringAttr::get(context, fir::StringLitOp::xlist());
- mlir::NamedAttribute dataAttr(denseTag, denseAttr);
- auto sizeTag = mlir::StringAttr::get(context, fir::StringLitOp::size());
- mlir::NamedAttribute sizeAttr(sizeTag, builder.getI64IntegerAttr(len));
- llvm::SmallVector<mlir::NamedAttribute> attrs = {dataAttr, sizeAttr};
- return fir::StringLitOp::create(builder, loc,
- llvm::ArrayRef<mlir::Type>{type},
- mlir::ValueRange{}, attrs);
+ return value.withStdString([&](const auto &value) -> fir::StringLitOp {
+ using ET = typename std::decay_t<decltype(value)>::value_type;
+ fir::CharacterType type =
+ fir::CharacterType::get(builder.getContext(), kind, len);
+ mlir::MLIRContext *context = builder.getContext();
+ std::int64_t size = static_cast<std::int64_t>(value.size());
+ mlir::ShapedType shape = mlir::RankedTensorType::get(
+ llvm::ArrayRef<std::int64_t>{size},
+ mlir::IntegerType::get(builder.getContext(), sizeof(ET) * 8));
+ auto denseAttr = mlir::DenseElementsAttr::get(
+ shape, llvm::ArrayRef<ET>{value.data(), value.size()});
+ auto denseTag = mlir::StringAttr::get(context, fir::StringLitOp::xlist());
+ mlir::NamedAttribute dataAttr(denseTag, denseAttr);
+ auto sizeTag = mlir::StringAttr::get(context, fir::StringLitOp::size());
+ mlir::NamedAttribute sizeAttr(sizeTag, builder.getI64IntegerAttr(len));
+ llvm::SmallVector<mlir::NamedAttribute> attrs = {dataAttr, sizeAttr};
+ return fir::StringLitOp::create(builder, loc,
+ llvm::ArrayRef<mlir::Type>{type},
+ mlir::ValueRange{}, attrs);
+ });
}
}
/// Convert a scalar literal CHARACTER to IR.
-template <int KIND>
static mlir::Value
genScalarLit(fir::FirOpBuilder &builder, mlir::Location loc,
const Fortran::evaluate::Scalar<Fortran::evaluate::Type<
- Fortran::common::TypeCategory::Character, KIND>> &value,
+ Fortran::common::TypeCategory::Character>> &value,
int64_t len, bool outlineInReadOnlyMemory) {
+ int kind = value.kind();
// When in an initializer context, construct the literal op itself and do
// not construct another constant object in rodata.
if (!outlineInReadOnlyMemory)
- return createStringLitOp<KIND>(builder, loc, value, len);
+ return createStringLitOp(builder, loc, value, len);
// Otherwise, the string is in a plain old expression so "outline" the value
// in read only data by hash consing it to a constant literal object.
// ASCII global constants are created using an mlir string attribute.
- if constexpr (KIND == 1) {
- return fir::getBase(fir::factory::createStringLiteral(builder, loc, value));
+ if (kind == 1) {
+ return fir::getBase(
+ fir::factory::createStringLiteral(builder, loc, *value.AsStringRef()));
}
- auto size = builder.getKindMap().getCharacterBitsize(KIND) / 8 * value.size();
- llvm::StringRef strVal(reinterpret_cast<const char *>(value.c_str()), size);
+ auto size = builder.getKindMap().getCharacterBitsize(kind) / 8 * value.size();
+ llvm::StringRef strVal(reinterpret_cast<const char *>(value.data()), size);
std::string globalName = fir::factory::uniqueCGIdent(
- KIND == 1 ? "cl"s : "cl"s + std::to_string(KIND), strVal);
+ kind == 1 ? "cl"s : "cl"s + std::to_string(kind), strVal);
fir::GlobalOp global = builder.getNamedGlobal(globalName);
fir::CharacterType type =
- fir::CharacterType::get(builder.getContext(), KIND, len);
+ fir::CharacterType::get(builder.getContext(), kind, len);
if (!global)
global = builder.createGlobalConstant(
loc, type, globalName,
[&](fir::FirOpBuilder &builder) {
- fir::StringLitOp str =
- createStringLitOp<KIND>(builder, loc, value, len);
+ fir::StringLitOp str = createStringLitOp(builder, loc, value, len);
fir::HasValueOp::create(builder, loc, str);
},
builder.createLinkOnceLinkage());
@@ -630,8 +638,8 @@ genInlinedArrayLit(Fortran::lower::AbstractConverter &converter,
if constexpr (T::category == Fortran::common::TypeCategory::Character) {
do {
mlir::Value elementVal =
- genScalarLit<T::kind>(builder, loc, con.At(subscripts), con.LEN(),
- /*outlineInReadOnlyMemory=*/false);
+ genScalarLit(builder, loc, con.At(subscripts), con.LEN(),
+ /*outlineInReadOnlyMemory=*/false);
array =
fir::InsertValueOp::create(builder, loc, arrayTy, array, elementVal,
builder.getArrayAttr(createIdx()));
@@ -653,9 +661,9 @@ genInlinedArrayLit(Fortran::lower::AbstractConverter &converter,
mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrayTy).getElementType();
do {
auto getElementVal = [&]() {
- return builder.createConvert(loc, eleTy,
- genScalarLit<T::category, T::kind>(
- builder, loc, con.At(subscripts)));
+ return builder.createConvert(
+ loc, eleTy,
+ genScalarLit<T::category>(builder, loc, con.At(subscripts)));
};
Fortran::evaluate::ConstantSubscripts nextSubscripts = subscripts;
bool nextIsSame = con.IncrementSubscripts(nextSubscripts) &&
@@ -743,6 +751,7 @@ static fir::ExtendedValue
genArrayLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
const Fortran::evaluate::Constant<T> &con,
bool outlineInReadOnlyMemory) {
+ const int kind{con.kind()};
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
Fortran::evaluate::ConstantSubscript size =
Fortran::evaluate::GetSize(con.shape());
@@ -758,8 +767,8 @@ genArrayLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
eleTy = Fortran::lower::translateDerivedTypeToFIRType(
converter, con.GetType().GetDerivedTypeSpec());
else
- eleTy = Fortran::lower::getFIRType(builder.getContext(), T::category,
- T::kind, typeParams);
+ eleTy = Fortran::lower::getFIRType(builder.getContext(), T::category, kind,
+ typeParams);
auto arrayTy = fir::SequenceType::get(shape, eleTy);
mlir::Value array = outlineInReadOnlyMemory
? genOutlineArrayLit(converter, loc, arrayTy, con)
@@ -795,8 +804,7 @@ fir::ExtendedValue Fortran::lower::ConstantBuilder<T>::gen(
assert(opt.has_value() && "constant has no value");
if constexpr (T::category == Fortran::common::TypeCategory::Character) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
- auto value =
- genScalarLit<T::kind>(builder, loc, opt.value(), constant.LEN(),
+ auto value = genScalarLit(builder, loc, opt.value(), constant.LEN(),
outlineBigConstantsInReadOnlyMemory);
mlir::Value len = builder.createIntegerConstant(
loc, builder.getCharacterLengthType(), constant.LEN());
@@ -807,8 +815,8 @@ fir::ExtendedValue Fortran::lower::ConstantBuilder<T>::gen(
return genScalarLit(converter, loc, *opt, eleTy,
outlineBigConstantsInReadOnlyMemory);
} else {
- return genScalarLit<T::category, T::kind>(converter.getFirOpBuilder(), loc,
- opt.value());
+ return genScalarLit<T::category>(converter.getFirOpBuilder(), loc,
+ opt.value());
}
}
@@ -843,12 +851,11 @@ genConstantValue(Fortran::lower::AbstractConverter &converter,
constantExpr.AsFortran());
}
-template <Fortran::common::TypeCategory TC, int KIND>
+template <Fortran::common::TypeCategory TC>
static fir::ExtendedValue genConstantValue(
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
- const Fortran::evaluate::Expr<Fortran::evaluate::Type<TC, KIND>>
- &constantExpr) {
- using T = Fortran::evaluate::Type<TC, KIND>;
+ const Fortran::evaluate::Expr<Fortran::evaluate::Type<TC>> &constantExpr) {
+ using T = Fortran::evaluate::Type<TC>;
// Initializer folding preserves parentheses around a scalar constant (e.g.
// "integer :: i = (42)"). UnwrapConstantValue looks through them.
if (const auto *constant =
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index 59ef7143914b2..31d3d802b2384 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -87,7 +87,7 @@ class HlfirDesignatorBuilder {
// Character designators variant contains substrings
using CharacterDesignators =
decltype(Fortran::evaluate::Designator<Fortran::evaluate::Type<
- Fortran::evaluate::TypeCategory::Character, 1>>::u);
+ Fortran::evaluate::TypeCategory::Character>>::u);
hlfir::EntityWithAttributes
gen(const CharacterDesignators &designatorVariant,
bool vectorSubscriptDesignatorToValue = true) {
@@ -100,7 +100,7 @@ class HlfirDesignatorBuilder {
// Character designators variant contains complex parts
using RealDesignators =
decltype(Fortran::evaluate::Designator<Fortran::evaluate::Type<
- Fortran::evaluate::TypeCategory::Real, 4>>::u);
+ Fortran::evaluate::TypeCategory::Real>>::u);
hlfir::EntityWithAttributes
gen(const RealDesignators &designatorVariant,
bool vectorSubscriptDesignatorToValue = true) {
@@ -113,7 +113,7 @@ class HlfirDesignatorBuilder {
// All other designators are similar
using OtherDesignators =
decltype(Fortran::evaluate::Designator<Fortran::evaluate::Type<
- Fortran::evaluate::TypeCategory::Integer, 4>>::u);
+ Fortran::evaluate::TypeCategory::Integer>>::u);
hlfir::EntityWithAttributes
gen(const OtherDesignators &designatorVariant,
bool vectorSubscriptDesignatorToValue = true) {
@@ -1056,11 +1056,11 @@ struct BinaryOp {};
#undef GENBIN
#define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp) \
- template <int KIND> \
- struct BinaryOp<Fortran::evaluate::GenBinEvOp<Fortran::evaluate::Type< \
- Fortran::common::TypeCategory::GenBinTyCat, KIND>>> { \
- using Op = Fortran::evaluate::GenBinEvOp<Fortran::evaluate::Type< \
- Fortran::common::TypeCategory::GenBinTyCat, KIND>>; \
+ template <> \
+ struct BinaryOp<Fortran::evaluate::GenBinEvOp< \
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::GenBinTyCat>>> { \
+ using Op = Fortran::evaluate::GenBinEvOp< \
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::GenBinTyCat>>; \
static hlfir::EntityWithAttributes gen(mlir::Location loc, \
fir::FirOpBuilder &builder, \
const Op &, hlfir::Entity lhs, \
@@ -1093,16 +1093,18 @@ GENBIN(Divide, Integer, mlir::arith::DivSIOp)
GENBIN(Divide, Unsigned, mlir::arith::DivUIOp)
GENBIN(Divide, Real, mlir::arith::DivFOp)
-template <int KIND>
+template <>
struct BinaryOp<Fortran::evaluate::Divide<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> {
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex>>> {
using Op = Fortran::evaluate::Divide<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>;
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
- fir::FirOpBuilder &builder, const Op &,
- hlfir::Entity lhs, hlfir::Entity rhs) {
+ fir::FirOpBuilder &builder,
+ const Op &op, hlfir::Entity lhs,
+ hlfir::Entity rhs) {
+ const int kind = op.kind();
mlir::Type ty = Fortran::lower::getFIRType(
- builder.getContext(), Fortran::common::TypeCategory::Complex, KIND,
+ builder.getContext(), Fortran::common::TypeCategory::Complex, kind,
/*params=*/{});
// TODO: Ideally, complex number division operations should always be
@@ -1118,36 +1120,38 @@ struct BinaryOp<Fortran::evaluate::Divide<
}
};
-template <Fortran::common::TypeCategory TC, int KIND>
-struct BinaryOp<Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>>> {
- using Op = Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>>;
+template <Fortran::common::TypeCategory TC>
+struct BinaryOp<Fortran::evaluate::Power<Fortran::evaluate::Type<TC>>> {
+ using Op = Fortran::evaluate::Power<Fortran::evaluate::Type<TC>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
- fir::FirOpBuilder &builder, const Op &,
- hlfir::Entity lhs, hlfir::Entity rhs) {
- mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND,
+ fir::FirOpBuilder &builder,
+ const Op &op, hlfir::Entity lhs,
+ hlfir::Entity rhs) {
+ const int kind = op.kind();
+ mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, kind,
/*params=*/{});
return hlfir::EntityWithAttributes{fir::genPow(builder, loc, ty, lhs, rhs)};
}
};
-template <Fortran::common::TypeCategory TC, int KIND>
+template <Fortran::common::TypeCategory TC>
struct BinaryOp<
- Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>> {
- using Op =
- Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>;
+ Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC>>> {
+ using Op = Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
- fir::FirOpBuilder &builder, const Op &,
- hlfir::Entity lhs, hlfir::Entity rhs) {
- mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND,
+ fir::FirOpBuilder &builder,
+ const Op &op, hlfir::Entity lhs,
+ hlfir::Entity rhs) {
+ const int kind = op.kind();
+ mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, kind,
/*params=*/{});
return hlfir::EntityWithAttributes{fir::genPow(builder, loc, ty, lhs, rhs)};
}
};
-template <Fortran::common::TypeCategory TC, int KIND>
-struct BinaryOp<
- Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>>> {
- using Op = Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>>;
+template <Fortran::common::TypeCategory TC>
+struct BinaryOp<Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC>>> {
+ using Op = Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder,
const Op &op, hlfir::Entity lhs,
@@ -1165,11 +1169,11 @@ struct BinaryOp<
// MIN and MAX are represented as evaluate::ProcedureRef and are not going
// through here. So far the frontend does not generate character Extremum so
// there is no way to test it.
-template <int KIND>
+template <>
struct BinaryOp<Fortran::evaluate::Extremum<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>> {
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Character>>> {
using Op = Fortran::evaluate::Extremum<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>;
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Character>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &, const Op &,
hlfir::Entity, hlfir::Entity) {
@@ -1202,11 +1206,11 @@ translateSignedRelational(Fortran::common::RelationalOperator rop) {
llvm_unreachable("unhandled INTEGER relational operator");
}
-template <int KIND>
+template <>
struct BinaryOp<Fortran::evaluate::Relational<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>> {
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer>>> {
using Op = Fortran::evaluate::Relational<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>;
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder,
const Op &op, hlfir::Entity lhs,
@@ -1218,17 +1222,16 @@ struct BinaryOp<Fortran::evaluate::Relational<
}
};
-template <int KIND>
+template <>
struct BinaryOp<Fortran::evaluate::Relational<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> {
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned>>> {
using Op = Fortran::evaluate::Relational<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>;
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder,
const Op &op, hlfir::Entity lhs,
hlfir::Entity rhs) {
- int bits = Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
- KIND>::Scalar::bits;
+ int bits = 8 * op.left().GetType().value().kind();
auto signlessType = mlir::IntegerType::get(
builder.getContext(), bits,
mlir::IntegerType::SignednessSemantics::Signless);
@@ -1241,11 +1244,11 @@ struct BinaryOp<Fortran::evaluate::Relational<
}
};
-template <int KIND>
+template <>
struct BinaryOp<Fortran::evaluate::Relational<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>> {
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Real>>> {
using Op = Fortran::evaluate::Relational<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>;
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Real>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder,
const Op &op, hlfir::Entity lhs,
@@ -1257,11 +1260,11 @@ struct BinaryOp<Fortran::evaluate::Relational<
}
};
-template <int KIND>
+template <>
struct BinaryOp<Fortran::evaluate::Relational<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> {
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex>>> {
using Op = Fortran::evaluate::Relational<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>;
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder,
const Op &op, hlfir::Entity lhs,
@@ -1273,11 +1276,11 @@ struct BinaryOp<Fortran::evaluate::Relational<
}
};
-template <int KIND>
+template <>
struct BinaryOp<Fortran::evaluate::Relational<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>> {
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Character>>> {
using Op = Fortran::evaluate::Relational<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>;
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Character>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder,
const Op &op, hlfir::Entity lhs,
@@ -1288,9 +1291,9 @@ struct BinaryOp<Fortran::evaluate::Relational<
}
};
-template <int KIND>
-struct BinaryOp<Fortran::evaluate::LogicalOperation<KIND>> {
- using Op = Fortran::evaluate::LogicalOperation<KIND>;
+template <>
+struct BinaryOp<Fortran::evaluate::LogicalOperation> {
+ using Op = Fortran::evaluate::LogicalOperation;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder,
const Op &op, hlfir::Entity lhs,
@@ -1345,9 +1348,9 @@ struct BinaryOp<Fortran::evaluate::LogicalOperation<KIND>> {
}
};
-template <int KIND>
-struct BinaryOp<Fortran::evaluate::ComplexConstructor<KIND>> {
- using Op = Fortran::evaluate::ComplexConstructor<KIND>;
+template <>
+struct BinaryOp<Fortran::evaluate::ComplexConstructor> {
+ using Op = Fortran::evaluate::ComplexConstructor;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder, const Op &,
hlfir::Entity lhs, hlfir::Entity rhs) {
@@ -1357,9 +1360,9 @@ struct BinaryOp<Fortran::evaluate::ComplexConstructor<KIND>> {
}
};
-template <int KIND>
-struct BinaryOp<Fortran::evaluate::SetLength<KIND>> {
- using Op = Fortran::evaluate::SetLength<KIND>;
+template <>
+struct BinaryOp<Fortran::evaluate::SetLength> {
+ using Op = Fortran::evaluate::SetLength;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder, const Op &,
hlfir::Entity string,
@@ -1378,9 +1381,9 @@ struct BinaryOp<Fortran::evaluate::SetLength<KIND>> {
}
};
-template <int KIND>
-struct BinaryOp<Fortran::evaluate::Concat<KIND>> {
- using Op = Fortran::evaluate::Concat<KIND>;
+template <>
+struct BinaryOp<Fortran::evaluate::Concat> {
+ using Op = Fortran::evaluate::Concat;
hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder, const Op &,
hlfir::Entity lhs, hlfir::Entity rhs) {
@@ -1415,9 +1418,9 @@ struct BinaryOp<Fortran::evaluate::Concat<KIND>> {
template <typename T>
struct UnaryOp {};
-template <int KIND>
-struct UnaryOp<Fortran::evaluate::Not<KIND>> {
- using Op = Fortran::evaluate::Not<KIND>;
+template <>
+struct UnaryOp<Fortran::evaluate::Not> {
+ using Op = Fortran::evaluate::Not;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder, const Op &,
hlfir::Entity lhs) {
@@ -1428,17 +1431,18 @@ struct UnaryOp<Fortran::evaluate::Not<KIND>> {
}
};
-template <int KIND>
+template <>
struct UnaryOp<Fortran::evaluate::Negate<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>> {
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer>>> {
using Op = Fortran::evaluate::Negate<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, KIND>>;
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
- fir::FirOpBuilder &builder, const Op &,
- hlfir::Entity lhs) {
+ fir::FirOpBuilder &builder,
+ const Op &op, hlfir::Entity lhs) {
+ const int kind = op.kind();
// Like LLVM, integer negation is the binary op "0 - value"
mlir::Type type = Fortran::lower::getFIRType(
- builder.getContext(), Fortran::common::TypeCategory::Integer, KIND,
+ builder.getContext(), Fortran::common::TypeCategory::Integer, kind,
/*params=*/{});
mlir::Value zero = builder.createIntegerConstant(loc, type, 0);
return hlfir::EntityWithAttributes{
@@ -1446,16 +1450,17 @@ struct UnaryOp<Fortran::evaluate::Negate<
}
};
-template <int KIND>
+template <>
struct UnaryOp<Fortran::evaluate::Negate<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> {
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned>>> {
using Op = Fortran::evaluate::Negate<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>;
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
- fir::FirOpBuilder &builder, const Op &,
- hlfir::Entity lhs) {
- int bits = Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
- KIND>::Scalar::bits;
+ fir::FirOpBuilder &builder,
+ const Op &op, hlfir::Entity lhs) {
+ const int kind = op.kind();
+ int bits = Fortran::evaluate::Type<
+ Fortran::common::TypeCategory::Integer>::Scalar::bits(kind);
mlir::Type signlessType = mlir::IntegerType::get(
builder.getContext(), bits,
mlir::IntegerType::SignednessSemantics::Signless);
@@ -1468,11 +1473,11 @@ struct UnaryOp<Fortran::evaluate::Negate<
}
};
-template <int KIND>
+template <>
struct UnaryOp<Fortran::evaluate::Negate<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>> {
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Real>>> {
using Op = Fortran::evaluate::Negate<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>;
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Real>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder, const Op &,
hlfir::Entity lhs) {
@@ -1481,11 +1486,11 @@ struct UnaryOp<Fortran::evaluate::Negate<
}
};
-template <int KIND>
+template <>
struct UnaryOp<Fortran::evaluate::Negate<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>> {
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex>>> {
using Op = Fortran::evaluate::Negate<
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex, KIND>>;
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Complex>>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder, const Op &,
hlfir::Entity lhs) {
@@ -1493,9 +1498,9 @@ struct UnaryOp<Fortran::evaluate::Negate<
}
};
-template <int KIND>
-struct UnaryOp<Fortran::evaluate::ComplexComponent<KIND>> {
- using Op = Fortran::evaluate::ComplexComponent<KIND>;
+template <>
+struct UnaryOp<Fortran::evaluate::ComplexComponent> {
+ using Op = Fortran::evaluate::ComplexComponent;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
fir::FirOpBuilder &builder,
const Op &op, hlfir::Entity lhs) {
@@ -1526,21 +1531,19 @@ struct UnaryOp<Fortran::evaluate::Parentheses<T>> {
}
};
-template <Fortran::common::TypeCategory TC1, int KIND,
- Fortran::common::TypeCategory TC2>
-struct UnaryOp<
- Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>, TC2>> {
- using Op =
- Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>, TC2>;
+template <Fortran::common::TypeCategory TC1, Fortran::common::TypeCategory TC2>
+struct UnaryOp<Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1>, TC2>> {
+ using Op = Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1>, TC2>;
static hlfir::EntityWithAttributes gen(mlir::Location loc,
- fir::FirOpBuilder &builder, const Op &,
- hlfir::Entity lhs) {
+ fir::FirOpBuilder &builder,
+ const Op &op, hlfir::Entity lhs) {
+ int kind = op.kind();
if constexpr (TC1 == Fortran::common::TypeCategory::Character &&
TC2 == TC1) {
- return hlfir::convertCharacterKind(loc, builder, lhs, KIND);
+ return hlfir::convertCharacterKind(loc, builder, lhs, kind);
}
mlir::Type type = Fortran::lower::getFIRType(builder.getContext(), TC1,
- KIND, /*params=*/{});
+ kind, /*params=*/{});
mlir::Value res = builder.convertWithSemantics(loc, type, lhs);
return hlfir::EntityWithAttributes{res};
}
@@ -1617,7 +1620,7 @@ class HlfirBuilder {
// least one operand is not constant (otherwise folds). For all other
// intrinsics, semantics converts BOZ to the expected type before lowering.
Fortran::evaluate::Constant<Fortran::evaluate::LargestInt> intConstant{
- expr};
+ Fortran::evaluate::LargestIntKind, expr};
return gen(intConstant);
}
@@ -1696,6 +1699,7 @@ class HlfirBuilder {
template <typename D, typename R, typename O>
hlfir::EntityWithAttributes
gen(const Fortran::evaluate::Operation<D, R, O> &op) {
+ const int rKind = op.kind();
auto &builder = getBuilder();
mlir::Location loc = getLoc();
const int rank = op.Rank();
@@ -1718,7 +1722,7 @@ class HlfirBuilder {
getConverter(), op.derived().GetType().GetDerivedTypeSpec());
} else {
elementType =
- Fortran::lower::getFIRType(builder.getContext(), R::category, R::kind,
+ Fortran::lower::getFIRType(builder.getContext(), R::category, rKind,
/*params=*/{});
}
mlir::Value shape = hlfir::genShape(loc, builder, left);
@@ -1741,6 +1745,7 @@ class HlfirBuilder {
template <typename D, typename R, typename LO, typename RO>
hlfir::EntityWithAttributes
gen(const Fortran::evaluate::Operation<D, R, LO, RO> &op) {
+ const int rKind = op.kind();
auto &builder = getBuilder();
mlir::Location loc = getLoc();
const int rank = op.Rank();
@@ -1771,7 +1776,7 @@ class HlfirBuilder {
// Elemental expression.
mlir::Type elementType =
- Fortran::lower::getFIRType(builder.getContext(), R::category, R::kind,
+ Fortran::lower::getFIRType(builder.getContext(), R::category, rKind,
/*params=*/{});
// TODO: "merge" shape, get cst shape from front-end if possible.
// Prefer a compile-time constant shape to get a statically shaped result.
@@ -1839,8 +1844,8 @@ class HlfirBuilder {
getStmtCtx())
.genNamedEntity(desc.base());
using ResTy = Fortran::evaluate::DescriptorInquiry::Result;
- mlir::Type resultType =
- getConverter().genType(ResTy::category, ResTy::kind);
+ const int resKind = Fortran::evaluate::DescriptorInquiry::kind();
+ mlir::Type resultType = getConverter().genType(ResTy::category, resKind);
auto castResult = [&](mlir::Value v) {
return hlfir::EntityWithAttributes{
builder.createConvert(loc, resultType, v)};
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 0fdbdfcc74424..7dd56a41354e8 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -53,10 +53,9 @@ static mlir::Type genRealType(mlir::MLIRContext *context, int kind) {
llvm_unreachable("REAL type translation not implemented");
}
-template <int KIND>
-int getIntegerBits() {
- return Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
- KIND>::Scalar::bits;
+static int getIntegerBits(int kind) {
+ return Fortran::evaluate::Type<
+ Fortran::common::TypeCategory::Integer>::Scalar::bits(kind);
}
static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind,
bool isUnsigned = false) {
@@ -66,18 +65,7 @@ static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind,
(isUnsigned ? mlir::IntegerType::SignednessSemantics::Unsigned
: mlir::IntegerType::SignednessSemantics::Signless);
- switch (kind) {
- case 1:
- return mlir::IntegerType::get(context, getIntegerBits<1>(), signedness);
- case 2:
- return mlir::IntegerType::get(context, getIntegerBits<2>(), signedness);
- case 4:
- return mlir::IntegerType::get(context, getIntegerBits<4>(), signedness);
- case 8:
- return mlir::IntegerType::get(context, getIntegerBits<8>(), signedness);
- case 16:
- return mlir::IntegerType::get(context, getIntegerBits<16>(), signedness);
- }
+ return mlir::IntegerType::get(context, getIntegerBits(kind), signedness);
}
llvm_unreachable("INTEGER or UNSIGNED kind not translated");
}
@@ -493,14 +481,14 @@ struct TypeBuilderImpl {
// To get the character length from a symbol, make an fold a designator for
// the symbol to cover the case where the symbol is an assumed length named
// constant and its length comes from its init expression length.
- template <int Kind>
fir::SequenceType::Extent
- getCharacterLengthHelper(const Fortran::semantics::Symbol &symbol) {
+ getCharacterLengthHelper(int kind, const Fortran::semantics::Symbol &symbol) {
using TC =
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, Kind>;
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Character>;
auto designator = Fortran::evaluate::Fold(
converter.getFoldingContext(),
- Fortran::evaluate::Expr<TC>{Fortran::evaluate::Designator<TC>{symbol}});
+ Fortran::evaluate::Expr<TC>{
+ Fortran::evaluate::Designator<TC>{kind, symbol}});
if (auto len = toInt64(std::move(designator.LEN())))
return *len;
return fir::SequenceType::getUnknownExtent();
@@ -524,15 +512,7 @@ struct TypeBuilderImpl {
llvm::report_fatal_error("not a character symbol");
int kind =
toInt64(Fortran::common::Clone(type->AsIntrinsic()->kind())).value();
- switch (kind) {
- case 1:
- return getCharacterLengthHelper<1>(symbol);
- case 2:
- return getCharacterLengthHelper<2>(symbol);
- case 4:
- return getCharacterLengthHelper<4>(symbol);
- }
- llvm_unreachable("unknown character kind");
+ return getCharacterLengthHelper(kind, symbol);
}
template <typename A>
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index 1a6819cf10ee7..0732354997cbd 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -6481,7 +6481,7 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
// Map standard OpenMP foreign-runtime identifier strings to
// their well-known integer values (OpenMP 5.1, Table 22.2).
auto frId = llvm::StringSwitch<std::optional<int64_t>>(
- llvm::StringRef(*str).lower())
+ str->AsStringRef()->lower())
.Case("cuda", 1)
.Case("cuda_driver", 2)
.Case("opencl", 3)
@@ -6771,7 +6771,7 @@ static void genErrorDirective(lower::AbstractConverter &converter,
if (args.message) {
if (auto expr = semantics::omp::GetEvaluateExpr(*args.message)) {
if (auto val = evaluate::GetScalarConstantValue<evaluate::Ascii>(*expr))
- message = *val;
+ message = val->AsStdString();
else
messageExpr = expr;
}
diff --git a/flang/lib/Lower/Support/Utils.cpp b/flang/lib/Lower/Support/Utils.cpp
index 9431daaddf1aa..be139d5fc775b 100644
--- a/flang/lib/Lower/Support/Utils.cpp
+++ b/flang/lib/Lower/Support/Utils.cpp
@@ -97,65 +97,72 @@ class HashEvaluateExpr {
static unsigned getHashValue(const Fortran::evaluate::ComplexPart &x) {
return getHashValue(x.complex()) - static_cast<unsigned>(x.part());
}
- template <Fortran::common::TypeCategory TC1, int KIND,
+ template <Fortran::common::TypeCategory TC1,
Fortran::common::TypeCategory TC2>
static unsigned getHashValue(
- const Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>, TC2>
- &x) {
+ const Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1>, TC2> &x) {
+ const int kind{x.kind()};
return getHashValue(x.left()) - (static_cast<unsigned>(TC1) + 2u) -
- (static_cast<unsigned>(KIND) + 5u);
+ (static_cast<unsigned>(kind) + 5u);
}
- template <int KIND>
- static unsigned
- getHashValue(const Fortran::evaluate::ComplexComponent<KIND> &x) {
+ static unsigned getHashValue(const Fortran::evaluate::ComplexComponent &x) {
+ const int kind{x.kind()};
return getHashValue(x.left()) -
- (static_cast<unsigned>(x.isImaginaryPart) + 1u) * 3u;
+ (static_cast<unsigned>(x.isImaginaryPart) + 1u) * 3u +
+ static_cast<unsigned>(kind);
}
template <typename T>
static unsigned getHashValue(const Fortran::evaluate::Parentheses<T> &x) {
return getHashValue(x.left()) * 17u;
}
- template <Fortran::common::TypeCategory TC, int KIND>
+ template <Fortran::common::TypeCategory TC>
static unsigned getHashValue(
- const Fortran::evaluate::Negate<Fortran::evaluate::Type<TC, KIND>> &x) {
+ const Fortran::evaluate::Negate<Fortran::evaluate::Type<TC>> &x) {
+ const int kind{x.kind()};
return getHashValue(x.left()) - (static_cast<unsigned>(TC) + 5u) -
- (static_cast<unsigned>(KIND) + 7u);
+ (static_cast<unsigned>(kind) + 7u);
}
- template <Fortran::common::TypeCategory TC, int KIND>
- static unsigned getHashValue(
- const Fortran::evaluate::Add<Fortran::evaluate::Type<TC, KIND>> &x) {
+ template <Fortran::common::TypeCategory TC>
+ static unsigned
+ getHashValue(const Fortran::evaluate::Add<Fortran::evaluate::Type<TC>> &x) {
+ const int kind{x.kind()};
return (getHashValue(x.left()) + getHashValue(x.right())) * 23u +
- static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);
+ static_cast<unsigned>(TC) + static_cast<unsigned>(kind);
}
- template <Fortran::common::TypeCategory TC, int KIND>
+ template <Fortran::common::TypeCategory TC>
static unsigned getHashValue(
- const Fortran::evaluate::Subtract<Fortran::evaluate::Type<TC, KIND>> &x) {
+ const Fortran::evaluate::Subtract<Fortran::evaluate::Type<TC>> &x) {
+ const int kind{x.kind()};
return (getHashValue(x.left()) - getHashValue(x.right())) * 19u +
- static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);
+ static_cast<unsigned>(TC) + static_cast<unsigned>(kind);
}
- template <Fortran::common::TypeCategory TC, int KIND>
+ template <Fortran::common::TypeCategory TC>
static unsigned getHashValue(
- const Fortran::evaluate::Multiply<Fortran::evaluate::Type<TC, KIND>> &x) {
+ const Fortran::evaluate::Multiply<Fortran::evaluate::Type<TC>> &x) {
+ const int kind{x.kind()};
return (getHashValue(x.left()) + getHashValue(x.right())) * 29u +
- static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);
+ static_cast<unsigned>(TC) + static_cast<unsigned>(kind);
}
- template <Fortran::common::TypeCategory TC, int KIND>
+ template <Fortran::common::TypeCategory TC>
static unsigned getHashValue(
- const Fortran::evaluate::Divide<Fortran::evaluate::Type<TC, KIND>> &x) {
+ const Fortran::evaluate::Divide<Fortran::evaluate::Type<TC>> &x) {
+ const int kind{x.kind()};
return (getHashValue(x.left()) - getHashValue(x.right())) * 31u +
- static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);
+ static_cast<unsigned>(TC) + static_cast<unsigned>(kind);
}
- template <Fortran::common::TypeCategory TC, int KIND>
- static unsigned getHashValue(
- const Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>> &x) {
+ template <Fortran::common::TypeCategory TC>
+ static unsigned
+ getHashValue(const Fortran::evaluate::Power<Fortran::evaluate::Type<TC>> &x) {
+ const int kind{x.kind()};
return (getHashValue(x.left()) - getHashValue(x.right())) * 37u +
- static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);
+ static_cast<unsigned>(TC) + static_cast<unsigned>(kind);
}
- template <Fortran::common::TypeCategory TC, int KIND>
+ template <Fortran::common::TypeCategory TC>
static unsigned getHashValue(
- const Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>> &x) {
+ const Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC>> &x) {
+ const int kind{x.kind()};
return (getHashValue(x.left()) + getHashValue(x.right())) * 41u +
- static_cast<unsigned>(TC) + static_cast<unsigned>(KIND) +
+ static_cast<unsigned>(TC) + static_cast<unsigned>(kind) +
static_cast<unsigned>(x.ordering) * 7u;
}
template <typename T>
@@ -163,28 +170,27 @@ class HashEvaluateExpr {
return getHashValue(x.condition()) * 151u -
getHashValue(x.thenValue()) * 3u + getHashValue(x.elseValue());
}
- template <Fortran::common::TypeCategory TC, int KIND>
+ template <Fortran::common::TypeCategory TC>
static unsigned getHashValue(
- const Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>
- &x) {
+ const Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC>> &x) {
+ const int kind{x.kind()};
return (getHashValue(x.left()) - getHashValue(x.right())) * 43u +
- static_cast<unsigned>(TC) + static_cast<unsigned>(KIND);
+ static_cast<unsigned>(TC) + static_cast<unsigned>(kind);
}
- template <int KIND>
- static unsigned
- getHashValue(const Fortran::evaluate::ComplexConstructor<KIND> &x) {
+ static unsigned getHashValue(const Fortran::evaluate::ComplexConstructor &x) {
+ const int kind{x.kind()};
return (getHashValue(x.left()) - getHashValue(x.right())) * 47u +
- static_cast<unsigned>(KIND);
+ static_cast<unsigned>(kind);
}
- template <int KIND>
- static unsigned getHashValue(const Fortran::evaluate::Concat<KIND> &x) {
+ static unsigned getHashValue(const Fortran::evaluate::Concat &x) {
+ const int kind{x.kind()};
return (getHashValue(x.left()) - getHashValue(x.right())) * 53u +
- static_cast<unsigned>(KIND);
+ static_cast<unsigned>(kind);
}
- template <int KIND>
- static unsigned getHashValue(const Fortran::evaluate::SetLength<KIND> &x) {
+ static unsigned getHashValue(const Fortran::evaluate::SetLength &x) {
+ const int kind{x.kind()};
return (getHashValue(x.left()) - getHashValue(x.right())) * 59u +
- static_cast<unsigned>(KIND);
+ static_cast<unsigned>(kind);
}
static unsigned getHashValue(const Fortran::semantics::SymbolRef &sym) {
return getHashValue(sym.get());
@@ -251,22 +257,19 @@ class HashEvaluateExpr {
// FIXME: hash the contents.
return 149u;
}
- template <int KIND>
- static unsigned getHashValue(const Fortran::evaluate::Not<KIND> &x) {
- return getHashValue(x.left()) * 61u + static_cast<unsigned>(KIND);
+ static unsigned getHashValue(const Fortran::evaluate::Not &x) {
+ return getHashValue(x.left()) * 61u;
}
- template <int KIND>
- static unsigned
- getHashValue(const Fortran::evaluate::LogicalOperation<KIND> &x) {
+ static unsigned getHashValue(const Fortran::evaluate::LogicalOperation &x) {
unsigned result = getHashValue(x.left()) + getHashValue(x.right());
return result * 67u + static_cast<unsigned>(x.logicalOperator) * 5u;
}
- template <Fortran::common::TypeCategory TC, int KIND>
+ template <Fortran::common::TypeCategory TC>
static unsigned getHashValue(
- const Fortran::evaluate::Relational<Fortran::evaluate::Type<TC, KIND>>
- &x) {
+ const Fortran::evaluate::Relational<Fortran::evaluate::Type<TC>> &x) {
+ const int kind{x.kind()};
return (getHashValue(x.left()) + getHashValue(x.right())) * 71u +
- static_cast<unsigned>(TC) + static_cast<unsigned>(KIND) +
+ static_cast<unsigned>(TC) + static_cast<unsigned>(kind) +
static_cast<unsigned>(x.opr) * 11u;
}
template <typename A>
@@ -284,9 +287,8 @@ class HashEvaluateExpr {
return Fortran::common::visit(
[&](const auto &v) { return getHashValue(v); }, x.u);
}
- template <int BITS>
static unsigned
- getHashValue(const Fortran::evaluate::value::Integer<BITS> &x) {
+ getHashValue(const Fortran::evaluate::value::IntegerValue &x) {
return static_cast<unsigned>(x.ToSInt());
}
static unsigned getHashValue(const Fortran::evaluate::NullPointer &x) {
@@ -374,84 +376,81 @@ class IsEqualEvaluateExpr {
template <typename A, Fortran::common::TypeCategory TC2>
static bool isEqual(const Fortran::evaluate::Convert<A, TC2> &x,
const Fortran::evaluate::Convert<A, TC2> &y) {
- return isEqual(x.left(), y.left());
+ return x.kind() == y.kind() && isEqual(x.left(), y.left());
}
- template <int KIND>
- static bool isEqual(const Fortran::evaluate::ComplexComponent<KIND> &x,
- const Fortran::evaluate::ComplexComponent<KIND> &y) {
- return isEqual(x.left(), y.left()) &&
+ static bool isEqual(const Fortran::evaluate::ComplexComponent &x,
+ const Fortran::evaluate::ComplexComponent &y) {
+ return x.kind() == y.kind() && isEqual(x.left(), y.left()) &&
x.isImaginaryPart == y.isImaginaryPart;
}
template <typename T>
static bool isEqual(const Fortran::evaluate::Parentheses<T> &x,
const Fortran::evaluate::Parentheses<T> &y) {
- return isEqual(x.left(), y.left());
+ return x.kind() == y.kind() && isEqual(x.left(), y.left());
}
template <typename A>
static bool isEqual(const Fortran::evaluate::Negate<A> &x,
const Fortran::evaluate::Negate<A> &y) {
- return isEqual(x.left(), y.left());
+ return x.kind() == y.kind() && isEqual(x.left(), y.left());
}
template <typename A>
static bool isBinaryEqual(const A &x, const A &y) {
- return isEqual(x.left(), y.left()) && isEqual(x.right(), y.right());
+ return x.kind() == y.kind() && isEqual(x.left(), y.left()) &&
+ isEqual(x.right(), y.right());
}
template <typename A>
static bool isEqual(const Fortran::evaluate::Add<A> &x,
const Fortran::evaluate::Add<A> &y) {
- return isBinaryEqual(x, y);
+ return x.kind() == y.kind() && isBinaryEqual(x, y);
}
template <typename A>
static bool isEqual(const Fortran::evaluate::Subtract<A> &x,
const Fortran::evaluate::Subtract<A> &y) {
- return isBinaryEqual(x, y);
+ return x.kind() == y.kind() && isBinaryEqual(x, y);
}
template <typename A>
static bool isEqual(const Fortran::evaluate::Multiply<A> &x,
const Fortran::evaluate::Multiply<A> &y) {
- return isBinaryEqual(x, y);
+ return x.kind() == y.kind() && isBinaryEqual(x, y);
}
template <typename A>
static bool isEqual(const Fortran::evaluate::Divide<A> &x,
const Fortran::evaluate::Divide<A> &y) {
- return isBinaryEqual(x, y);
+ return x.kind() == y.kind() && isBinaryEqual(x, y);
}
template <typename A>
static bool isEqual(const Fortran::evaluate::Power<A> &x,
const Fortran::evaluate::Power<A> &y) {
- return isBinaryEqual(x, y);
+ return x.kind() == y.kind() && isBinaryEqual(x, y);
}
template <typename A>
static bool isEqual(const Fortran::evaluate::Extremum<A> &x,
const Fortran::evaluate::Extremum<A> &y) {
- return isBinaryEqual(x, y);
+ return x.kind() == y.kind() && isBinaryEqual(x, y);
}
template <typename T>
static bool isEqual(const Fortran::evaluate::ConditionalExpr<T> &x,
const Fortran::evaluate::ConditionalExpr<T> &y) {
- return isEqual(x.condition(), y.condition()) &&
+ return x.kind() == y.kind() && isEqual(x.condition(), y.condition()) &&
isEqual(x.thenValue(), y.thenValue()) &&
isEqual(x.elseValue(), y.elseValue());
}
template <typename A>
static bool isEqual(const Fortran::evaluate::RealToIntPower<A> &x,
const Fortran::evaluate::RealToIntPower<A> &y) {
- return isBinaryEqual(x, y);
+ return x.kind() == y.kind() && isBinaryEqual(x, y);
}
- template <int KIND>
- static bool isEqual(const Fortran::evaluate::ComplexConstructor<KIND> &x,
- const Fortran::evaluate::ComplexConstructor<KIND> &y) {
- return isBinaryEqual(x, y);
+ static bool isEqual(const Fortran::evaluate::ComplexConstructor &x,
+ const Fortran::evaluate::ComplexConstructor &y) {
+ return x.kind() == y.kind() && isBinaryEqual(x, y);
}
- template <int KIND>
- static bool isEqual(const Fortran::evaluate::Concat<KIND> &x,
- const Fortran::evaluate::Concat<KIND> &y) {
- return isBinaryEqual(x, y);
+ static bool isEqual(const Fortran::evaluate::Concat &x,
+ const Fortran::evaluate::Concat &y) {
+ return x.kind() == y.kind() && isBinaryEqual(x, y);
}
- template <int KIND>
- static bool isEqual(const Fortran::evaluate::SetLength<KIND> &x,
- const Fortran::evaluate::SetLength<KIND> &y) {
- return isBinaryEqual(x, y);
+ static bool isEqual(const Fortran::evaluate::SetLength &x,
+ const Fortran::evaluate::SetLength &y) {
+ return x.kind() == y.kind() && isBinaryEqual(x, y);
}
static bool isEqual(const Fortran::semantics::SymbolRef &x,
const Fortran::semantics::SymbolRef &y) {
@@ -475,7 +474,7 @@ class IsEqualEvaluateExpr {
template <typename A>
static bool isEqual(const Fortran::evaluate::Constant<A> &x,
const Fortran::evaluate::Constant<A> &y) {
- return x == y;
+ return x.kind() == y.kind() && x == y;
}
static bool isEqual(const Fortran::evaluate::ActualArgument &x,
const Fortran::evaluate::ActualArgument &y) {
@@ -526,11 +525,13 @@ class IsEqualEvaluateExpr {
}
static bool isEqual(const Fortran::evaluate::SubscriptInteger &x,
const Fortran::evaluate::SubscriptInteger &y) {
- return x == y;
+ return x.kind() == y.kind() && x == y;
}
template <typename A>
static bool isEqual(const Fortran::evaluate::ArrayConstructor<A> &x,
const Fortran::evaluate::ArrayConstructor<A> &y) {
+ if (x.kind() != y.kind())
+ return false;
bool checkCharacterType = true;
if constexpr (A::category == Fortran::common::TypeCategory::Character) {
checkCharacterType = isEqual(*x.LEN(), *y.LEN());
@@ -541,16 +542,17 @@ class IsEqualEvaluateExpr {
}
static bool isEqual(const Fortran::evaluate::ImpliedDoIndex &x,
const Fortran::evaluate::ImpliedDoIndex &y) {
- return toStringRef(x.name) == toStringRef(y.name);
+ return x.kind() == y.kind() && toStringRef(x.name) == toStringRef(y.name);
}
static bool isEqual(const Fortran::evaluate::TypeParamInquiry &x,
const Fortran::evaluate::TypeParamInquiry &y) {
- return isEqual(x.base(), y.base()) && isEqual(x.parameter(), y.parameter());
+ return x.kind() == y.kind() && isEqual(x.base(), y.base()) &&
+ isEqual(x.parameter(), y.parameter());
}
static bool isEqual(const Fortran::evaluate::DescriptorInquiry &x,
const Fortran::evaluate::DescriptorInquiry &y) {
- return isEqual(x.base(), y.base()) && x.field() == y.field() &&
- x.dimension() == y.dimension();
+ return x.kind() == y.kind() && isEqual(x.base(), y.base()) &&
+ x.field() == y.field() && x.dimension() == y.dimension();
}
static bool isEqual(const Fortran::evaluate::RankOneBoundElement &x,
const Fortran::evaluate::RankOneBoundElement &y) {
@@ -558,6 +560,8 @@ class IsEqualEvaluateExpr {
}
static bool isEqual(const Fortran::evaluate::StructureConstructor &x,
const Fortran::evaluate::StructureConstructor &y) {
+ if (x.kind() != y.kind())
+ return false;
const auto &xValues = x.values();
const auto &yValues = y.values();
if (xValues.size() != yValues.size())
@@ -575,47 +579,52 @@ class IsEqualEvaluateExpr {
}
return true;
}
- template <int KIND>
- static bool isEqual(const Fortran::evaluate::Not<KIND> &x,
- const Fortran::evaluate::Not<KIND> &y) {
- return isEqual(x.left(), y.left());
+ static bool isEqual(const Fortran::evaluate::Not &x,
+ const Fortran::evaluate::Not &y) {
+ return x.kind() == y.kind() && isEqual(x.left(), y.left());
}
- template <int KIND>
- static bool isEqual(const Fortran::evaluate::LogicalOperation<KIND> &x,
- const Fortran::evaluate::LogicalOperation<KIND> &y) {
- return isEqual(x.left(), y.left()) && isEqual(x.right(), y.right());
+ static bool isEqual(const Fortran::evaluate::LogicalOperation &x,
+ const Fortran::evaluate::LogicalOperation &y) {
+ return x.kind() == y.kind() && isEqual(x.left(), y.left()) &&
+ isEqual(x.right(), y.right());
}
template <typename A>
static bool isEqual(const Fortran::evaluate::Relational<A> &x,
const Fortran::evaluate::Relational<A> &y) {
- return isEqual(x.left(), y.left()) && isEqual(x.right(), y.right());
+ return x.kind() == y.kind() && isEqual(x.left(), y.left()) &&
+ isEqual(x.right(), y.right());
}
template <typename A>
static bool isEqual(const Fortran::evaluate::Expr<A> &x,
const Fortran::evaluate::Expr<A> &y) {
- return Fortran::common::visit(
- [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);
+ return x.kind() == y.kind() &&
+ Fortran::common::visit(
+ [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u,
+ y.u);
}
static bool
isEqual(const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &x,
const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &y) {
- return Fortran::common::visit(
- [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);
+ return x.kind() == y.kind() &&
+ Fortran::common::visit(
+ [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u,
+ y.u);
}
template <typename A>
static bool isEqual(const Fortran::evaluate::Designator<A> &x,
const Fortran::evaluate::Designator<A> &y) {
- return Fortran::common::visit(
- [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u, y.u);
+ return x.kind() == y.kind() &&
+ Fortran::common::visit(
+ [&](const auto &v, const auto &w) { return isEqual(v, w); }, x.u,
+ y.u);
}
- template <int BITS>
- static bool isEqual(const Fortran::evaluate::value::Integer<BITS> &x,
- const Fortran::evaluate::value::Integer<BITS> &y) {
- return x == y;
+ static bool isEqual(const Fortran::evaluate::value::IntegerValue &x,
+ const Fortran::evaluate::value::IntegerValue &y) {
+ return x.kind() == y.kind() && x == y;
}
static bool isEqual(const Fortran::evaluate::NullPointer &x,
const Fortran::evaluate::NullPointer &y) {
- return true;
+ return x.kind() == y.kind() && true;
}
template <typename A, typename B,
std::enable_if_t<!std::is_same_v<A, B>, bool> = true>
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 6309b3617f84b..21cb1fcfb2ffa 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -271,7 +271,7 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
ConvertToType(dummy.type.type(), std::move(actual))};
CHECK(converted);
actual = std::move(*converted);
- actualType.set_LEN(SubscriptIntExpr{*dummyLength});
+ actualType.set_LEN(evaluate::MakeSubscriptIntExpr(*dummyLength));
}
}
}
diff --git a/flang/lib/Semantics/check-case.cpp b/flang/lib/Semantics/check-case.cpp
index 7f227cbab618a..38eab344ed48f 100644
--- a/flang/lib/Semantics/check-case.cpp
+++ b/flang/lib/Semantics/check-case.cpp
@@ -22,8 +22,8 @@ namespace Fortran::semantics {
template <typename T> class CaseValues {
public:
- CaseValues(SemanticsContext &c, const evaluate::DynamicType &t)
- : context_{c}, caseExprType_{t} {}
+ CaseValues(int kind, SemanticsContext &c, const evaluate::DynamicType &t)
+ : kind_{kind}, context_{c}, caseExprType_{t} {}
void Check(const std::list<parser::CaseConstruct::Case> &cases) {
for (const parser::CaseConstruct::Case &c : cases) {
@@ -61,13 +61,13 @@ template <typename T> class CaseValues {
"CASE range is not allowed for LOGICAL"_err_en_US);
}
}
- cases_.emplace_back(stmt);
+ cases_.emplace_back(kind_, stmt);
cases_.back().lower = std::move(pair.first);
cases_.back().upper = std::move(pair.second);
}
}
},
- [&](const parser::Default &) { cases_.emplace_front(stmt); },
+ [&](const parser::Default &) { cases_.emplace_front(kind_, stmt); },
},
selector.u);
}
@@ -86,7 +86,8 @@ template <typename T> class CaseValues {
context_.foldingContext(), foldingMessages};
auto folded{evaluate::Fold(foldingContext, SomeExpr{*x->v})};
if (auto converted{evaluate::Fold(foldingContext,
- evaluate::ConvertToType(T::GetType(), SomeExpr{folded}))}) {
+ evaluate::ConvertToType(
+ {T::category, kind_}, SomeExpr{folded}))}) {
if (auto value{evaluate::GetScalarConstantValue<T>(*converted)}) {
auto back{evaluate::Fold(foldingContext,
evaluate::ConvertToType(*type, SomeExpr{*converted}))};
@@ -143,22 +144,23 @@ template <typename T> class CaseValues {
}
struct Case {
- explicit Case(const parser::Statement<parser::CaseStmt> &s) : stmt{s} {}
+ explicit Case(int kind, const parser::Statement<parser::CaseStmt> &s)
+ : kind_{kind}, stmt{s} {}
bool IsDefault() const { return !lower && !upper; }
std::string AsFortran() const {
std::string result;
{
llvm::raw_string_ostream bs{result};
if (lower) {
- evaluate::Constant<T>{*lower}.AsFortran(bs << '(');
+ evaluate::Constant<T>{kind_, *lower}.AsFortran(bs << '(');
if (!upper) {
bs << ':';
} else if (*lower != *upper) {
- evaluate::Constant<T>{*upper}.AsFortran(bs << ':');
+ evaluate::Constant<T>{kind_, *upper}.AsFortran(bs << ':');
}
bs << ')';
} else if (upper) {
- evaluate::Constant<T>{*upper}.AsFortran(bs << "(:") << ')';
+ evaluate::Constant<T>{kind_, *upper}.AsFortran(bs << "(:") << ')';
} else {
bs << "DEFAULT";
}
@@ -166,6 +168,7 @@ template <typename T> class CaseValues {
return result;
}
+ int kind_;
const parser::Statement<parser::CaseStmt> &stmt;
std::optional<Value> lower, upper;
};
@@ -215,6 +218,7 @@ template <typename T> class CaseValues {
}
}
+ int kind_;
SemanticsContext &context_;
const evaluate::DynamicType &caseExprType_;
std::list<Case> cases_;
@@ -224,9 +228,9 @@ template <typename T> class CaseValues {
template <TypeCategory CAT> struct TypeVisitor {
using Result = bool;
using Types = evaluate::CategoryTypes<CAT>;
- template <typename T> Result Test() {
- if (T::kind == exprType.kind()) {
- CaseValues<T>(context, exprType).Check(caseList);
+ template <typename T> Result Test(int kind) {
+ if (kind == exprType.kind()) {
+ CaseValues<T>(kind, context, exprType).Check(caseList);
return true;
} else {
return false;
@@ -341,19 +345,19 @@ void CaseChecker::Enter(const parser::CaseConstruct &construct) {
std::get<std::list<parser::CaseConstruct::Case>>(construct.t)};
switch (exprType->category()) {
case TypeCategory::Integer:
- common::SearchTypes(
+ evaluate::SearchTypes(
TypeVisitor<TypeCategory::Integer>{context_, *exprType, caseList});
return;
case TypeCategory::Unsigned:
- common::SearchTypes(
+ evaluate::SearchTypes(
TypeVisitor<TypeCategory::Unsigned>{context_, *exprType, caseList});
return;
case TypeCategory::Logical:
- CaseValues<evaluate::Type<TypeCategory::Logical, 1>>{context_, *exprType}
+ CaseValues<evaluate::Type<TypeCategory::Logical>>{1, context_, *exprType}
.Check(caseList);
return;
case TypeCategory::Character:
- common::SearchTypes(
+ evaluate::SearchTypes(
TypeVisitor<TypeCategory::Character>{context_, *exprType, caseList});
return;
case TypeCategory::Derived:
@@ -361,8 +365,8 @@ void CaseChecker::Enter(const parser::CaseConstruct &construct) {
if (derived->IsEnumerationType()) {
if (ConvertEnumCaseValues(context_, caseList, *derived)) {
evaluate::DynamicType intType{TypeCategory::Integer, 4};
- CaseValues<evaluate::Type<TypeCategory::Integer, 4>>{
- context_, intType}
+ CaseValues<evaluate::Type<TypeCategory::Integer>>{
+ 4, context_, intType}
.Check(caseList);
}
return;
diff --git a/flang/lib/Semantics/check-coarray.cpp b/flang/lib/Semantics/check-coarray.cpp
index 00b97162ff0d4..a80dbed3f9206 100644
--- a/flang/lib/Semantics/check-coarray.cpp
+++ b/flang/lib/Semantics/check-coarray.cpp
@@ -209,7 +209,7 @@ void CoarrayChecker::Leave(const parser::SyncImagesStmt &x) {
someInt && evaluate::IsActuallyConstant(*someInt)) {
auto converted{evaluate::Fold(context_.foldingContext(),
evaluate::ConvertToType<evaluate::SubscriptInteger>(
- common::Clone(*someInt)))};
+ evaluate::SubscriptIntegerKind, common::Clone(*someInt)))};
if (const auto *cst{
evaluate::UnwrapConstantValue<evaluate::SubscriptInteger>(
converted)}) {
diff --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp
index e8b7ea2eda63e..8adf758e319af 100644
--- a/flang/lib/Semantics/check-data.cpp
+++ b/flang/lib/Semantics/check-data.cpp
@@ -25,7 +25,7 @@ namespace Fortran::semantics {
void DataChecker::Enter(const parser::DataImpliedDo &x) {
const auto &name{parser::UnwrapRef<parser::Name>(
std::get<parser::DataImpliedDo::Bounds>(x.t).Name())};
- int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
+ int kind{evaluate::ResultKind<evaluate::ImpliedDoIndex>};
if (const auto dynamicType{evaluate::DynamicType::From(DEREF(name.symbol))}) {
if (dynamicType->category() == TypeCategory::Integer) {
kind = dynamicType->kind();
diff --git a/flang/lib/Semantics/check-io.h b/flang/lib/Semantics/check-io.h
index 96a07ce13f7bb..58714b39352d8 100644
--- a/flang/lib/Semantics/check-io.h
+++ b/flang/lib/Semantics/check-io.h
@@ -91,8 +91,11 @@ class IoChecker : public virtual BaseChecker {
const auto foldExpr{
evaluate::Fold(context_.foldingContext(), common::Clone(*expr))};
if constexpr (std::is_same_v<R, std::string>) {
- return evaluate::GetScalarConstantValue<DefaultCharConstantType>(
- foldExpr);
+ if (auto charVal{
+ evaluate::GetScalarConstantValue<DefaultCharConstantType>(
+ foldExpr)}) {
+ return charVal->AsStdString();
+ }
} else {
static_assert(std::is_same_v<R, std::int64_t>, "unexpected type");
return evaluate::ToInt64(foldExpr);
diff --git a/flang/lib/Semantics/check-omp-atomic.cpp b/flang/lib/Semantics/check-omp-atomic.cpp
index 810d91a54d710..93508ceb866ca 100644
--- a/flang/lib/Semantics/check-omp-atomic.cpp
+++ b/flang/lib/Semantics/check-omp-atomic.cpp
@@ -59,8 +59,7 @@ template <typename...> struct IsIntegral {
static constexpr bool value{false};
};
-template <common::TypeCategory C, int K>
-struct IsIntegral<evaluate::Type<C, K>> {
+template <common::TypeCategory C> struct IsIntegral<evaluate::Type<C>> {
static constexpr bool value{//
C == common::TypeCategory::Integer ||
C == common::TypeCategory::Unsigned};
@@ -72,8 +71,7 @@ template <typename...> struct IsFloatingPoint {
static constexpr bool value{false};
};
-template <common::TypeCategory C, int K>
-struct IsFloatingPoint<evaluate::Type<C, K>> {
+template <common::TypeCategory C> struct IsFloatingPoint<evaluate::Type<C>> {
static constexpr bool value{//
C == common::TypeCategory::Real || C == common::TypeCategory::Complex};
};
@@ -88,8 +86,7 @@ template <typename...> struct IsLogical {
static constexpr bool value{false};
};
-template <common::TypeCategory C, int K>
-struct IsLogical<evaluate::Type<C, K>> {
+template <common::TypeCategory C> struct IsLogical<evaluate::Type<C>> {
static constexpr bool value{C == common::TypeCategory::Logical};
};
@@ -160,7 +157,7 @@ struct ReassocRewriter : public evaluate::rewrite::Identity {
// Since this works with clang, MSVC and at least GCC 8.5, I'm assuming
// that this is some kind of a GCC issue.
using MatchTypes = std::tuple<evaluate::Add<T>, evaluate::Multiply<T>,
- evaluate::LogicalOperation<T::kind>>;
+ evaluate::LogicalOperation>;
#else
using MatchTypes = typename decltype(outer1)::MatchTypes;
#endif
@@ -205,6 +202,7 @@ struct ReassocRewriter : public evaluate::rewrite::Identity {
evaluate::Expr<T> Reconstruct(const S &op, evaluate::Expr<T> atom,
evaluate::Expr<T> op1, evaluate::Expr<T> op2) {
using TypeS = llvm::remove_cvref_t<decltype(op)>;
+ const int KindS{op.kind()};
// This function has to be semantically correct for all possible types
// of S even though at runtime s will only be one of the matched types.
// Limit the construction to the operation types that we tried to match
@@ -212,8 +210,10 @@ struct ReassocRewriter : public evaluate::rewrite::Identity {
if constexpr (!common::HasMember<TypeS, MatchTypes>) {
return evaluate::Expr<T>(TypeS(op));
} else if constexpr (is_logical_v<T>) {
- constexpr int K{T::kind};
- if constexpr (std::is_same_v<TypeS, evaluate::LogicalOperation<K>>) {
+ CHECK(op1.kind() == op2.kind());
+ const int K{op1.kind()};
+ if constexpr (std::is_same_v<TypeS, evaluate::LogicalOperation>) {
+ CHECK(K == KindS);
// Logical operators take an extra argument in their constructor,
// so they need their own reconstruction code.
common::LogicalOperator opCode{op.logicalOperator};
@@ -224,9 +224,9 @@ struct ReassocRewriter : public evaluate::rewrite::Identity {
}
} else {
// Generic reconstruction.
- return evaluate::Expr<T>(TypeS( //
+ return evaluate::Expr<T>(TypeS(KindS, //
std::move(atom),
- evaluate::Expr<T>(TypeS( //
+ evaluate::Expr<T>(TypeS(KindS, //
std::move(op1), std::move(op2)))));
}
}
@@ -1722,6 +1722,7 @@ struct MinMaxRewriter : public evaluate::rewrite::Identity {
template <typename T>
evaluate::Expr<T> operator()(
evaluate::Expr<T> &&x, const evaluate::FunctionRef<T> &f) {
+ const int kind{f.kind()};
const evaluate::ProcedureDesignator &proc = f.proc();
if (!IsMinMax(proc) || f.arguments().size() <= 2) {
return Id::operator()(std::move(x), f);
@@ -1777,10 +1778,10 @@ struct MinMaxRewriter : public evaluate::rewrite::Identity {
}
SomeExpr tmp = evaluate::AsGenericExpr(
- evaluate::FunctionRef<T>(AsRvalue(proc), AsRvalue(nonAtoms)));
+ evaluate::FunctionRef<T>{kind, AsRvalue(proc), AsRvalue(nonAtoms)});
- return evaluate::Expr<T>(evaluate::FunctionRef<T>(
- AsRvalue(proc), {AsActual(*atomArg), AsActual(tmp)}));
+ return evaluate::Expr<T>{evaluate::FunctionRef<T>{
+ kind, AsRvalue(proc), {AsActual(*atomArg), AsActual(tmp)}}};
}
private:
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 7bd5f1720fb3c..124b659113e84 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -2752,7 +2752,7 @@ void OmpStructureChecker::Enter(const parser::OmpErrorDirective &x) {
if (args.message) {
if (auto expr{GetEvaluateExpr(*args.message)}) {
if (auto val{evaluate::GetScalarConstantValue<evaluate::Ascii>(*expr)}) {
- message = *val;
+ message = val->AsStdString();
}
}
}
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index cd9ec3059afec..ad893735eae6c 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -207,7 +207,7 @@ bool DataInitializationCompiler<DSV>::Scan(const parser::DataImpliedDo &ido) {
auto foldedUpper{evaluate::Fold(context, SomeExpr{*upperExpr})};
auto upper{ToInt64(foldedUpper)};
if (lower && upper) {
- int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
+ int kind{evaluate::ResultKind<evaluate::ImpliedDoIndex>};
if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
if (dynamicType->category() == TypeCategory::Integer) {
kind = dynamicType->kind();
@@ -829,7 +829,7 @@ static bool CombineEquivalencedInitialization(
minElementBytes = 1;
}
const DeclTypeSpec &typeSpec{scope.MakeNumericType(
- TypeCategory::Integer, KindExpr{minElementBytes})};
+ TypeCategory::Integer, MakeKindExpr(minElementBytes))};
details.set_type(typeSpec);
ArraySpec arraySpec;
arraySpec.emplace_back(ShapeSpec::MakeExplicit(Bound{
diff --git a/flang/lib/Semantics/dump-expr.cpp b/flang/lib/Semantics/dump-expr.cpp
index 44c7d5a4058cf..9a581896a8914 100644
--- a/flang/lib/Semantics/dump-expr.cpp
+++ b/flang/lib/Semantics/dump-expr.cpp
@@ -224,12 +224,7 @@ void DumpEvaluateExpr::Outdent() {
void DumpEvExpr(const SomeExpr &x) { DumpEvaluateExpr::Dump(x); }
void DumpEvExpr(
- const evaluate::Expr<evaluate::Type<common::TypeCategory::Integer, 4>> &x) {
- DumpEvaluateExpr::Dump(x);
-}
-
-void DumpEvExpr(
- const evaluate::Expr<evaluate::Type<common::TypeCategory::Integer, 8>> &x) {
+ const evaluate::Expr<evaluate::Type<common::TypeCategory::Integer>> &x) {
DumpEvaluateExpr::Dump(x);
}
@@ -240,7 +235,7 @@ void DumpEvExpr(const evaluate::DataRef &x) { DumpEvaluateExpr::Dump(x); }
void DumpEvExpr(const evaluate::Substring &x) { DumpEvaluateExpr::Dump(x); }
void DumpEvExpr(
- const evaluate::Designator<evaluate::Type<common::TypeCategory::Integer, 4>>
+ const evaluate::Designator<evaluate::Type<common::TypeCategory::Integer>>
&x) {
DumpEvaluateExpr::Dump(x);
}
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index fc57cc43e981c..68dcb5721d37a 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -87,7 +87,7 @@ static std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
if (auto lenExpr{type.LEN()}) {
type.length = Fold(context,
AsExpr(Extremum<SubscriptInteger>{Ordering::Greater,
- Expr<SubscriptInteger>{0}, std::move(*lenExpr)}));
+ MakeSubscriptIntExpr(0), std::move(*lenExpr)}));
}
return type;
} else {
@@ -728,24 +728,25 @@ int ExpressionAnalyzer::AnalyzeKindParam(
template <typename TYPES, TypeCategory CAT> struct IntTypeVisitor {
using Result = MaybeExpr;
using Types = TYPES;
- template <typename T> Result Test() {
- if (T::kind >= kind) {
+ template <typename T> Result Test(int testKind) {
+ if (testKind >= kind) {
const char *p{digits.begin()};
using Int = typename T::Scalar;
- typename Int::ValueWithOverflow num{0, false};
+ typename Int::ValueWithOverflow num{Int::Zero(testKind), false};
const char *typeName{
CAT == TypeCategory::Integer ? "INTEGER" : "UNSIGNED"};
if (isNegated) {
- auto unsignedNum{Int::Read(p, 10, false /*unsigned*/)};
+ auto unsignedNum{Int::Read(testKind, p, 10, false /*unsigned*/)};
num.value = unsignedNum.value.Negate().value;
num.overflow = unsignedNum.overflow ||
- (CAT == TypeCategory::Integer && num.value > Int{0});
+ (CAT == TypeCategory::Integer && num.value > Int{testKind, 0});
if (!num.overflow && num.value.Negate().overflow) {
analyzer.Warn(LanguageFeature::BigIntLiterals, digits,
- "negated maximum INTEGER(KIND=%d) literal"_port_en_US, T::kind);
+ "negated maximum INTEGER(KIND=%d) literal"_port_en_US, testKind);
}
} else {
- num = Int::Read(p, 10, /*isSigned=*/CAT == TypeCategory::Integer);
+ num = Int::Read(
+ testKind, p, 10, /*isSigned=*/CAT == TypeCategory::Integer);
}
if (num.overflow) {
if constexpr (CAT == TypeCategory::Unsigned) {
@@ -753,10 +754,10 @@ template <typename TYPES, TypeCategory CAT> struct IntTypeVisitor {
"Unsigned literal too large for UNSIGNED(KIND=%d); truncated"_warn_en_US,
kind);
return Expr<SomeType>{
- Expr<SomeKind<CAT>>{Expr<T>{Constant<T>{std::move(num.value)}}}};
+ MakeConstantExpr<T>(testKind, std::move(num.value))};
}
} else {
- if (T::kind > kind) {
+ if (testKind > kind) {
if (!isDefaultKind ||
!analyzer.context().IsEnabled(LanguageFeature::BigIntLiterals)) {
return std::nullopt;
@@ -764,11 +765,11 @@ template <typename TYPES, TypeCategory CAT> struct IntTypeVisitor {
analyzer.Warn(LanguageFeature::BigIntLiterals, digits,
"Integer literal is too large for default %s(KIND=%d); "
"assuming %s(KIND=%d)"_port_en_US,
- typeName, kind, typeName, T::kind);
+ typeName, kind, typeName, testKind);
}
}
return Expr<SomeType>{
- Expr<SomeKind<CAT>>{Expr<T>{Constant<T>{std::move(num.value)}}}};
+ MakeConstantExpr<T>(testKind, std::move(num.value))};
}
}
return std::nullopt;
@@ -789,7 +790,7 @@ MaybeExpr ExpressionAnalyzer::IntLiteralConstant(
const char *typeName{CAT == TypeCategory::Integer ? "INTEGER" : "UNSIGNED"};
if (CheckIntrinsicKind(CAT, kind)) {
auto digits{std::get<parser::CharBlock>(x.t)};
- if (MaybeExpr result{common::SearchTypes(IntTypeVisitor<TYPES, CAT>{
+ if (MaybeExpr result{SearchTypes(IntTypeVisitor<TYPES, CAT>{
*this, digits, kind, isDefaultKind, isNegated})}) {
return result;
} else if (isDefaultKind) {
@@ -830,21 +831,21 @@ MaybeExpr ExpressionAnalyzer::Analyze(
}
template <typename TYPE>
-Constant<TYPE> ReadRealLiteral(
- parser::CharBlock source, FoldingContext &context, bool isDefaultKind) {
+Constant<TYPE> ReadRealLiteral(int kind, parser::CharBlock source,
+ FoldingContext &context, bool isDefaultKind) {
const char *p{source.begin()};
- auto valWithFlags{
- Scalar<TYPE>::Read(p, context.targetCharacteristics().roundingMode())};
+ auto valWithFlags{Scalar<TYPE>::Read(
+ kind, p, context.targetCharacteristics().roundingMode())};
CHECK(p == source.end());
context.RealFlagWarnings(valWithFlags.flags, "conversion of REAL literal");
auto value{valWithFlags.value};
if (context.targetCharacteristics().areSubnormalsFlushedToZero()) {
value = value.FlushSubnormalToZero();
}
- typename Constant<TYPE>::Result resultInfo;
+ typename Constant<TYPE>::Result resultInfo{kind};
resultInfo.set_isFromInexactLiteralConversion(
isDefaultKind && valWithFlags.flags.test(RealFlag::Inexact));
- return {value, resultInfo};
+ return {kind, value, resultInfo};
}
struct RealTypeVisitor {
@@ -855,10 +856,10 @@ struct RealTypeVisitor {
int k, parser::CharBlock lit, FoldingContext &ctx, bool isDeftKind)
: kind{k}, literal{lit}, context{ctx}, isDefaultKind{isDeftKind} {}
- template <typename T> Result Test() {
- if (kind == T::kind) {
- return {
- AsCategoryExpr(ReadRealLiteral<T>(literal, context, isDefaultKind))};
+ template <typename T> Result Test(int testKind) {
+ if (kind == testKind) {
+ return {AsCategoryExpr(
+ ReadRealLiteral<T>(testKind, literal, context, isDefaultKind))};
}
return std::nullopt;
}
@@ -920,7 +921,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::RealLiteralConstant &x) {
}
}
bool isDefaultKind{!xkind && letterKind.value_or('e') == 'e'};
- auto result{common::SearchTypes(
+ auto result{SearchTypes(
RealTypeVisitor{kind, xreal.source, GetFoldingContext(), isDefaultKind})};
if (!result) { // C717
Say("Unsupported REAL(KIND=%d)"_err_en_US, kind);
@@ -970,17 +971,17 @@ MaybeExpr ExpressionAnalyzer::AnalyzeString(std::string &&string, int kind) {
}
switch (kind) {
case 1:
- return AsGenericExpr(Constant<Type<TypeCategory::Character, 1>>{
+ return AsGenericExpr(MakeConstant<Type<TypeCategory::Character>>(1,
parser::DecodeString<std::string, parser::Encoding::LATIN_1>(
- string, true)});
+ string, true)));
case 2:
- return AsGenericExpr(Constant<Type<TypeCategory::Character, 2>>{
+ return AsGenericExpr(MakeConstant<Type<TypeCategory::Character>>(2,
parser::DecodeString<std::u16string, parser::Encoding::UTF_8>(
- string, true)});
+ string, true)));
case 4:
- return AsGenericExpr(Constant<Type<TypeCategory::Character, 4>>{
+ return AsGenericExpr(MakeConstant<Type<TypeCategory::Character>>(4,
parser::DecodeString<std::u32string, parser::Encoding::UTF_8>(
- string, true)});
+ string, true)));
default:
CRASH_NO_CASE;
}
@@ -1008,9 +1009,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::LogicalLiteralConstant &x) {
auto kind{AnalyzeKindParam(std::get<std::optional<parser::KindParam>>(x.t),
GetDefaultKind(TypeCategory::Logical))};
bool value{std::get<bool>(x.t)};
- auto result{common::SearchTypes(
- TypeKindVisitor<TypeCategory::Logical, Constant, bool>{
- kind, std::move(value)})};
+ auto result{SearchTypes(
+ TypeKindVisitor<TypeCategory::Logical, Constant, value::LogicalValue>{
+ kind, value::LogicalValue{kind, value}})};
if (!result) {
Say("unsupported LOGICAL(KIND=%d)"_err_en_US, kind); // C728
}
@@ -1037,7 +1038,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::BOZLiteralConstant &x) {
}
CHECK(*p == '"');
++p;
- auto value{BOZLiteralConstant::Read(p, base, false /*unsigned*/)};
+ auto value{BOZLiteralConstant::Read(
+ BOZLiteralConstantKind, p, base, false /*unsigned*/)};
if (*p != '"') {
Say("Invalid digit ('%c') in BOZ literal '%s'"_err_en_US, *p,
x.v); // C7107, C7108
@@ -1072,7 +1074,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Name &n) {
// while processing other specification expressions in the PDT
// definition; the right kind value will be used later in each of its
// instantiations.
- int kind{SubscriptInteger::kind};
+ int kind{SubscriptIntegerKind};
if (const auto *typeSpec{ultimate.GetType()}) {
if (const semantics::IntrinsicTypeSpec *
intrinType{typeSpec->AsIntrinsic()}) {
@@ -1179,12 +1181,13 @@ std::optional<Expr<SubscriptInteger>> ExpressionAnalyzer::GetSubstringBound(
Say("substring bound expression has rank %d"_err_en_US, expr->Rank());
}
if (auto *intExpr{std::get_if<Expr<SomeInteger>>(&expr->u)}) {
- if (auto *ssIntExpr{std::get_if<Expr<SubscriptInteger>>(&intExpr->u)}) {
+ if (auto *ssIntExpr{std::get_if<Expr<SubscriptInteger>>(&intExpr->u)};
+ ssIntExpr && ssIntExpr->kind() == SubscriptIntegerKind) {
return {std::move(*ssIntExpr)};
}
return {Expr<SubscriptInteger>{
Convert<SubscriptInteger, TypeCategory::Integer>{
- std::move(*intExpr)}}};
+ SubscriptIntegerKind, std::move(*intExpr)}}};
} else {
Say("substring bound expression is not INTEGER"_err_en_US);
}
@@ -1260,26 +1263,26 @@ MaybeExpr ExpressionAnalyzer::Analyze(
common::visit([](const auto &ckExpr) { return ckExpr.LEN().value(); },
charExpr->u)};
if (!lower) {
- lower = Expr<SubscriptInteger>{1};
+ lower = MakeSubscriptIntExpr(1);
}
if (!upper) {
- upper = Expr<SubscriptInteger>{
- static_cast<std::int64_t>(ToInt64(length).value())};
+ upper = MakeSubscriptIntExpr(ToInt64(length).value());
}
return common::visit(
[&](auto &&ckExpr) -> MaybeExpr {
using Result = ResultType<decltype(ckExpr)>;
+ const int resultKind{ckExpr.kind()};
auto *cp{std::get_if<Constant<Result>>(&ckExpr.u)};
CHECK(DEREF(cp).size() == 1);
StaticDataObject::Pointer staticData{StaticDataObject::Create()};
- staticData->set_alignment(Result::kind)
- .set_itemBytes(Result::kind)
+ staticData->set_alignment(resultKind)
+ .set_itemBytes(resultKind)
.Push(cp->GetScalarValue().value(),
foldingContext_.targetCharacteristics().isBigEndian());
Substring substring{std::move(staticData), std::move(lower.value()),
std::move(upper.value())};
- return AsGenericExpr(
- Expr<Result>{Designator<Result>{std::move(substring)}});
+ return AsGenericExpr(Expr<Result>{
+ Designator<Result>{resultKind, std::move(substring)}});
},
std::move(charExpr->u));
}
@@ -1311,12 +1314,13 @@ std::optional<Expr<SubscriptInteger>> ExpressionAnalyzer::AsSubscript(
expr->Rank());
}
if (auto *intExpr{std::get_if<Expr<SomeInteger>>(&expr->u)}) {
- if (auto *ssIntExpr{std::get_if<Expr<SubscriptInteger>>(&intExpr->u)}) {
+ if (auto *ssIntExpr{std::get_if<Expr<SubscriptInteger>>(&intExpr->u)};
+ ssIntExpr && ssIntExpr->kind() == SubscriptIntegerKind) {
return std::move(*ssIntExpr);
} else {
return Expr<SubscriptInteger>{
Convert<SubscriptInteger, TypeCategory::Integer>{
- std::move(*intExpr)}};
+ SubscriptIntegerKind, std::move(*intExpr)}};
}
} else {
Say("Subscript expression is not INTEGER"_err_en_US);
@@ -1549,7 +1553,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::StructureComponent &sc) {
? ComplexPart::Part::RE
: ComplexPart::Part::IM};
return AsCategoryExpr(Designator<PartType>{
- ComplexPart{std::move(*dataRef), part}});
+ z.kind(), ComplexPart{std::move(*dataRef), part}});
},
zExpr->u)};
return AsGenericExpr(std::move(realExpr));
@@ -1581,8 +1585,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::CoindexedNamedObject &x) {
std::get<std::list<parser::Cosubscript>>(selector.t)) {
MaybeExpr coex{Analyze(cosub)};
if (auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(coex)}) {
- cosubscripts.push_back(
- ConvertToType<SubscriptInteger>(std::move(*intExpr)));
+ cosubscripts.push_back(ConvertToType<SubscriptInteger>(
+ SubscriptIntegerKind, std::move(*intExpr)));
} else {
cosubsOk = false;
}
@@ -1709,15 +1713,15 @@ class ArrayConstructorContext {
// expression in ToExpr().
using Result = MaybeExpr;
using Types = AllTypes;
- template <typename T> Result Test() {
+ template <typename T> Result Test(int kind) {
if (type_ && type_->category() == T::category) {
if constexpr (T::category == TypeCategory::Derived) {
if (!type_->IsUnlimitedPolymorphic()) {
return AsMaybeExpr(ArrayConstructor<T>{type_->GetDerivedTypeSpec(),
MakeSpecific<T>(std::move(values_))});
}
- } else if (type_->kind() == T::kind) {
- ArrayConstructor<T> result{MakeSpecific<T>(std::move(values_))};
+ } else if (type_->kind() == kind) {
+ ArrayConstructor<T> result{kind, MakeSpecific<T>(std::move(values_))};
if constexpr (T::category == TypeCategory::Character) {
if (auto len{LengthIfGood()}) {
// The ac-do-variables may be treated as constant expressions,
@@ -1744,6 +1748,7 @@ class ArrayConstructorContext {
private:
using ImpliedDoIntType = ResultType<ImpliedDoIndex>;
+ static constexpr int ImpliedDoIntKind = ResultKind<ImpliedDoIndex>;
std::optional<Expr<SubscriptInteger>> LengthIfGood() const {
if (type_) {
@@ -1769,23 +1774,20 @@ class ArrayConstructorContext {
parser::CharBlock name, std::int64_t lower, std::int64_t upper,
std::int64_t stride);
- template <int KIND>
- std::optional<Expr<Type<TypeCategory::Integer, KIND>>> ToSpecificInt(
- MaybeExpr &&y) {
+ std::optional<Expr<ImpliedDoIntType>> ToSpecificInt(MaybeExpr &&y) {
if (y) {
Expr<SomeInteger> *intExpr{UnwrapExpr<Expr<SomeInteger>>(*y)};
return Fold(exprAnalyzer_.GetFoldingContext(),
- ConvertToType<Type<TypeCategory::Integer, KIND>>(
- std::move(DEREF(intExpr))));
+ ConvertToType<ImpliedDoIntType>(
+ SubscriptIntegerKind, std::move(DEREF(intExpr))));
} else {
return std::nullopt;
}
}
- template <int KIND, typename A>
- std::optional<Expr<Type<TypeCategory::Integer, KIND>>> GetSpecificIntExpr(
- const A &x) {
- return ToSpecificInt<KIND>(exprAnalyzer_.Analyze(x));
+ template <typename A>
+ std::optional<Expr<ImpliedDoIntType>> GetSpecificIntExpr(const A &x) {
+ return ToSpecificInt(exprAnalyzer_.Analyze(x));
}
// Nested array constructors all reference the same ExpressionAnalyzer,
@@ -1953,13 +1955,12 @@ void ArrayConstructorContext::Add(const parser::AcValue::Triplet &triplet) {
if (strideType->kind() > kind) {
kind = strideType->kind();
}
- auto lower{ToSpecificInt<ImpliedDoIntType::kind>(std::move(lowerExpr))};
- auto upper{ToSpecificInt<ImpliedDoIntType::kind>(std::move(upperExpr))};
+ auto lower{ToSpecificInt(std::move(lowerExpr))};
+ auto upper{ToSpecificInt(std::move(upperExpr))};
if (lower && upper) {
- auto stride{
- ToSpecificInt<ImpliedDoIntType::kind>(std::move(strideExpr))};
+ auto stride{ToSpecificInt(std::move(strideExpr))};
if (!stride) {
- stride = Expr<ImpliedDoIntType>{1};
+ stride = MakeConstantExpr<ImpliedDoIntType>(ImpliedDoIntKind, 1);
}
DynamicType type{TypeCategory::Integer, kind};
if (!type_) {
@@ -1993,7 +1994,7 @@ void ArrayConstructorContext::Add(const parser::AcImpliedDo &impliedDo) {
exprAnalyzer_.Analyze(bounds.Name());
const auto &parsedName{parser::UnwrapRef<parser::Name>(bounds.Name())};
parser::CharBlock name{parsedName.source};
- int kind{ImpliedDoIntType::kind};
+ int kind{ImpliedDoIntKind};
if (const Symbol *symbol{parsedName.symbol}) {
if (auto dynamicType{DynamicType::From(symbol)}) {
if (dynamicType->category() == TypeCategory::Integer) {
@@ -2002,14 +2003,14 @@ void ArrayConstructorContext::Add(const parser::AcImpliedDo &impliedDo) {
}
}
std::optional<Expr<ImpliedDoIntType>> lower{
- GetSpecificIntExpr<ImpliedDoIntType::kind>(bounds.Lower())};
+ GetSpecificIntExpr(bounds.Lower())};
std::optional<Expr<ImpliedDoIntType>> upper{
- GetSpecificIntExpr<ImpliedDoIntType::kind>(bounds.Upper())};
+ GetSpecificIntExpr(bounds.Upper())};
if (lower && upper) {
std::optional<Expr<ImpliedDoIntType>> stride{
- GetSpecificIntExpr<ImpliedDoIntType::kind>(bounds.Step())};
+ GetSpecificIntExpr(bounds.Step())};
if (!stride) {
- stride = Expr<ImpliedDoIntType>{1};
+ stride = MakeConstantExpr<ImpliedDoIntType>(ImpliedDoIntKind, 1);
}
if (exprAnalyzer_.AddImpliedDo(name, kind)) {
// Check for constant bounds; the loop may require complete unrolling
@@ -2094,7 +2095,7 @@ void ArrayConstructorContext::UnrollConstantImpliedDo(
}
MaybeExpr ArrayConstructorContext::ToExpr() {
- return common::SearchTypes(std::move(*this));
+ return SearchTypes(std::move(*this));
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayConstructor &array) {
@@ -3661,8 +3662,7 @@ std::optional<Chevrons> ExpressionAnalyzer::AnalyzeChevrons(
return std::nullopt;
}
} else {
- result.emplace_back(
- AsGenericExpr(evaluate::Constant<evaluate::CInteger>{-1}));
+ result.emplace_back(AsGenericExpr(MakeCIntegerConstant(-1)));
}
if (auto expr{Analyze(std::get<1>(chevrons->t))};
expr && checkLaunchArg(*expr, "block")) {
@@ -4207,8 +4207,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::ConditionalExpr &x) {
return common::visit(
common::visitors{
[&](Expr<SomeDerived> &&elseVal) -> MaybeExpr {
- Expr<LogicalResult> cond{ConvertToType<LogicalResult>(
- std::move(std::get<Expr<SomeLogical>>(condExpr->u)))};
+ Expr<LogicalResult> cond{
+ ConvertToType<LogicalResult>(LogicalResultKind,
+ std::move(std::get<Expr<SomeLogical>>(condExpr->u)))};
Expr<SomeDerived> thenVal{
std::move(std::get<Expr<SomeDerived>>(thenExpr->u))};
return AsGenericExpr(
@@ -4228,6 +4229,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::ConditionalExpr &x) {
using T =
typename std::decay_t<decltype(elseKindExpr)>::Result;
Expr<LogicalResult> cond{ConvertToType<LogicalResult>(
+ LogicalResultKind,
std::move(std::get<Expr<SomeLogical>>(condExpr->u)))};
Expr<T> thenVal{std::move(std::get<Expr<T>>(
std::get<CategoryType>(thenExpr->u).u))};
@@ -4314,7 +4316,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Concat &x) {
[&](auto &&x, auto &&y) -> MaybeExpr {
using T = ResultType<decltype(x)>;
if constexpr (std::is_same_v<T, ResultType<decltype(y)>>) {
- return AsGenericExpr(Concat<T::kind>{std::move(x), std::move(y)});
+ return AsGenericExpr(Concat{std::move(x), std::move(y)});
} else {
DIE("different types for intrinsic concat");
}
@@ -4719,7 +4721,7 @@ Expr<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(
const std::optional<parser::KindSelector> &selector) {
int defaultKind{GetDefaultKind(category)};
if (!selector) {
- return Expr<SubscriptInteger>{defaultKind};
+ return MakeSubscriptIntExpr(defaultKind);
}
return common::visit(
common::visitors{
@@ -4727,13 +4729,14 @@ Expr<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(
if (MaybeExpr kind{Analyze(x)}) {
if (std::optional<std::int64_t> code{ToInt64(*kind)}) {
if (CheckIntrinsicKind(category, *code)) {
- return Expr<SubscriptInteger>{*code};
+ return MakeSubscriptIntExpr(*code);
}
} else if (auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(*kind)}) {
- return ConvertToType<SubscriptInteger>(std::move(*intExpr));
+ return ConvertToType<SubscriptInteger>(
+ SubscriptIntegerKind, std::move(*intExpr));
}
}
- return Expr<SubscriptInteger>{defaultKind};
+ return MakeSubscriptIntExpr(defaultKind);
},
[&](const parser::KindSelector::StarSize &x) {
std::intmax_t size = x.v;
@@ -4742,7 +4745,7 @@ Expr<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(
} else if (category == TypeCategory::Complex) {
size /= 2;
}
- return Expr<SubscriptInteger>{size};
+ return MakeSubscriptIntExpr(size);
},
},
selector->u);
@@ -5728,11 +5731,11 @@ std::optional<ActualArgument> ArgumentAnalyzer::AnalyzeExpr(
// (or a smaller numeric type) by legacy code.
if (auto hollerith{UnwrapExpr<Constant<Ascii>>(*argExpr)};
hollerith && hollerith->wasHollerith()) {
- std::string bytes{hollerith->values()};
+ auto bytes{hollerith->values()};
while ((bytes.size() % 8) != 0) {
bytes += ' ';
}
- Constant<Ascii> c{std::move(bytes)};
+ Constant<Ascii> c{AsciiKind, std::move(bytes)};
c.set_wasHollerith(true);
argExpr = AsGenericExpr(std::move(c));
}
@@ -6019,7 +6022,7 @@ bool ExprChecker::Pre(const parser::DataImpliedDo &ido) {
parser::Walk(std::get<parser::DataImpliedDo::Bounds>(ido.t), *this);
const auto &bounds{std::get<parser::DataImpliedDo::Bounds>(ido.t)};
const auto &name{parser::UnwrapRef<parser::Name>(bounds.Name())};
- int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
+ int kind{evaluate::ResultKind<evaluate::ImpliedDoIndex>};
if (const auto dynamicType{evaluate::DynamicType::From(DEREF(name.symbol))}) {
if (dynamicType->category() == TypeCategory::Integer) {
kind = dynamicType->kind();
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index 731d98f1103a5..1b84ca1a5f111 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -1139,8 +1139,8 @@ struct ArrayExpressionRecognizer {
return common::visit([](auto &&s) { return isArrayExpression(s); }, x.u);
}
- template <TypeCategory C, int K>
- static bool isArrayExpression(const evaluate::Expr<evaluate::Type<C, K>> &x) {
+ template <TypeCategory C>
+ static bool isArrayExpression(const evaluate::Expr<evaluate::Type<C>> &x) {
return common::visit([](auto &&s) { return isArrayExpression(s); },
evaluate::match::deparen(x).u);
}
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index 7425f831b51b4..7152bb8342c05 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -533,11 +533,11 @@ static bool CheckPointerBounds(
},
[&](const evaluate::Assignment::BoundsRemapping &bounds) {
isBoundsRemapping = true;
- evaluate::ExtentExpr lhsSizeExpr{1};
+ evaluate::ExtentExpr lhsSizeExpr{evaluate::MakeExtentConstant(1)};
for (const auto &bound : bounds) {
lhsSizeExpr = std::move(lhsSizeExpr) *
(common::Clone(bound.second) - common::Clone(bound.first) +
- evaluate::ExtentExpr{1});
+ evaluate::MakeExtentExpr(1));
}
if (std::optional<std::int64_t> lhsSize{evaluate::ToInt64(
evaluate::Fold(context, std::move(lhsSizeExpr)))}) {
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 6580c7e31abdb..deb11bdeb96fb 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -465,7 +465,7 @@ ArraySpecAnalyzer::CheckExplicitShapeBoundsSpec(
CHECK(someInt);
auto asSI{evaluate::Fold(context_.foldingContext(),
evaluate::ConvertToType<evaluate::SubscriptInteger>(
- common::Clone(*someInt)))};
+ evaluate::SubscriptIntegerKind, common::Clone(*someInt)))};
if (folded.Rank() == 0) {
// Scalar bound: broadcasts to every dimension.
return std::make_pair(Bound{MaybeSubscriptIntExpr{std::move(asSI)}},
@@ -599,7 +599,7 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
}
}
Bound lb{lbExpr ? std::move(lbExpr)
- : MaybeSubscriptIntExpr{SubscriptIntExpr{1}}};
+ : MaybeSubscriptIntExpr{evaluate::MakeSubscriptIntExpr(1)}};
Bound ub{std::move(ubExpr)};
arraySpec_.push_back(ShapeSpec::MakeExplicit(std::move(lb), std::move(ub)));
}
@@ -640,7 +640,7 @@ Bound ArraySpecAnalyzer::GetBound(const parser::SpecificationExpr &x) {
if (auto *intExpr{evaluate::UnwrapExpr<SomeIntExpr>(*maybeExpr)}) {
expr = evaluate::Fold(context_.foldingContext(),
evaluate::ConvertToType<evaluate::SubscriptInteger>(
- std::move(*intExpr)));
+ evaluate::SubscriptIntegerKind, std::move(*intExpr)));
}
}
return Bound{std::move(expr)};
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 27c4e96d269aa..bd3a6222710b4 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -220,7 +220,7 @@ class BaseVisitor {
MaybeSubscriptIntExpr EvaluateSubscriptIntExpr(const T &expr) {
if (MaybeIntExpr maybeIntExpr{EvaluateIntExpr(expr)}) {
return FoldExpr(evaluate::ConvertToType<evaluate::SubscriptInteger>(
- std::move(*maybeIntExpr)));
+ evaluate::SubscriptIntegerKind, std::move(*maybeIntExpr)));
} else {
return std::nullopt;
}
@@ -2599,8 +2599,11 @@ void AttrsVisitor::SetBindNameOn(Symbol &symbol) {
return;
}
symbol.SetIsCDefined(isCDefined_);
- std::optional<std::string> label{
- evaluate::GetScalarConstantValue<evaluate::Ascii>(bindName_)};
+ std::optional<std::string> label;
+ if (auto charVal{
+ evaluate::GetScalarConstantValue<evaluate::Ascii>(bindName_)}) {
+ label = charVal->AsStdString();
+ }
// 18.9.2(2): discard leading and trailing blanks
if (label) {
symbol.SetIsExplicitBindName(true);
@@ -6215,7 +6218,7 @@ bool DeclarationVisitor::Pre(const parser::Enumerator &enumerator) {
// Enumerators are treated as PARAMETER (section 7.6 paragraph (4))
symbol = &MakeSymbol(name, Attrs{Attr::PARAMETER}, ObjectEntityDetails{});
symbol->SetType(context().MakeNumericType(
- TypeCategory::Integer, evaluate::CInteger::kind));
+ TypeCategory::Integer, evaluate::CIntegerKind));
}
if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>(
@@ -6226,7 +6229,7 @@ bool DeclarationVisitor::Pre(const parser::Enumerator &enumerator) {
// F2023 7.6.1 errata f23/013: a BOZ enumerator initializer
// has the value specified by INT(boz-literal-constant, C_INT).
const evaluate::DynamicType cIntType{
- TypeCategory::Integer, evaluate::CInteger::kind};
+ TypeCategory::Integer, evaluate::CIntegerKind};
if (MaybeExpr maybeExpr{EvaluateExpr(expr)}) {
if (auto converted{
evaluate::ConvertToType(cIntType, std::move(*maybeExpr))}) {
@@ -6252,8 +6255,8 @@ bool DeclarationVisitor::Pre(const parser::Enumerator &enumerator) {
if (symbol) {
if (enumerationState_.value) {
- symbol->get<ObjectEntityDetails>().set_init(SomeExpr{
- evaluate::Expr<evaluate::CInteger>{*enumerationState_.value}});
+ symbol->get<ObjectEntityDetails>().set_init(
+ SomeExpr{evaluate::MakeCIntegerExpr(*enumerationState_.value)});
} else {
context().SetError(*symbol);
}
@@ -6324,7 +6327,7 @@ void DeclarationVisitor::Post(const parser::EnumerationTypeStmt &x) {
Symbol &ordinalSym{MakeSymbol(currScope(), ordinalName, Attrs{})};
ordinalSym.set_details(ObjectEntityDetails{});
ordinalSym.SetType(
- currScope().MakeNumericType(TypeCategory::Integer, KindExpr{4}));
+ currScope().MakeNumericType(TypeCategory::Integer, MakeKindExpr(4)));
ordinalSym.set(Symbol::Flag::CompilerCreated);
symbol.get<DerivedTypeDetails>().add_component(ordinalSym);
}
@@ -6362,7 +6365,7 @@ bool DeclarationVisitor::Pre(const parser::EnumerationEnumeratorStmt &x) {
CHECK(ordinalIter != currScope().end());
const Symbol &ordinalSym{*ordinalIter->second};
enumCtor.Add(ordinalSym,
- evaluate::AsGenericExpr(evaluate::Expr<evaluate::CInteger>{ordinal}));
+ evaluate::AsGenericExpr(evaluate::MakeCIntegerExpr(ordinal)));
enumerator.get<ObjectEntityDetails>().set_init(
SomeExpr{evaluate::Expr<evaluate::SomeDerived>{
evaluate::Constant<evaluate::SomeDerived>{std::move(enumCtor)}}});
@@ -6759,7 +6762,7 @@ void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Character &) {
}
if (!charInfo_.kind) {
charInfo_.kind =
- KindExpr{context().GetDefaultKind(TypeCategory::Character)};
+ MakeKindExpr(context().GetDefaultKind(TypeCategory::Character));
}
SetDeclTypeSpec(currScope().MakeCharacterType(
std::move(*charInfo_.length), std::move(*charInfo_.kind)));
@@ -9216,11 +9219,11 @@ const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
if (length) {
return currScope().MakeCharacterType(
ParamValue{SomeIntExpr{*std::move(length)}, common::TypeParamAttr::Len},
- KindExpr{type.kind()});
+ MakeKindExpr(type.kind()));
} else {
return currScope().MakeCharacterType(
ParamValue::Deferred(common::TypeParamAttr::Len),
- KindExpr{type.kind()});
+ MakeKindExpr(type.kind()));
}
}
@@ -9432,12 +9435,14 @@ class ExecutionPartAsyncIOSkimmer : public ExecutionPartSkimmerBase {
bool Pre(const parser::IoControlSpec::Asynchronous &async) {
if (auto folded{evaluate::Fold(
context_.foldingContext(), AnalyzeExpr(context_, async.v))}) {
- if (auto str{
+ if (auto charVal{
evaluate::GetScalarConstantValue<evaluate::Ascii>(*folded)}) {
- for (char ch : *str) {
- if (ch != ' ') {
- inAsyncIO_ = ch == 'y' || ch == 'Y';
- break;
+ if (auto str{charVal->AsStdString()}) {
+ for (char ch : *str) {
+ if (ch != ' ') {
+ inAsyncIO_ = ch == 'y' || ch == 'Y';
+ break;
+ }
}
}
}
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index 24f8f571439a3..ef56ce90ff0a7 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -296,7 +296,7 @@ static evaluate::StructureConstructorValues &AddValue(
}
static SomeExpr IntToExpr(std::int64_t n) {
- return evaluate::AsGenericExpr(evaluate::ExtentExpr{n});
+ return evaluate::AsGenericExpr(evaluate::MakeExtentExpr(n));
}
static evaluate::StructureConstructor Structure(
@@ -320,31 +320,31 @@ static int GetIntegerKind(const Symbol &symbol, bool canBeUninstantiated) {
// Save a rank-1 array constant of some numeric type as an
// initialized data object in a scope.
template <typename T>
-static SomeExpr SaveNumericPointerTarget(
- Scope &scope, SourceName name, std::vector<typename T::Scalar> &&x) {
+static SomeExpr SaveNumericPointerTarget(int kind, Scope &scope,
+ SourceName name, std::vector<typename T::Scalar> &&x) {
if (x.empty()) {
return SomeExpr{evaluate::NullPointer{}};
} else {
ObjectEntityDetails object;
if (const auto *spec{scope.FindType(
- DeclTypeSpec{NumericTypeSpec{T::category, KindExpr{T::kind}}})}) {
+ DeclTypeSpec{NumericTypeSpec{T::category, MakeKindExpr(kind)}})}) {
object.set_type(*spec);
} else {
- object.set_type(scope.MakeNumericType(T::category, KindExpr{T::kind}));
+ object.set_type(scope.MakeNumericType(T::category, MakeKindExpr(kind)));
}
auto elements{static_cast<evaluate::ConstantSubscript>(x.size())};
ArraySpec arraySpec;
arraySpec.push_back(ShapeSpec::MakeExplicit(Bound{0}, Bound{elements - 1}));
object.set_shape(arraySpec);
object.set_init(evaluate::AsGenericExpr(evaluate::Constant<T>{
- std::move(x), evaluate::ConstantSubscripts{elements}}));
+ kind, std::move(x), evaluate::ConstantSubscripts{elements}}));
Symbol &symbol{*scope
.try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE},
std::move(object))
.first->second};
SetReadOnlyCompilerCreatedFlags(symbol);
return evaluate::AsGenericExpr(
- evaluate::Expr<T>{evaluate::Designator<T>{symbol}});
+ evaluate::Expr<T>{evaluate::Designator<T>{kind, symbol}});
}
}
@@ -357,12 +357,12 @@ static SomeExpr SaveObjectInit(
CHECK(symbol.get<ObjectEntityDetails>().init().has_value());
SetReadOnlyCompilerCreatedFlags(symbol);
return evaluate::AsGenericExpr(
- evaluate::Designator<evaluate::SomeDerived>{symbol});
+ evaluate::Designator<evaluate::SomeDerived>{0, symbol});
}
-template <int KIND> static SomeExpr IntExpr(std::int64_t n) {
+static SomeExpr IntExpr(int kind, std::int64_t n) {
return evaluate::AsGenericExpr(
- evaluate::Constant<evaluate::Type<TypeCategory::Integer, KIND>>{n});
+ evaluate::MakeConstant<evaluate::Type<TypeCategory::Integer>>(kind, n));
}
static std::optional<std::string> GetSuffixIfTypeKindParameters(
@@ -490,8 +490,8 @@ const Symbol *RuntimeTableBuilder::DescribeType(
AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s,
SomeExpr{evaluate::NullPointer{}});
}
- using Int8 = evaluate::Type<TypeCategory::Integer, 8>;
- using Int1 = evaluate::Type<TypeCategory::Integer, 1>;
+ using Int8 = evaluate::Type<TypeCategory::Integer>;
+ using Int1 = evaluate::Type<TypeCategory::Integer>;
std::vector<Int8::Scalar> kinds;
std::vector<Int1::Scalar> lenKinds;
if (parameters) {
@@ -514,20 +514,20 @@ const Symbol *RuntimeTableBuilder::DescribeType(
}
}
}
- kinds.emplace_back(value);
+ kinds.emplace_back(8, value);
} else { // LEN= parameter
lenKinds.emplace_back(
- GetIntegerKind(*inst, isPDTDefinitionWithKindParameters));
+ 1, GetIntegerKind(*inst, isPDTDefinitionWithKindParameters));
}
}
}
}
AddValue(dtValues, derivedTypeSchema_, "kindparameter"s,
- SaveNumericPointerTarget<Int8>(scope,
+ SaveNumericPointerTarget<Int8>(8, scope,
SaveObjectName((fir::kKindParameterSeparator + distinctName).str()),
std::move(kinds)));
AddValue(dtValues, derivedTypeSchema_, "lenparameterkind"s,
- SaveNumericPointerTarget<Int1>(scope,
+ SaveNumericPointerTarget<Int1>(1, scope,
SaveObjectName((fir::kLenKindSeparator + distinctName).str()),
std::move(lenKinds)));
// Traverse the components of the derived type
@@ -645,27 +645,28 @@ const Symbol *RuntimeTableBuilder::DescribeType(
static_cast<evaluate::ConstantSubscript>(specials.size())}));
}
AddValue(dtValues, derivedTypeSchema_, "specialbitset"s,
- IntExpr<4>(specialBitSet));
+ IntExpr(4, specialBitSet));
// Note the presence/absence of a parent component
AddValue(dtValues, derivedTypeSchema_, "hasparent"s,
- IntExpr<1>(dtScope.GetDerivedTypeParent() != nullptr));
+ IntExpr(1, dtScope.GetDerivedTypeParent() != nullptr));
// To avoid wasting run time attempting to initialize derived type
// instances without any initialized components, analyze the type
// and set a flag if there's nothing to do for it at run time.
AddValue(dtValues, derivedTypeSchema_, "noinitializationneeded"s,
- IntExpr<1>(derivedTypeSpec &&
- !derivedTypeSpec->HasDefaultInitialization(false, false)));
+ IntExpr(1,
+ derivedTypeSpec &&
+ !derivedTypeSpec->HasDefaultInitialization(false, false)));
// Similarly, a flag to short-circuit destruction when not needed.
AddValue(dtValues, derivedTypeSchema_, "nodestructionneeded"s,
- IntExpr<1>(derivedTypeSpec && !derivedTypeSpec->HasDestruction()));
+ IntExpr(1, derivedTypeSpec && !derivedTypeSpec->HasDestruction()));
// Similarly, a flag to short-circuit finalization when not needed.
AddValue(dtValues, derivedTypeSchema_, "nofinalizationneeded"s,
- IntExpr<1>(
- derivedTypeSpec && !MayRequireFinalization(*derivedTypeSpec)));
+ IntExpr(
+ 1, derivedTypeSpec && !MayRequireFinalization(*derivedTypeSpec)));
// Similarly, a flag to enable optimized runtime assignment.
AddValue(dtValues, derivedTypeSchema_, "nodefinedassignment"s,
- IntExpr<1>(
- derivedTypeSpec && !MayHaveDefinedAssignment(*derivedTypeSpec)));
+ IntExpr(
+ 1, derivedTypeSpec && !MayHaveDefinedAssignment(*derivedTypeSpec)));
}
dtObject.get<ObjectEntityDetails>().set_init(MaybeExpr{
StructureExpr(Structure(derivedTypeSchema_, std::move(dtValues)))});
@@ -715,7 +716,7 @@ SomeExpr RuntimeTableBuilder::GetEnumValue(const char *name) const {
const Symbol &symbol{GetSchemaSymbol(name)};
auto value{evaluate::ToInt64(symbol.get<ObjectEntityDetails>().init())};
CHECK(value.has_value());
- return IntExpr<1>(*value);
+ return IntExpr(1, *value);
}
Symbol &RuntimeTableBuilder::CreateObject(
@@ -741,15 +742,16 @@ SomeExpr RuntimeTableBuilder::SaveNameAsPointerTarget(
ObjectEntityDetails object;
auto len{static_cast<common::ConstantSubscript>(name.size())};
if (const auto *spec{scope.FindType(DeclTypeSpec{CharacterTypeSpec{
- ParamValue{len, common::TypeParamAttr::Len}, KindExpr{1}}})}) {
+ ParamValue{len, common::TypeParamAttr::Len}, MakeKindExpr(1)}})}) {
object.set_type(*spec);
} else {
object.set_type(scope.MakeCharacterType(
- ParamValue{len, common::TypeParamAttr::Len}, KindExpr{1}));
+ ParamValue{len, common::TypeParamAttr::Len}, MakeKindExpr(1)));
}
- using evaluate::Ascii;
+ using evaluate::Ascii, evaluate::AsciiKind, evaluate::MakeConstantExpr;
using AsciiExpr = evaluate::Expr<Ascii>;
- object.set_init(evaluate::AsGenericExpr(AsciiExpr{name}));
+ object.set_init(
+ evaluate::AsGenericExpr(MakeConstantExpr<Ascii>(AsciiKind, name)));
Symbol &symbol{
*scope
.try_emplace(
@@ -758,7 +760,7 @@ SomeExpr RuntimeTableBuilder::SaveNameAsPointerTarget(
.first->second};
SetReadOnlyCompilerCreatedFlags(symbol);
return evaluate::AsGenericExpr(
- AsciiExpr{evaluate::Designator<Ascii>{symbol}});
+ AsciiExpr{evaluate::Designator<Ascii>{AsciiKind, symbol}});
}
evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
@@ -781,14 +783,14 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
AddValue(values, componentSchema_, "name"s,
SaveNameAsPointerTarget(scope, symbol.name().ToString()));
AddValue(values, componentSchema_, "category"s,
- IntExpr<1>(static_cast<int>(dyType.category())));
+ IntExpr(1, static_cast<int>(dyType.category())));
if (dyType.IsUnlimitedPolymorphic() ||
dyType.category() == TypeCategory::Derived) {
- AddValue(values, componentSchema_, "kind"s, IntExpr<1>(0));
+ AddValue(values, componentSchema_, "kind"s, IntExpr(1, 0));
} else {
- AddValue(values, componentSchema_, "kind"s, IntExpr<1>(dyType.kind()));
+ AddValue(values, componentSchema_, "kind"s, IntExpr(1, dyType.kind()));
}
- AddValue(values, componentSchema_, "offset"s, IntExpr<8>(symbol.offset()));
+ AddValue(values, componentSchema_, "offset"s, IntExpr(8, symbol.offset()));
// CHARACTER length
auto len{typeAndShape->LEN()};
if (const semantics::DerivedTypeSpec *
@@ -801,7 +803,7 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
if (const auto *clamped{evaluate::UnwrapExpr<
evaluate::Extremum<evaluate::SubscriptInteger>>(*len)}) {
if (clamped->ordering == evaluate::Ordering::Greater &&
- clamped->left() == evaluate::Expr<evaluate::SubscriptInteger>{0}) {
+ clamped->left() == evaluate::MakeSubscriptIntExpr(0)) {
len = common::Clone(clamped->right());
}
}
@@ -862,7 +864,7 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
SomeExpr{evaluate::NullPointer{}});
}
// Shape information
- AddValue(values, componentSchema_, "rank"s, IntExpr<1>(rank));
+ AddValue(values, componentSchema_, "rank"s, IntExpr(1, rank));
if (rank > 0 && !IsAllocatable(symbol) && !IsPointer(symbol)) {
std::vector<evaluate::StructureConstructor> bounds;
evaluate::NamedEntity entity{symbol};
@@ -927,7 +929,7 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
evaluate::StructureConstructorValues values;
AddValue(values, procPtrSchema_, "name"s,
SaveNameAsPointerTarget(scope, symbol.name().ToString()));
- AddValue(values, procPtrSchema_, "offset"s, IntExpr<8>(symbol.offset()));
+ AddValue(values, procPtrSchema_, "offset"s, IntExpr(8, symbol.offset()));
if (auto init{proc.init()}; init && *init) {
AddValue(values, procPtrSchema_, "initialization"s,
SomeExpr{evaluate::ProcedureDesignator{**init}});
@@ -1202,7 +1204,7 @@ void RuntimeTableBuilder::DescribeSpecialProc(
} else {
which = scalarFinalEnum_;
if (int rank{typeAndShape.Rank()}; rank > 0) {
- which = IntExpr<1>(ToInt64(which).value() + rank);
+ which = IntExpr(1, ToInt64(which).value() + rank);
if (dummyData.IsPassedByDescriptor(proc->IsBindC())) {
argThatMightBeDescriptor = 1;
}
@@ -1264,7 +1266,7 @@ void RuntimeTableBuilder::DescribeSpecialProc(
AddValue(
values, specialSchema_, "which"s, SomeExpr{std::move(which.value())});
AddValue(values, specialSchema_, "isargdescriptorset"s,
- IntExpr<1>(isArgDescriptorSet));
+ IntExpr(1, isArgDescriptorSet));
int bindingIndex{0};
if (bindings) {
int j{0};
@@ -1277,9 +1279,9 @@ void RuntimeTableBuilder::DescribeSpecialProc(
}
}
CHECK(bindingIndex <= 255);
- AddValue(values, specialSchema_, "istypebound"s, IntExpr<1>(bindingIndex));
+ AddValue(values, specialSchema_, "istypebound"s, IntExpr(1, bindingIndex));
AddValue(values, specialSchema_, "specialcaseflag"s,
- IntExpr<1>(specialCaseFlag));
+ IntExpr(1, specialCaseFlag));
AddValue(values, specialSchema_, procCompName,
SomeExpr{evaluate::ProcedureDesignator{specific}});
// index might already be present in the case of an override
diff --git a/flang/lib/Semantics/scope.cpp b/flang/lib/Semantics/scope.cpp
index c000bb9038cf5..7c9e2286c797b 100644
--- a/flang/lib/Semantics/scope.cpp
+++ b/flang/lib/Semantics/scope.cpp
@@ -257,11 +257,12 @@ const DeclTypeSpec *Scope::GetType(const SomeExpr &expr) {
case TypeCategory::Unsigned:
case TypeCategory::Real:
case TypeCategory::Complex:
- return &MakeNumericType(dyType->category(), KindExpr{dyType->kind()});
+ return &MakeNumericType(
+ dyType->category(), MakeKindExpr(dyType->kind()));
case TypeCategory::Character:
if (const ParamValue * lenParam{dyType->charLengthParamValue()}) {
return &MakeCharacterType(
- ParamValue{*lenParam}, KindExpr{dyType->kind()});
+ ParamValue{*lenParam}, MakeKindExpr(dyType->kind()));
} else {
auto lenExpr{dyType->GetCharLength()};
if (!lenExpr) {
@@ -272,12 +273,12 @@ const DeclTypeSpec *Scope::GetType(const SomeExpr &expr) {
return &MakeCharacterType(
ParamValue{SomeIntExpr{std::move(*lenExpr)},
common::TypeParamAttr::Len},
- KindExpr{dyType->kind()});
+ MakeKindExpr(dyType->kind()));
}
}
break;
case TypeCategory::Logical:
- return &MakeLogicalType(KindExpr{dyType->kind()});
+ return &MakeLogicalType(MakeKindExpr(dyType->kind()));
case TypeCategory::Derived:
return &MakeDerivedType(dyType->IsPolymorphic()
? DeclTypeSpec::ClassDerived
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index 33c54c81f8abd..1ccbf79750be2 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -406,13 +406,13 @@ const DeclTypeSpec &SemanticsContext::MakeNumericType(
if (kind == 0) {
kind = GetDefaultKind(category);
}
- return globalScope_.MakeNumericType(category, KindExpr{kind});
+ return globalScope_.MakeNumericType(category, MakeKindExpr(kind));
}
const DeclTypeSpec &SemanticsContext::MakeLogicalType(int kind) {
if (kind == 0) {
kind = GetDefaultKind(TypeCategory::Logical);
}
- return globalScope_.MakeLogicalType(KindExpr{kind});
+ return globalScope_.MakeLogicalType(MakeKindExpr(kind));
}
bool SemanticsContext::AnyFatalError() const {
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index 678bae83ba68e..d8bafc2d26aa6 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -23,6 +23,8 @@
namespace Fortran::semantics {
+KindExpr MakeKindExpr(int v) { return evaluate::MakeSubscriptIntExpr(v); }
+
DerivedTypeSpec::DerivedTypeSpec(SourceName name, const Symbol &typeSymbol)
: name_{name}, originalTypeSymbol_{typeSymbol},
typeSymbol_{typeSymbol.GetUltimate()} {
@@ -114,7 +116,7 @@ void DerivedTypeSpec::EvaluateParameters(SemanticsContext &context) {
auto &messages{foldingContext.messages()};
for (const Symbol &symbol : OrderParameterDeclarations(typeSymbol_)) {
SourceName name{symbol.name()};
- int parameterKind{evaluate::TypeParamInquiry::Result::kind};
+ int parameterKind{evaluate::TypeParamInquiry::ResultKind};
// Compute the integer kind value of the type parameter,
// which may depend on the values of earlier ones.
if (const auto *typeSpec{symbol.GetType()}) {
@@ -436,7 +438,7 @@ void DerivedTypeSpec::Instantiate(Scope &containingScope) {
std::move(DEREF(evaluate::UnwrapExpr<SomeIntExpr>(*expr))));
if (auto dyType{expr->GetType()}) {
instanceDetails.set_type(newScope.MakeNumericType(
- TypeCategory::Integer, KindExpr{dyType->kind()}));
+ TypeCategory::Integer, MakeKindExpr(dyType->kind())));
}
}
if (!instanceDetails.type()) {
@@ -661,7 +663,7 @@ const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType(
if (MaybeExpr analyzed{AnalyzeExpr(scope_.context(), *originalKindExpr)}) {
if (auto *intExpr{evaluate::UnwrapExpr<SomeIntExpr>(*analyzed)}) {
kindExpr = evaluate::ConvertToType<evaluate::SubscriptInteger>(
- std::move(*intExpr));
+ evaluate::SubscriptIntegerKind, std::move(*intExpr));
}
}
}
@@ -692,13 +694,13 @@ const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType(
}
switch (spec.category()) {
case DeclTypeSpec::Numeric:
- return scope_.MakeNumericType(intrinsic.category(), KindExpr{kind});
+ return scope_.MakeNumericType(intrinsic.category(), MakeKindExpr(kind));
case DeclTypeSpec::Logical:
- return scope_.MakeLogicalType(KindExpr{kind});
+ return scope_.MakeLogicalType(MakeKindExpr(kind));
case DeclTypeSpec::Character:
return scope_.MakeCharacterType(
FoldCharacterLength(foldingContext(), spec.characterTypeSpec()),
- KindExpr{kind});
+ MakeKindExpr(kind));
default:
CRASH_NO_CASE;
}
@@ -831,7 +833,8 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DerivedTypeSpec &x) {
return o << x.AsFortran();
}
-Bound::Bound(common::ConstantSubscript bound) : expr_{bound} {}
+Bound::Bound(common::ConstantSubscript bound)
+ : expr_{evaluate::MakeSubscriptIntExpr(bound)} {}
llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const Bound &x) {
if (x.isStar()) {
@@ -881,8 +884,7 @@ ParamValue::ParamValue(SomeIntExpr &&expr, common::TypeParamAttr attr)
: attr_{attr}, expr_{std::move(expr)} {}
ParamValue::ParamValue(
common::ConstantSubscript value, common::TypeParamAttr attr)
- : ParamValue(SomeIntExpr{evaluate::Expr<evaluate::SubscriptInteger>{value}},
- attr) {}
+ : ParamValue(SomeIntExpr{evaluate::MakeSubscriptIntExpr(value)}, attr) {}
void ParamValue::SetExplicit(SomeIntExpr &&x) {
category_ = Category::Explicit;
diff --git a/flang/test/Evaluate/fold-ibits.f90 b/flang/test/Evaluate/fold-ibits.f90
index b49fce9f7af96..69052b0bcd588 100644
--- a/flang/test/Evaluate/fold-ibits.f90
+++ b/flang/test/Evaluate/fold-ibits.f90
@@ -11,3 +11,32 @@ module m1
integer, parameter :: expect3(*) = [((iand(shiftr(mess,pos),maskr(len)),len=0,31-pos),pos=0,31)]
logical, parameter :: test3 = all(res3 == expect3)
end module
+
+! IBITS must be folded at the kind of its first argument. Folding it at the
+! default integer kind truncates arguments of a wider kind.
+module m2
+ implicit integer(a-z)
+ integer(1), parameter :: mess1 = int(z'5a', 1)
+ integer(2), parameter :: mess2 = int(z'5a5a', 2)
+ integer(8), parameter :: mess8 = int(z'5a5a5a5a5a5a5a5a', 8)
+ integer(16), parameter :: mess16 = int(z'5a5a5a5a5a5a5a5a5a5a5a5a5a5a5a5a', 16)
+ logical, parameter :: test_kind1 = all( &
+ [((ibits(mess1,pos,len),len=0,7-pos),pos=0,7)] == &
+ [((iand(shiftr(mess1,pos),maskr(len,1)),len=0,7-pos),pos=0,7)])
+ logical, parameter :: test_kind2 = all( &
+ [((ibits(mess2,pos,len),len=0,15-pos),pos=0,15)] == &
+ [((iand(shiftr(mess2,pos),maskr(len,2)),len=0,15-pos),pos=0,15)])
+ logical, parameter :: test_kind8 = all( &
+ [((ibits(mess8,pos,len),len=0,63-pos),pos=0,63)] == &
+ [((iand(shiftr(mess8,pos),maskr(len,8)),len=0,63-pos),pos=0,63)])
+ logical, parameter :: test_kind16 = all( &
+ [((ibits(mess16,pos,len),len=0,127-pos),pos=0,127)] == &
+ [((iand(shiftr(mess16,pos),maskr(len,16)),len=0,127-pos),pos=0,127)])
+ ! Bit fields that extend past bit 31 must survive.
+ logical, parameter :: test_wide8 = ibits(1234567890123_8, 0, 40) == 135056262347_8
+ logical, parameter :: test_wide16 = &
+ ibits(1234567890123456789_16, 8, 120) == 4822530820794753_16
+ ! Folding must not narrow the first argument, which would overflow.
+ integer(8), parameter :: nonarrow8 = ibits(-1_8, 0, 64)
+ logical, parameter :: test_nonarrow8 = nonarrow8 == -1_8
+end module
diff --git a/flang/test/Evaluate/fold-real-storage-size.f90 b/flang/test/Evaluate/fold-real-storage-size.f90
new file mode 100644
index 0000000000000..460e5a6beea11
--- /dev/null
+++ b/flang/test/Evaluate/fold-real-storage-size.f90
@@ -0,0 +1,24 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+
+! REAL(3) is bfloat16: its raw bits occupy 2 bytes, not 3. Constant
+! initialization and TRANSFER round-trip values through their raw bytes, so
+! the number of bytes stored must not be conflated with the kind number.
+! See fold-real10-storage-size.f90 for the REAL(10) counterpart.
+
+subroutine data_init
+ real(3) :: x
+ data x/1.5_3/
+ print *, x
+end subroutine
+! CHECK-LABEL: SUBROUTINE data_init
+! CHECK: DATA x/1.5_3/
+
+subroutine transfers
+ print *, transfer(1.5_3, 0.0_3)
+ print *, transfer(1.5_3, 0_2)
+ print *, transfer(16320_2, 0.0_3)
+end subroutine
+! CHECK-LABEL: SUBROUTINE transfers
+! CHECK: PRINT *, 1.5_3
+! CHECK: PRINT *, 16320_2
+! CHECK: PRINT *, 1.5_3
diff --git a/flang/test/Evaluate/fold-real10-storage-size.f90 b/flang/test/Evaluate/fold-real10-storage-size.f90
new file mode 100644
index 0000000000000..6def77bd9fa06
--- /dev/null
+++ b/flang/test/Evaluate/fold-real10-storage-size.f90
@@ -0,0 +1,41 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+! REQUIRES: target=x86_64{{.*}}
+
+! REAL(10) is the x87 extended format: 80 significant bits held in a 16-byte
+! container, so its raw bits occupy 16 bytes rather than 10. Constant
+! initialization, TRANSFER and host-library folding all round-trip values
+! through their raw bytes, so the number of bytes stored must not be
+! conflated with the kind number.
+
+subroutine data_init
+ real(10) :: x
+ complex(10) :: y
+ data x/1.5_10/
+ data y/(1.5_10, 2.5_10)/
+ print *, x, y
+end subroutine
+! CHECK-LABEL: SUBROUTINE data_init
+! CHECK: DATA x/1.5_10/
+! CHECK: DATA y/(1.5_10,2.5_10)/
+
+subroutine transfers
+ ! A bit pattern of 1 reinterpreted as REAL(10) is the smallest subnormal,
+ ! so the low-order bytes must survive the round trip.
+ print *, transfer(1_8, 0.0_10)
+ print *, transfer(1.5_10, 0.0_10)
+ print *, transfer(1.5_10, 0_2, 8)
+end subroutine
+! CHECK-LABEL: SUBROUTINE transfers
+! CHECK: PRINT *, {{.*}}e-4951_10
+! CHECK: PRINT *, 1.5_10
+! CHECK: PRINT *, [INTEGER(2)::0_2,0_2,0_2,-16384_2,16383_2,0_2,0_2,0_2]
+
+subroutine host_folding
+ ! Folding these casts to and from the host long double, whose size differs
+ ! from the number of significant bytes.
+ real(10), parameter :: s = sin(1.0_10)
+ real(10), parameter :: e = exp(1.0_10)
+ print *, s, e
+end subroutine
+! CHECK-LABEL: SUBROUTINE host_folding
+! CHECK: PRINT *, 8.414709848078965048756572286947630345821380615234375e-1_10, 2.718281828459045090795598298427648842334747314453125_10
diff --git a/flang/test/Evaluate/fold-transfer-partial.f90 b/flang/test/Evaluate/fold-transfer-partial.f90
new file mode 100644
index 0000000000000..4e01635641c71
--- /dev/null
+++ b/flang/test/Evaluate/fold-transfer-partial.f90
@@ -0,0 +1,71 @@
+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Tests folding of TRANSFER(...) when the physical representation of the
+! result is longer than that of SOURCE. F2023 16.9.212 p.5 requires the
+! leading part of the result's physical representation to be that of
+! SOURCE, and requires TRANSFER(TRANSFER(E, D), E) to have the value of E
+! for scalar D and E (and likewise TRANSFER(TRANSFER(E, D), E, SIZE(E))
+! when D is an array and E has rank one); the Examples paragraph's
+! Case (ii) shows a trailing array element only partially covered by
+! SOURCE. The remainder of the result beyond SOURCE's representation is
+! processor dependent; flang zero-fills it (as already pinned for
+! CHARACTER by fold-transfer.f90's test_i2c_s).
+! Same-size and mold-shorter values are covered by fold-transfer.f90;
+! this file pins the mold-longer cases. All checks are byte-order
+! independent: the round trips prove the leading-part byte placement,
+! and the two-endian .or. checks (idiom precedent: fold-transfer.f90's
+! test_c2i_s) are portable value/zero-fill pins, not placement proofs.
+
+module m
+ ! Scalar MOLD longer than SOURCE: round trips (16.9.212 p.5), ...
+ logical, parameter :: test_rt_scalar = transfer(transfer(1_4, 0_8), 0_4) == 1_4
+ logical, parameter :: test_rt_neg = transfer(transfer(-1_4, 0_8), 0_4) == -1_4
+ logical, parameter :: test_rt_real = transfer(transfer(1.5, 0._8), 0.0) == 1.5
+ ! ... and a portable leading-part + zero-fill value pin (either
+ ! byte order's correct value; placement is proven by the round trips)
+ integer(8), parameter :: w1 = transfer(1_4, 0_8)
+ logical, parameter :: test_lead_zfill = w1 == 1_8 .or. w1 == 4294967296_8
+
+ ! Rank-one results whose trailing element is only partially covered
+ ! by SOURCE, with and without SIZE=
+ integer(8), parameter :: via8(2) = transfer([1_4, 2_4, 3_4], 0_8, 2)
+ logical, parameter :: test_rt_array = all(transfer(via8, 0_4, 3) == [1_4, 2_4, 3_4])
+ logical, parameter :: test_elem2_zfill = via8(2) == 3_8 .or. via8(2) == 12884901888_8
+ integer(8), parameter :: via8b(*) = transfer([1_4, 2_4, 3_4], [0_8])
+ logical, parameter :: test_rt_array2 = all(transfer(via8b, 0_4, 3) == [1_4, 2_4, 3_4])
+ real(8), parameter :: rvia8(2) = transfer([1.5, 2.5, 3.5], 0._8, 2)
+ logical, parameter :: test_rt_real_arr = all(transfer(rvia8, 0.0, 3) == [1.5, 2.5, 3.5])
+
+ ! The standard's own Case (ii) example (16.9.212 p.6): the second
+ ! element's real part has the value 3.3; its imaginary part is
+ ! processor dependent
+ complex, parameter :: cx(2) = transfer([1.1, 2.2, 3.3], [(0.0, 0.0)])
+ logical, parameter :: test_case_ii = cx(1) == (1.1, 2.2) .and. real(cx(2)) == 3.3
+
+ ! Derived-type MOLD longer than SOURCE: the leading part is preserved
+ ! (observed portably via round trips); components at or beyond the end
+ ! of SOURCE's representation are zero-filled
+ type t1
+ integer(8) :: a, b
+ end type
+ type(t1), parameter :: x1 = transfer([1_4, 2_4, 3_4], t1(0, 0)) ! b partially covered
+ logical, parameter :: test_derived_rt = all(transfer(x1, 0_4, 3) == [1_4, 2_4, 3_4])
+ type(t1), parameter :: x2 = transfer(7_4, t1(-1, -1)) ! a partial, b wholly beyond
+ logical, parameter :: test_derived_lead = transfer(x2, 0_4) == 7_4
+ logical, parameter :: test_derived_zero = x2%b == 0_8
+ type(t1), parameter :: x4 = transfer(1_8, t1(-1, -1)) ! b exactly at the end
+ logical, parameter :: test_at_end = x4%a == 1_8 .and. x4%b == 0_8
+ type t2
+ integer(4) :: x
+ integer(4) :: y ! keeps c beyond a 4-byte SOURCE even where integer(8) has 4-byte alignment
+ integer(8) :: c(4) ! wholly beyond SOURCE's representation
+ end type
+ type(t2), parameter :: x3 = transfer(9_4, t2(0, 0, [0_8, 0_8, 0_8, 0_8]))
+ logical, parameter :: test_beyond = x3%x == 9_4 .and. x3%y == 0_4 .and. all(x3%c == 0_8)
+
+ ! CHARACTER MOLD with elements beyond SOURCE: NUL fill
+ character(1), parameter :: ch(50) = transfer(1_8, 'x', 50)
+ logical, parameter :: test_char_rt = transfer(ch(1:8), 0_8) == 1_8
+ logical, parameter :: test_char_zero = ichar(ch(9)) == 0 .and. ichar(ch(50)) == 0
+ character(8), parameter :: c8 = transfer('AB', 'xxxxxxxx')
+ logical, parameter :: test_char_scalar = c8(1:2) == 'AB' .and. ichar(c8(3:3)) == 0 .and. ichar(c8(8:8)) == 0
+end module
diff --git a/flang/test/Lower/constant-literal-kinds.f90 b/flang/test/Lower/constant-literal-kinds.f90
new file mode 100644
index 0000000000000..76498b91ce9df
--- /dev/null
+++ b/flang/test/Lower/constant-literal-kinds.f90
@@ -0,0 +1,63 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! Constant array literals are hoisted into globals that are shared between
+! equivalent literals. Every constant expression hashes to the same bucket,
+! so the equality predicate in Fortran::lower::isEqual() is what keeps them
+! apart: literals that differ only in the kind of their elements must not be
+! given the same global, or the global would be emitted with the element type
+! of whichever literal was lowered first.
+
+subroutine integer_kinds
+ interface
+ subroutine i1(x)
+ integer(1) :: x(3)
+ end subroutine
+ subroutine i2(x)
+ integer(2) :: x(3)
+ end subroutine
+ subroutine i4(x)
+ integer(4) :: x(3)
+ end subroutine
+ subroutine i8(x)
+ integer(8) :: x(3)
+ end subroutine
+ end interface
+ call i1([1_1, 2_1, 3_1])
+ call i2([1_2, 2_2, 3_2])
+ call i4([1_4, 2_4, 3_4])
+ call i8([1_8, 2_8, 3_8])
+end subroutine
+! CHECK-DAG: fir.global internal @_QQro.3xi1.{{[0-9]+}}(dense<[1, 2, 3]> : tensor<3xi8>) {{.*}} : !fir.array<3xi8>
+! CHECK-DAG: fir.global internal @_QQro.3xi2.{{[0-9]+}}(dense<[1, 2, 3]> : tensor<3xi16>) {{.*}} : !fir.array<3xi16>
+! CHECK-DAG: fir.global internal @_QQro.3xi4.{{[0-9]+}}(dense<[1, 2, 3]> : tensor<3xi32>) {{.*}} : !fir.array<3xi32>
+! CHECK-DAG: fir.global internal @_QQro.3xi8.{{[0-9]+}}(dense<[1, 2, 3]> : tensor<3xi64>) {{.*}} : !fir.array<3xi64>
+
+subroutine real_kinds
+ interface
+ subroutine r4(x)
+ real(4) :: x(3)
+ end subroutine
+ subroutine r8(x)
+ real(8) :: x(3)
+ end subroutine
+ end interface
+ call r4([1.0_4, 2.0_4, 3.0_4])
+ call r8([1.0_8, 2.0_8, 3.0_8])
+end subroutine
+! CHECK-DAG: fir.global internal @_QQro.3xr4.{{[0-9]+}}({{.*}} : tensor<3xf32>) {{.*}} : !fir.array<3xf32>
+! CHECK-DAG: fir.global internal @_QQro.3xr8.{{[0-9]+}}({{.*}} : tensor<3xf64>) {{.*}} : !fir.array<3xf64>
+
+subroutine logical_kinds
+ interface
+ subroutine l1(x)
+ logical(1) :: x(2)
+ end subroutine
+ subroutine l4(x)
+ logical(4) :: x(2)
+ end subroutine
+ end interface
+ call l1([.true._1, .false._1])
+ call l4([.true._4, .false._4])
+end subroutine
+! CHECK-DAG: fir.global internal @_QQro.2xl1.{{[0-9]+}}({{.*}} : tensor<2xi8>) {{.*}} : !fir.array<2x!fir.logical<1>>
+! CHECK-DAG: fir.global internal @_QQro.2xl4.{{[0-9]+}}({{.*}} : tensor<2xi32>) {{.*}} : !fir.array<2x!fir.logical<4>>
diff --git a/flang/tools/CMakeLists.txt b/flang/tools/CMakeLists.txt
index 975eaa29343fc..9f919ffe6e5d3 100644
--- a/flang/tools/CMakeLists.txt
+++ b/flang/tools/CMakeLists.txt
@@ -16,3 +16,4 @@ add_subdirectory(tco)
add_subdirectory(f18-parse-demo)
add_subdirectory(fir-opt)
add_subdirectory(fir-lsp-server)
+add_subdirectory(object-size-probe)
diff --git a/flang/tools/object-size-probe/CMakeLists.txt b/flang/tools/object-size-probe/CMakeLists.txt
new file mode 100644
index 0000000000000..6203eafa2ff91
--- /dev/null
+++ b/flang/tools/object-size-probe/CMakeLists.txt
@@ -0,0 +1,42 @@
+#===-- tools/object-size-probe/CMakeLists.txt ------------------------------===#
+#
+# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+# See https://llvm.org/LICENSE.txt for license information.
+# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+#
+#===------------------------------------------------------------------------===#
+
+if (CMAKE_CROSSCOMPILING)
+ # Cannot execute the probe when cross-compiling
+ # Unlike tblgen, building it separately is no solution because we need the
+ # sizeof(...)/alignof(...) to be processed for the target, not the host.
+ # include/flang/Evaluate/object-sizes.h contains backup values when the
+ # generated header does not exist
+ return ()
+endif ()
+
+
+set(LLVM_LINK_COMPONENTS
+ Support
+ )
+
+add_llvm_executable(flang-object-size-probe object-size-probe.cpp)
+target_include_directories(flang-object-size-probe PRIVATE
+ "${FLANG_SOURCE_DIR}/lib/Evaluate"
+ )
+
+set(_object_sizes_dir "${FLANG_BINARY_DIR}/include/object-sizes/$<CONFIG>/flang/Evaluate")
+set(_object_sizes_h "${_object_sizes_dir}/object-sizes-generated.h")
+
+add_custom_command(
+ OUTPUT "${_object_sizes_h}"
+ COMMAND "${CMAKE_COMMAND}" -E make_directory "${_object_sizes_dir}"
+ COMMAND "$<TARGET_FILE:flang-object-size-probe>" "${_object_sizes_h}"
+ DEPENDS flang-object-size-probe
+ COMMENT "Deducing IntegerValueImpl/RealValueImpl/CharacterValueImpl object size and alignment ($<CONFIG>)"
+ VERBATIM)
+add_custom_target(flang-generated-object-sizes DEPENDS "${_object_sizes_h}")
+
+add_dependencies(FortranEvaluate flang-generated-object-sizes)
+add_dependencies(FortranSemantics flang-generated-object-sizes)
+add_dependencies(FortranLower flang-generated-object-sizes)
diff --git a/flang/tools/object-size-probe/object-size-probe.cpp b/flang/tools/object-size-probe/object-size-probe.cpp
new file mode 100644
index 0000000000000..58f485b423d4b
--- /dev/null
+++ b/flang/tools/object-size-probe/object-size-probe.cpp
@@ -0,0 +1,99 @@
+//===-- tools/object-size-probe/object-size-probe.cpp -----------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Automatic deduction of the opaque object size/alignment used by the
+// IntegerValue, RealValue, and CharacterValue facades (integer-value.h,
+// real-value.h, character-value.h).
+//
+// These are similar to the pImpl-idiom, except that instead of the facade
+// storing a pointer to the implementation-object (IntegerValueImpl,
+// RealValueImpl, CharacterValueImpl), it is reinterpret-casted over the facade
+// object. This requires both to have the same object sizes. A `sizeof(*Impl)`
+// would defeat the purpose of hiding the implementation. Instead, we probe the
+// object size at build time.
+//
+// This program is compiled and executed to generate a header file containing
+// sizes of the implementation objects.
+//
+//===----------------------------------------------------------------------===//
+
+#define FLANG_OBJECT_SIZE_PROBE
+
+#include "character-value-impl.h"
+#include "integer-value-impl.h"
+#include "real-value-impl.h"
+#include "llvm/Support/FileSystem.h"
+#include "llvm/Support/Format.h"
+#include "llvm/Support/ToolOutputFile.h"
+#include "llvm/Support/raw_ostream.h"
+#include <cstddef>
+#include <cstdlib>
+
+using Fortran::evaluate::value::CharacterValueImpl;
+using Fortran::evaluate::value::IntegerValueImpl;
+using Fortran::evaluate::value::RealValueImpl;
+
+int main(int argc, char **argv) {
+ if (argc != 2) {
+ llvm::errs() << "usage: " << argv[0] << " <object-sizes-generated.h>\n";
+ return EXIT_FAILURE;
+ }
+
+ std::error_code ec;
+ llvm::ToolOutputFile out(argv[1], ec, llvm::sys::fs::OF_Text);
+ if (ec) {
+ llvm::errs() << "object-size-probe: cannot open " << argv[1]
+ << " for writing: " << ec.message() << '\n';
+ return EXIT_FAILURE;
+ }
+
+ out.os() << llvm::format(
+ R"(
+//===-- object-sizes-generated.h --------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Generated at build time by flang-object-size-probe.
+// Do not edit; edit flang/tools/object-size-probe/object-size-probe.cpp instead.
+// Included by flang/Evaluate/object-sizes.h when present on the path.
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_EVALUATE_OBJECT_SIZES_GENERATED_H_
+#define FORTRAN_EVALUATE_OBJECT_SIZES_GENERATED_H_
+
+#include <cstddef>
+
+namespace Fortran::evaluate::value::detail {
+
+// Object size/alignment for IntegerValue / IntegerValueImpl
+inline constexpr std::size_t kIntegerObjectSize{%zu};
+inline constexpr std::size_t kIntegerObjectAlign{%zu};
+
+// Object size/alignment for RealValue / RealValueImpl
+inline constexpr std::size_t kRealObjectSize{%zu};
+inline constexpr std::size_t kRealObjectAlign{%zu};
+
+// Object size/alignment for CharacterValue / CharacterValueImpl
+inline constexpr std::size_t kCharacterObjectSize{%zu};
+inline constexpr std::size_t kCharacterObjectAlign{%zu};
+
+} // namespace Fortran::evaluate::value::detail
+#endif // FORTRAN_EVALUATE_OBJECT_SIZES_GENERATED_H_
+)",
+ sizeof(IntegerValueImpl), alignof(IntegerValueImpl),
+ sizeof(RealValueImpl), alignof(RealValueImpl), sizeof(CharacterValueImpl),
+ alignof(CharacterValueImpl));
+
+ out.keep();
+ return EXIT_SUCCESS;
+}
diff --git a/flang/unittests/CMakeLists.txt b/flang/unittests/CMakeLists.txt
index 64cd5c0446474..db83c4a98e615 100644
--- a/flang/unittests/CMakeLists.txt
+++ b/flang/unittests/CMakeLists.txt
@@ -15,6 +15,10 @@ function(add_flang_unittest test_dirname)
if (FLANG_PARALLEL_COMPILE_JOBS)
set_property(TARGET ${test_dirname} PROPERTY JOB_POOL_COMPILE flang_compile_job_pool)
endif ()
+
+ if(TARGET flang-generated-object-sizes)
+ add_dependencies(${test_dirname} flang-generated-object-sizes)
+ endif()
endfunction()
if (CXX_SUPPORTS_SUGGEST_OVERRIDE_FLAG)
@@ -53,6 +57,10 @@ function(add_flang_nongtest_unittest test_name)
if(NOT ARG_SLOW_TEST)
add_dependencies(FlangUnitTests ${test_name}${suffix})
endif()
+
+ if(TARGET flang-generated-object-sizes)
+ add_dependencies(${test_name}${suffix} flang-generated-object-sizes)
+ endif()
endfunction()
add_subdirectory(Optimizer)
diff --git a/flang/unittests/Evaluate/expression.cpp b/flang/unittests/Evaluate/expression.cpp
index d575f36def287..8d570f517bc1f 100644
--- a/flang/unittests/Evaluate/expression.cpp
+++ b/flang/unittests/Evaluate/expression.cpp
@@ -11,13 +11,17 @@
using namespace Fortran::evaluate;
+static Expr<Type<TypeCategory::Integer>> MakeDefaultIntegerExpr(int32_t v) {
+ return MakeConstantExpr<Type<TypeCategory::Integer>>(4, v);
+}
+
int main() {
- using DefaultIntegerExpr = Expr<Type<TypeCategory::Integer, 4>>;
- TEST(DefaultIntegerExpr::Result::AsFortran() == "INTEGER(4)");
- MATCH("666_4", DefaultIntegerExpr{666}.AsFortran());
- MATCH("-1_4", (-DefaultIntegerExpr{1}).AsFortran());
- auto ex1{
- DefaultIntegerExpr{2} + DefaultIntegerExpr{3} * -DefaultIntegerExpr{4}};
+ using DefaultIntegerExpr = Expr<Type<TypeCategory::Integer>>;
+ TEST(DefaultIntegerExpr::Result{4}.AsFortran() == "INTEGER(4)");
+ MATCH("666_4", MakeDefaultIntegerExpr(666).AsFortran());
+ MATCH("-1_4", (-MakeDefaultIntegerExpr(1)).AsFortran());
+ auto ex1{MakeDefaultIntegerExpr(2) +
+ MakeDefaultIntegerExpr(3) * -MakeDefaultIntegerExpr(4)};
MATCH("2_4+3_4*(-4_4)", ex1.AsFortran());
Fortran::common::IntrinsicTypeDefaultKinds defaults;
auto intrinsics{Fortran::evaluate::IntrinsicProcTable::Configure(defaults)};
@@ -28,9 +32,10 @@ int main() {
intrinsics, targetCharacteristics, languageFeatures, tempNames};
ex1 = Fold(context, std::move(ex1));
MATCH("-10_4", ex1.AsFortran());
- MATCH("1_4/2_4", (DefaultIntegerExpr{1} / DefaultIntegerExpr{2}).AsFortran());
- DefaultIntegerExpr a{1};
- DefaultIntegerExpr b{2};
+ MATCH("1_4/2_4",
+ (MakeDefaultIntegerExpr(1) / MakeDefaultIntegerExpr(2)).AsFortran());
+ DefaultIntegerExpr a{MakeDefaultIntegerExpr(1)};
+ DefaultIntegerExpr b{MakeDefaultIntegerExpr(2)};
MATCH("1_4", a.AsFortran());
a = b;
MATCH("2_4", a.AsFortran());
diff --git a/flang/unittests/Evaluate/folding.cpp b/flang/unittests/Evaluate/folding.cpp
index 832e55d44316d..31b33c51af57b 100644
--- a/flang/unittests/Evaluate/folding.cpp
+++ b/flang/unittests/Evaluate/folding.cpp
@@ -15,13 +15,19 @@ using namespace Fortran::evaluate;
template <typename... T> struct RunOnTypes {};
template <typename Test, typename... T>
struct RunOnTypes<Test, std::tuple<T...>> {
- static void Run() { (..., Test::template Run<T>()); }
+ template <typename U> static void RunOnKinds() {
+ for (int kind : KindsByType<U::category>::kinds) {
+ Test::template Run<U>(kind);
+ }
+ }
+
+ static void Run() { (..., RunOnKinds<T>()); }
};
// test for fold.h GetScalarConstantValue function
struct TestGetScalarConstantValue {
- template <typename T> static void Run() {
- Expr<T> exprFullyTyped{Constant<T>{Scalar<T>{}}};
+ template <typename T> static void Run(int kind) {
+ Expr<T> exprFullyTyped{MakeZeroExpr<T>(kind)};
Expr<SomeKind<T::category>> exprSomeKind{exprFullyTyped};
Expr<SomeType> exprSomeType{exprSomeKind};
TEST(GetScalarConstantValue<T>(exprFullyTyped).has_value());
@@ -33,13 +39,15 @@ struct TestGetScalarConstantValue {
template <typename T>
Scalar<T> CallHostRt(
HostRuntimeWrapper func, FoldingContext &context, Scalar<T> x) {
+ const int kind{x.kind()};
return GetScalarConstantValue<T>(
- func(context, {AsGenericExpr(Constant<T>{x})}))
+ func(context, {AsGenericExpr(Constant<T>{kind, x})}))
.value();
}
void TestHostRuntimeSubnormalFlushing() {
- using R4 = Type<TypeCategory::Real, 4>;
+ using R4 = host::TypeKind<TypeCategory::Real, 4>;
+ using FR4 = R4::FortranType;
if constexpr (std::is_same_v<host::HostType<R4>, float>) {
Fortran::parser::CharBlock src;
Fortran::parser::ContextualMessages messages{src, nullptr};
@@ -56,13 +64,14 @@ void TestHostRuntimeSubnormalFlushing() {
FoldingContext noFlushingContext{messages, defaults, intrinsics,
noFlushingTargetCharacteristics, languageFeatures, tempNames};
- DynamicType r4{R4{}.GetType()};
+ DynamicType r4{R4::GetType()};
// Test subnormal argument flushing
if (auto callable{GetHostRuntimeWrapper("log", r4, {r4})}) {
// Biggest IEEE 32bits subnormal power of two
- const Scalar<R4> x1{Scalar<R4>::Word{0x00400000}};
- Scalar<R4> y1Flushing{CallHostRt<R4>(*callable, flushingContext, x1)};
- Scalar<R4> y1NoFlushing{CallHostRt<R4>(*callable, noFlushingContext, x1)};
+ const Scalar<FR4> x1{4, Scalar<FR4>::Word{4, 0x00400000}};
+ Scalar<FR4> y1Flushing{CallHostRt<FR4>(*callable, flushingContext, x1)};
+ Scalar<FR4> y1NoFlushing{
+ CallHostRt<FR4>(*callable, noFlushingContext, x1)};
// We would expect y1Flushing to be NaN, but some libc logf implementation
// "workaround" subnormal flushing by returning a constant negative
// results for all subnormal values (-1.03972076416015625e2_4). In case of
diff --git a/flang/unittests/Evaluate/intrinsics.cpp b/flang/unittests/Evaluate/intrinsics.cpp
index cca2f8c30247e..1abb41ae392ac 100644
--- a/flang/unittests/Evaluate/intrinsics.cpp
+++ b/flang/unittests/Evaluate/intrinsics.cpp
@@ -44,7 +44,8 @@ class CookedStrings {
};
template <typename A> auto Const(A &&x) -> Constant<TypeOf<A>> {
- return Constant<TypeOf<A>>{std::move(x)};
+ const int kind{x.kind()};
+ return Constant<TypeOf<A>>{kind, std::move(x)};
}
template <typename A> struct NamedArg {
@@ -152,64 +153,73 @@ void TestIntrinsics() {
IntrinsicProcTable table{IntrinsicProcTable::Configure(defaults)};
table.Dump(llvm::outs());
- using Int1 = Type<TypeCategory::Integer, 1>;
- using Int4 = Type<TypeCategory::Integer, 4>;
- using Int8 = Type<TypeCategory::Integer, 8>;
- using Real4 = Type<TypeCategory::Real, 4>;
- using Real8 = Type<TypeCategory::Real, 8>;
- using Complex4 = Type<TypeCategory::Complex, 4>;
- using Complex8 = Type<TypeCategory::Complex, 8>;
- using Char = Type<TypeCategory::Character, 1>;
- using Log4 = Type<TypeCategory::Logical, 4>;
+ using Int1 = Type<TypeCategory::Integer>;
+ Int1 int1{1};
+ using Int4 = Type<TypeCategory::Integer>;
+ Int4 int4{4};
+ using Int8 = Type<TypeCategory::Integer>;
+ Int8 int8{8};
+ using Real4 = Type<TypeCategory::Real>;
+ Real4 real4{4};
+ using Real8 = Type<TypeCategory::Real>;
+ Real8 real8{8};
+ using Complex4 = Type<TypeCategory::Complex>;
+ Complex4 complex4{4};
+ using Complex8 = Type<TypeCategory::Complex>;
+ Complex8 complex8{8};
+ using Char = Type<TypeCategory::Character>;
+ Char ascii{1};
+ using Log4 = Type<TypeCategory::Logical>;
+ Log4 log4{4};
TestCall{defaults, table, "bad"}
- .Push(Const(Scalar<Int4>{}))
+ .Push(Const(Scalar<Int4>::Zero(4)))
.DoCall(); // bad intrinsic name
TestCall{defaults, table, "abs"}
- .Push(Named("a", Const(Scalar<Int4>{})))
- .DoCall(Int4::GetType());
+ .Push(Named("a", Const(Scalar<Int4>::Zero(4))))
+ .DoCall(int4.GetType());
TestCall{defaults, table, "abs"}
- .Push(Const(Scalar<Int4>{}))
- .DoCall(Int4::GetType());
+ .Push(Const(Scalar<Int4>::Zero(4)))
+ .DoCall(int4.GetType());
TestCall{defaults, table, "abs"}
- .Push(Named("bad", Const(Scalar<Int4>{})))
+ .Push(Named("bad", Const(Scalar<Int4>::Zero(4))))
.DoCall(); // bad keyword
TestCall{defaults, table, "abs"}.DoCall(); // insufficient args
TestCall{defaults, table, "abs"}
- .Push(Const(Scalar<Int4>{}))
- .Push(Const(Scalar<Int4>{}))
+ .Push(Const(Scalar<Int4>::Zero(4)))
+ .Push(Const(Scalar<Int4>::Zero(4)))
.DoCall(); // too many args
TestCall{defaults, table, "abs"}
- .Push(Const(Scalar<Int4>{}))
- .Push(Named("a", Const(Scalar<Int4>{})))
+ .Push(Const(Scalar<Int4>::Zero(4)))
+ .Push(Named("a", Const(Scalar<Int4>::Zero(4))))
.DoCall();
TestCall{defaults, table, "abs"}
- .Push(Named("a", Const(Scalar<Int4>{})))
- .Push(Const(Scalar<Int4>{}))
+ .Push(Named("a", Const(Scalar<Int4>::Zero(4))))
+ .Push(Const(Scalar<Int4>::Zero(4)))
.DoCall();
TestCall{defaults, table, "abs"}
- .Push(Const(Scalar<Int1>{}))
- .DoCall(Int1::GetType());
+ .Push(Const(Scalar<Int1>::Zero(1)))
+ .DoCall(int1.GetType());
TestCall{defaults, table, "abs"}
- .Push(Const(Scalar<Int4>{}))
- .DoCall(Int4::GetType());
+ .Push(Const(Scalar<Int4>::Zero(4)))
+ .DoCall(int4.GetType());
TestCall{defaults, table, "abs"}
- .Push(Const(Scalar<Int8>{}))
- .DoCall(Int8::GetType());
+ .Push(Const(Scalar<Int8>::Zero(8)))
+ .DoCall(int8.GetType());
TestCall{defaults, table, "abs"}
- .Push(Const(Scalar<Real4>{}))
- .DoCall(Real4::GetType());
+ .Push(Const(Scalar<Real4>::Zero(4)))
+ .DoCall(real4.GetType());
TestCall{defaults, table, "abs"}
- .Push(Const(Scalar<Real8>{}))
- .DoCall(Real8::GetType());
+ .Push(Const(Scalar<Real8>::Zero(8)))
+ .DoCall(real8.GetType());
TestCall{defaults, table, "abs"}
- .Push(Const(Scalar<Complex4>{}))
- .DoCall(Real4::GetType());
+ .Push(Const(Scalar<Complex4>::Zero(4)))
+ .DoCall(real4.GetType());
TestCall{defaults, table, "abs"}
- .Push(Const(Scalar<Complex8>{}))
- .DoCall(Real8::GetType());
- TestCall{defaults, table, "abs"}.Push(Const(Scalar<Char>{})).DoCall();
- TestCall{defaults, table, "abs"}.Push(Const(Scalar<Log4>{})).DoCall();
+ .Push(Const(Scalar<Complex8>::Zero(8)))
+ .DoCall(real8.GetType());
+ TestCall{defaults, table, "abs"}.Push(Const(Scalar<Char>::Zero(1))).DoCall();
+ TestCall{defaults, table, "abs"}.Push(Const(Scalar<Log4>::Zero(4))).DoCall();
// "Ext" in names for calls allowed as extensions
TestCall maxCallR{defaults, table, "max"}, maxCallI{defaults, table, "min"},
@@ -218,110 +228,114 @@ void TestIntrinsics() {
max0ExtCall{defaults, table, "max0"},
amin1ExtCall{defaults, table, "amin1"};
for (int j{0}; j < 10; ++j) {
- maxCallR.Push(Const(Scalar<Real4>{}));
- maxCallI.Push(Const(Scalar<Int4>{}));
- max0Call.Push(Const(Scalar<Int4>{}));
- max0ExtCall.Push(Const(Scalar<Real4>{}));
- max1Call.Push(Const(Scalar<Real4>{}));
- amin0Call.Push(Const(Scalar<Int4>{}));
- amin1ExtCall.Push(Const(Scalar<Int4>{}));
- amin1Call.Push(Const(Scalar<Real4>{}));
+ maxCallR.Push(Const(Scalar<Real4>::Zero(4)));
+ maxCallI.Push(Const(Scalar<Int4>::Zero(4)));
+ max0Call.Push(Const(Scalar<Int4>::Zero(4)));
+ max0ExtCall.Push(Const(Scalar<Real4>::Zero(4)));
+ max1Call.Push(Const(Scalar<Real4>::Zero(4)));
+ amin0Call.Push(Const(Scalar<Int4>::Zero(4)));
+ amin1ExtCall.Push(Const(Scalar<Int4>::Zero(4)));
+ amin1Call.Push(Const(Scalar<Real4>::Zero(4)));
}
- maxCallR.DoCall(Real4::GetType());
- maxCallI.DoCall(Int4::GetType());
- max0Call.DoCall(Int4::GetType());
- max0ExtCall.DoCall(Int4::GetType());
- max1Call.DoCall(Int4::GetType());
- amin0Call.DoCall(Real4::GetType());
- amin1Call.DoCall(Real4::GetType());
- amin1ExtCall.DoCall(Real4::GetType());
+ maxCallR.DoCall(real4.GetType());
+ maxCallI.DoCall(int4.GetType());
+ max0Call.DoCall(int4.GetType());
+ max0ExtCall.DoCall(int4.GetType());
+ max1Call.DoCall(int4.GetType());
+ amin0Call.DoCall(real4.GetType());
+ amin1Call.DoCall(real4.GetType());
+ amin1ExtCall.DoCall(real4.GetType());
TestCall{defaults, table, "conjg"}
- .Push(Const(Scalar<Complex4>{}))
- .DoCall(Complex4::GetType());
+ .Push(Const(Scalar<Complex4>::Zero(4)))
+ .DoCall(complex4.GetType());
TestCall{defaults, table, "conjg"}
- .Push(Const(Scalar<Complex8>{}))
- .DoCall(Complex8::GetType());
+ .Push(Const(Scalar<Complex8>::Zero(8)))
+ .DoCall(complex8.GetType());
TestCall{defaults, table, "dconjg"}
- .Push(Const(Scalar<Complex8>{}))
- .DoCall(Complex8::GetType());
+ .Push(Const(Scalar<Complex8>::Zero(8)))
+ .DoCall(complex8.GetType());
- TestCall{defaults, table, "float"}.Push(Const(Scalar<Real4>{})).DoCall();
TestCall{defaults, table, "float"}
- .Push(Const(Scalar<Int4>{}))
- .DoCall(Real4::GetType());
- TestCall{defaults, table, "idint"}.Push(Const(Scalar<Int4>{})).DoCall();
+ .Push(Const(Scalar<Real4>::Zero(4)))
+ .DoCall();
+ TestCall{defaults, table, "float"}
+ .Push(Const(Scalar<Int4>::Zero(4)))
+ .DoCall(real4.GetType());
+ TestCall{defaults, table, "idint"}
+ .Push(Const(Scalar<Int4>::Zero(4)))
+ .DoCall();
TestCall{defaults, table, "idint"}
- .Push(Const(Scalar<Real8>{}))
- .DoCall(Int4::GetType());
+ .Push(Const(Scalar<Real8>::Zero(8)))
+ .DoCall(int4.GetType());
// Allowed as extensions
TestCall{defaults, table, "float"}
- .Push(Const(Scalar<Int8>{}))
- .DoCall(Real4::GetType());
+ .Push(Const(Scalar<Int8>::Zero(8)))
+ .DoCall(real4.GetType());
TestCall{defaults, table, "idint"}
- .Push(Const(Scalar<Real4>{}))
- .DoCall(Int4::GetType());
+ .Push(Const(Scalar<Real4>::Zero(4)))
+ .DoCall(int4.GetType());
- TestCall{defaults, table, "num_images"}.DoCall(Int4::GetType());
+ TestCall{defaults, table, "num_images"}.DoCall(int4.GetType());
TestCall{defaults, table, "num_images"}
- .Push(Const(Scalar<Int1>{}))
- .DoCall(Int4::GetType());
+ .Push(Const(Scalar<Int1>::Zero(1)))
+ .DoCall(int4.GetType());
TestCall{defaults, table, "num_images"}
- .Push(Const(Scalar<Int4>{}))
- .DoCall(Int4::GetType());
+ .Push(Const(Scalar<Int4>::Zero(4)))
+ .DoCall(int4.GetType());
TestCall{defaults, table, "num_images"}
- .Push(Const(Scalar<Int8>{}))
- .DoCall(Int4::GetType());
+ .Push(Const(Scalar<Int8>::Zero(8)))
+ .DoCall(int4.GetType());
TestCall{defaults, table, "num_images"}
- .Push(Named("team_number", Const(Scalar<Int4>{})))
- .DoCall(Int4::GetType());
+ .Push(Named("team_number", Const(Scalar<Int4>::Zero(4))))
+ .DoCall(int4.GetType());
TestCall{defaults, table, "num_images"}
- .Push(Const(Scalar<Int4>{}))
- .Push(Const(Scalar<Int4>{}))
+ .Push(Const(Scalar<Int4>::Zero(4)))
+ .Push(Const(Scalar<Int4>::Zero(4)))
.DoCall(); // too many args
TestCall{defaults, table, "num_images"}
- .Push(Named("bad", Const(Scalar<Int4>{})))
+ .Push(Named("bad", Const(Scalar<Int4>::Zero(4))))
.DoCall(); // bad keyword
TestCall{defaults, table, "num_images"}
- .Push(Const(Scalar<Char>{}))
+ .Push(Const(Scalar<Char>::Zero(1)))
.DoCall(); // bad type
TestCall{defaults, table, "num_images"}
- .Push(Const(Scalar<Log4>{}))
+ .Push(Const(Scalar<Log4>::Zero(4)))
.DoCall(); // bad type
TestCall{defaults, table, "num_images"}
- .Push(Const(Scalar<Complex8>{}))
+ .Push(Const(Scalar<Complex8>::Zero(8)))
.DoCall(); // bad type
TestCall{defaults, table, "num_images"}
- .Push(Const(Scalar<Real4>{}))
+ .Push(Const(Scalar<Real4>::Zero(4)))
.DoCall(); // bad type
// This test temporarily removed because it requires access to
// the ISO_FORTRAN_ENV intrinsic module. This module should to
// be loaded (somehow) and the following test reinstated.
- // TestCall{defaults, table, "team_number"}.DoCall(Int4::GetType());
+ // TestCall{defaults, table, "team_number"}.DoCall(int4.GetType());
TestCall{defaults, table, "team_number"}
- .Push(Const(Scalar<Int4>{}))
- .Push(Const(Scalar<Int4>{}))
+ .Push(Const(Scalar<Int4>::Zero(4)))
+ .Push(Const(Scalar<Int4>::Zero(4)))
.DoCall(); // too many args
TestCall{defaults, table, "team_number"}
- .Push(Named("bad", Const(Scalar<Int4>{})))
+ .Push(Named("bad", Const(Scalar<Int4>::Zero(4))))
.DoCall(); // bad keyword
TestCall{defaults, table, "team_number"}
- .Push(Const(Scalar<Int4>{}))
+ .Push(Const(Scalar<Int4>::Zero(4)))
.DoCall(); // bad type
TestCall{defaults, table, "team_number"}
- .Push(Const(Scalar<Char>{}))
+ .Push(Const(Scalar<Char>::Zero(1)))
.DoCall(); // bad type
TestCall{defaults, table, "team_number"}
- .Push(Const(Scalar<Log4>{}))
+ .Push(Const(Scalar<Log4>::Zero(4)))
.DoCall(); // bad type
TestCall{defaults, table, "team_number"}
- .Push(Const(Scalar<Complex8>{}))
+ .Push(Const(Scalar<Complex8>::Zero(4)))
.DoCall(); // bad type
TestCall{defaults, table, "team_number"}
- .Push(Const(Scalar<Real4>{}))
+ .Push(Const(Scalar<Real4>::Zero(4)))
.DoCall(); // bad type
// TODO: test other intrinsics
diff --git a/flang/unittests/Evaluate/logical.cpp b/flang/unittests/Evaluate/logical.cpp
index ba7d0d8d0c0e3..c8bf850d6c08e 100644
--- a/flang/unittests/Evaluate/logical.cpp
+++ b/flang/unittests/Evaluate/logical.cpp
@@ -2,41 +2,40 @@
#include "flang/Testing/testing.h"
#include <cstdio>
-template <int KIND> void testKind() {
- using Type =
- Fortran::evaluate::Type<Fortran::common::TypeCategory::Logical, KIND>;
+static void testKind(int kind) {
+ using Type = Fortran::evaluate::Type<Fortran::common::TypeCategory::Logical>;
TEST(Fortran::evaluate::IsSpecificIntrinsicType<Type>);
TEST(Type::category == Fortran::common::TypeCategory::Logical);
- TEST(Type::kind == KIND);
+ TEST(Type{kind}.kind() == kind);
using Value = Fortran::evaluate::Scalar<Type>;
- MATCH(8 * KIND, Value::bits);
+ MATCH(8 * kind, Value::Zero(kind).bits());
TEST(!Value{}.IsTrue());
- TEST(!Value{false}.IsTrue());
- TEST(Value{true}.IsTrue());
- TEST(Value{false}.NOT().IsTrue());
- TEST(!Value{true}.NOT().IsTrue());
- TEST(!Value{false}.AND(Value{false}).IsTrue());
- TEST(!Value{false}.AND(Value{true}).IsTrue());
- TEST(!Value{true}.AND(Value{false}).IsTrue());
- TEST(Value{true}.AND(Value{true}).IsTrue());
- TEST(!Value{false}.OR(Value{false}).IsTrue());
- TEST(Value{false}.OR(Value{true}).IsTrue());
- TEST(Value{true}.OR(Value{false}).IsTrue());
- TEST(Value{true}.OR(Value{true}).IsTrue());
- TEST(Value{false}.EQV(Value{false}).IsTrue());
- TEST(!Value{false}.EQV(Value{true}).IsTrue());
- TEST(!Value{true}.EQV(Value{false}).IsTrue());
- TEST(Value{true}.EQV(Value{true}).IsTrue());
- TEST(!Value{false}.NEQV(Value{false}).IsTrue());
- TEST(Value{false}.NEQV(Value{true}).IsTrue());
- TEST(Value{true}.NEQV(Value{false}).IsTrue());
- TEST(!Value{true}.NEQV(Value{true}).IsTrue());
+ TEST(!Value(kind, false).IsTrue());
+ TEST(Value(kind, true).IsTrue());
+ TEST(Value(kind, false).NOT().IsTrue());
+ TEST(!Value(kind, true).NOT().IsTrue());
+ TEST(!Value(kind, false).AND(Value(kind, false)).IsTrue());
+ TEST(!Value(kind, false).AND(Value(kind, true)).IsTrue());
+ TEST(!Value(kind, true).AND(Value(kind, false)).IsTrue());
+ TEST(Value(kind, true).AND(Value(kind, true)).IsTrue());
+ TEST(!Value(kind, false).OR(Value(kind, false)).IsTrue());
+ TEST(Value(kind, false).OR(Value(kind, true)).IsTrue());
+ TEST(Value(kind, true).OR(Value(kind, false)).IsTrue());
+ TEST(Value(kind, true).OR(Value(kind, true)).IsTrue());
+ TEST(Value(kind, false).EQV(Value(kind, false)).IsTrue());
+ TEST(!Value(kind, false).EQV(Value(kind, true)).IsTrue());
+ TEST(!Value(kind, true).EQV(Value(kind, false)).IsTrue());
+ TEST(Value(kind, true).EQV(Value(kind, true)).IsTrue());
+ TEST(!Value(kind, false).NEQV(Value(kind, false)).IsTrue());
+ TEST(Value(kind, false).NEQV(Value(kind, true)).IsTrue());
+ TEST(Value(kind, true).NEQV(Value(kind, false)).IsTrue());
+ TEST(!Value(kind, true).NEQV(Value(kind, true)).IsTrue());
}
int main() {
- testKind<1>();
- testKind<2>();
- testKind<4>();
- testKind<8>();
+ testKind(1);
+ testKind(2);
+ testKind(4);
+ testKind(8);
return testing::Complete();
}
diff --git a/flang/unittests/Evaluate/real.cpp b/flang/unittests/Evaluate/real.cpp
index a28da5c3273ce..9599303b6b566 100644
--- a/flang/unittests/Evaluate/real.cpp
+++ b/flang/unittests/Evaluate/real.cpp
@@ -1,3 +1,4 @@
+#include "flang/Evaluate/real.h"
#include "flang/Evaluate/type.h"
#include "flang/Testing/fp-testing.h"
#include "flang/Testing/testing.h"
@@ -10,16 +11,16 @@
using namespace Fortran::evaluate;
using namespace Fortran::common;
-using Real2 = Scalar<Type<TypeCategory::Real, 2>>;
-using Real3 = Scalar<Type<TypeCategory::Real, 3>>;
-using Real4 = Scalar<Type<TypeCategory::Real, 4>>;
-using Real8 = Scalar<Type<TypeCategory::Real, 8>>;
+using Real2 = value::Real<value::Integer<16>, 11>;
+using Real3 = value::Real<value::Integer<16>, 8>;
+using Real4 = value::Real<value::Integer<32>, 24>;
+using Real8 = value::Real<value::Integer<64>, 53>;
#ifdef __x86_64__
-using Real10 = Scalar<Type<TypeCategory::Real, 10>>;
+using Real10 = value::Real<value::X87IntegerContainer, 64>;
#endif
-using Real16 = Scalar<Type<TypeCategory::Real, 16>>;
-using Integer4 = Scalar<Type<TypeCategory::Integer, 4>>;
-using Integer8 = Scalar<Type<TypeCategory::Integer, 8>>;
+using Real16 = value::Real<value::Integer<128>, 113>;
+using Integer4 = value::Integer<32>;
+using Integer8 = value::Integer<64>;
void dumpTest() {
struct {
>From 373bbaf6cd5bbc304ed67a5f73fe31b48b748c56 Mon Sep 17 00:00:00 2001
From: Michael Kruse <llvm-project at meinersbur.de>
Date: Tue, 11 Aug 2026 09:42:54 +0200
Subject: [PATCH 2/9] Fix (unrealted) Werror fail
---
flang/lib/Lower/ConvertType.cpp | 2 +-
flang/unittests/Evaluate/intrinsics.cpp | 2 --
2 files changed, 1 insertion(+), 3 deletions(-)
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 7dd56a41354e8..a2c10f0bd821f 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -489,7 +489,7 @@ struct TypeBuilderImpl {
converter.getFoldingContext(),
Fortran::evaluate::Expr<TC>{
Fortran::evaluate::Designator<TC>{kind, symbol}});
- if (auto len = toInt64(std::move(designator.LEN())))
+ if (auto len = toInt64(designator.LEN()))
return *len;
return fir::SequenceType::getUnknownExtent();
}
diff --git a/flang/unittests/Evaluate/intrinsics.cpp b/flang/unittests/Evaluate/intrinsics.cpp
index 1abb41ae392ac..69c8aa4246950 100644
--- a/flang/unittests/Evaluate/intrinsics.cpp
+++ b/flang/unittests/Evaluate/intrinsics.cpp
@@ -168,9 +168,7 @@ void TestIntrinsics() {
using Complex8 = Type<TypeCategory::Complex>;
Complex8 complex8{8};
using Char = Type<TypeCategory::Character>;
- Char ascii{1};
using Log4 = Type<TypeCategory::Logical>;
- Log4 log4{4};
TestCall{defaults, table, "bad"}
.Push(Const(Scalar<Int4>::Zero(4)))
>From 7922bd0fd52f3d074ffe81c9b79608a7963c953a Mon Sep 17 00:00:00 2001
From: Michael Kruse <llvm-project at meinersbur.de>
Date: Tue, 11 Aug 2026 10:17:38 +0200
Subject: [PATCH 3/9] Don't require exact fp fold
---
flang/test/Evaluate/fold-real10-storage-size.f90 | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/test/Evaluate/fold-real10-storage-size.f90 b/flang/test/Evaluate/fold-real10-storage-size.f90
index 6def77bd9fa06..c3df93a96eb04 100644
--- a/flang/test/Evaluate/fold-real10-storage-size.f90
+++ b/flang/test/Evaluate/fold-real10-storage-size.f90
@@ -38,4 +38,4 @@ subroutine host_folding
print *, s, e
end subroutine
! CHECK-LABEL: SUBROUTINE host_folding
-! CHECK: PRINT *, 8.414709848078965048756572286947630345821380615234375e-1_10, 2.718281828459045090795598298427648842334747314453125_10
+! CHECK: PRINT *, 8.4{{[0-9]*}}e-1_10, 2.7{{[0-9]*}}_10
>From d061f299e12c33a1b6f68e300ae2f9529a94f9c9 Mon Sep 17 00:00:00 2001
From: Michael Kruse <llvm-project at meinersbur.de>
Date: Tue, 11 Aug 2026 10:56:27 +0200
Subject: [PATCH 4/9] Exclude Windows from folding test
---
flang/test/Evaluate/fold-real10-storage-size.f90 | 1 +
1 file changed, 1 insertion(+)
diff --git a/flang/test/Evaluate/fold-real10-storage-size.f90 b/flang/test/Evaluate/fold-real10-storage-size.f90
index c3df93a96eb04..851b613dbff41 100644
--- a/flang/test/Evaluate/fold-real10-storage-size.f90
+++ b/flang/test/Evaluate/fold-real10-storage-size.f90
@@ -1,5 +1,6 @@
! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
! REQUIRES: target=x86_64{{.*}}
+! UNSUPPORTED: system-windows
! REAL(10) is the x87 extended format: 80 significant bits held in a 16-byte
! container, so its raw bits occupy 16 bytes rather than 10. Constant
>From ff8958e14dbcc6c8add13b38b347960cedb153b9 Mon Sep 17 00:00:00 2001
From: Michael Kruse <llvm-project at meinersbur.de>
Date: Sun, 16 Aug 2026 16:37:40 +0200
Subject: [PATCH 5/9] WIP
---
flang/include/flang/Evaluate/character-value.h | 1 +
1 file changed, 1 insertion(+)
diff --git a/flang/include/flang/Evaluate/character-value.h b/flang/include/flang/Evaluate/character-value.h
index aff74cf8a5cb1..27a88bc58247e 100644
--- a/flang/include/flang/Evaluate/character-value.h
+++ b/flang/include/flang/Evaluate/character-value.h
@@ -11,6 +11,7 @@
#include "flang/Evaluate/common.h"
#include "flang/Evaluate/object-sizes.h"
+#include "llvm/Support/Compiler.h"
#include <cstddef>
#include <iosfwd>
#include <optional>
>From e5ba9bb373e327672f26c1f35d33204836817429 Mon Sep 17 00:00:00 2001
From: Michael Kruse <llvm-project at meinersbur.de>
Date: Mon, 17 Aug 2026 18:03:54 +0200
Subject: [PATCH 6/9] Fix kind/value swap
---
flang/lib/Evaluate/fold-implementation.h | 4 ++--
flang/test/Semantics/modfile86.f90 | 18 ++++++++++++++++++
2 files changed, 20 insertions(+), 2 deletions(-)
create mode 100644 flang/test/Semantics/modfile86.f90
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index f694a826a2496..24e68fb3e74cd 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -2309,8 +2309,8 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) {
using IntType = typename T::Scalar::Word;
auto intNumerator{folded->first.ToInteger()};
isCanonicalNaNOrInf = intNumerator.flags == RealFlags{} &&
- intNumerator.value >= IntType{-1, 16} &&
- intNumerator.value <= IntType{1, 16};
+ intNumerator.value >= IntType{16, -1} &&
+ intNumerator.value <= IntType{16, 1};
}
}
if (!isCanonicalNaNOrInf) {
diff --git a/flang/test/Semantics/modfile86.f90 b/flang/test/Semantics/modfile86.f90
new file mode 100644
index 0000000000000..178ab436401c8
--- /dev/null
+++ b/flang/test/Semantics/modfile86.f90
@@ -0,0 +1,18 @@
+! RUN: split-file %s %t
+! RUN: %flang_fc1 -fsyntax-only -module-dir %t %t/m.f90
+! RUN: %flang_fc1 -fsyntax-only -Werror -module-dir %t %t/use.f90
+
+! Ensure that canonical representations of infinities and NaNs in module files
+! can be read without emitting folding exception warnings.
+
+!--- m.f90
+module m
+ real(4), parameter :: positive_infinity = z'7f800000'
+ real(4), parameter :: negative_infinity = z'ff800000'
+ real(4), parameter :: quiet_nan = z'7fc00000'
+end module
+
+!--- use.f90
+program test
+ use m
+end program
>From 4bd50876ddde2ecee693fe62061a75bc193c73d3 Mon Sep 17 00:00:00 2001
From: Michael Kruse <llvm-project at meinersbur.de>
Date: Mon, 17 Aug 2026 18:06:31 +0200
Subject: [PATCH 7/9] Check for kind
---
flang/include/flang/Evaluate/expression.h | 1 +
1 file changed, 1 insertion(+)
diff --git a/flang/include/flang/Evaluate/expression.h b/flang/include/flang/Evaluate/expression.h
index ba8f2b744bd9c..a7818eb796328 100644
--- a/flang/include/flang/Evaluate/expression.h
+++ b/flang/include/flang/Evaluate/expression.h
@@ -202,6 +202,7 @@ class Operation {
static constexpr int Corank() { return 0; }
bool operator==(const Operation &that) const {
+ CHECK(kind() == that.kind());
return operand_ == that.operand_;
}
>From 470834d30ac2502b029188bc0df1de4f1b979acf Mon Sep 17 00:00:00 2001
From: Michael Kruse <llvm-project at meinersbur.de>
Date: Mon, 17 Aug 2026 18:11:15 +0200
Subject: [PATCH 8/9] Backport CharacterValueImpl::FromRawBytes
---
flang/lib/Evaluate/character-value-impl.cpp | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/flang/lib/Evaluate/character-value-impl.cpp b/flang/lib/Evaluate/character-value-impl.cpp
index dfac05b1b8aae..e9b69c8d969d6 100644
--- a/flang/lib/Evaluate/character-value-impl.cpp
+++ b/flang/lib/Evaluate/character-value-impl.cpp
@@ -31,11 +31,12 @@ CharacterValueImpl CharacterValueImpl::Zero(int kind) {
CharacterValueImpl CharacterValueImpl::FromRawBytes(
int kind, const void *raw, size_t byteSize) {
- return withCharProto(kind, [kind, raw, byteSize](auto charProto) {
+ return withCharProto(kind, [kind, raw, size](auto charProto) {
using CharT = decltype(charProto);
+ CHECK(size % sizeof(CharT) == 0);
std::basic_string<CharT> s;
- if (byteSize > 0) {
- s.assign(static_cast<const CharT *>(raw), byteSize);
+ if (size > 0) {
+ s.assign(static_cast<const CharT *>(raw), size / sizeof(CharT));
}
return CharacterValueImpl{kind, std::move(s)};
});
>From fea302e42506f96316bfa59aaa3b64736c1ea92f Mon Sep 17 00:00:00 2001
From: Michael Kruse <llvm-project at meinersbur.de>
Date: Tue, 18 Aug 2026 09:47:46 +0200
Subject: [PATCH 9/9] Compare KIND in operator==
---
flang/include/flang/Evaluate/expression.h | 8 ++++++--
flang/lib/Evaluate/expression.cpp | 20 ++++++++++----------
flang/lib/Evaluate/real-value-impl.cpp | 2 +-
flang/lib/Lower/Support/Utils.cpp | 2 +-
4 files changed, 18 insertions(+), 14 deletions(-)
diff --git a/flang/include/flang/Evaluate/expression.h b/flang/include/flang/Evaluate/expression.h
index a7818eb796328..be7fa33738257 100644
--- a/flang/include/flang/Evaluate/expression.h
+++ b/flang/include/flang/Evaluate/expression.h
@@ -202,8 +202,7 @@ class Operation {
static constexpr int Corank() { return 0; }
bool operator==(const Operation &that) const {
- CHECK(kind() == that.kind());
- return operand_ == that.operand_;
+ return kind() == that.kind() && operand_ == that.operand_;
}
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
@@ -923,6 +922,11 @@ class Expr<SomeKind<CAT>> : public ExpressionBase<SomeKind<CAT>> {
public:
using Result = SomeKind<CAT>;
EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
+
+ int kind() const {
+ return common::visit([](auto v) -> int { return v.kind(); }, u);
+ }
+
common::MapTemplate<evaluate::Expr, CategoryTypes<CAT>> u;
};
diff --git a/flang/lib/Evaluate/expression.cpp b/flang/lib/Evaluate/expression.cpp
index d341320658e24..e8279bb288588 100644
--- a/flang/lib/Evaluate/expression.cpp
+++ b/flang/lib/Evaluate/expression.cpp
@@ -228,49 +228,49 @@ bool StructureConstructor::operator==(const StructureConstructor &that) const {
bool Expr<Type<TypeCategory::Integer>>::operator==(
const Expr<Type<TypeCategory::Integer>> &that) const {
- return u == that.u;
+ return kind() == that.kind() && u == that.u;
}
bool Expr<Type<TypeCategory::Real>>::operator==(
const Expr<Type<TypeCategory::Real>> &that) const {
- return u == that.u;
+ return kind() == that.kind() && u == that.u;
}
bool Expr<Type<TypeCategory::Complex>>::operator==(
const Expr<Type<TypeCategory::Complex>> &that) const {
- return u == that.u;
+ return kind() == that.kind() && u == that.u;
}
bool Expr<Type<TypeCategory::Logical>>::operator==(
const Expr<Type<TypeCategory::Logical>> &that) const {
- return u == that.u;
+ return kind() == that.kind() && u == that.u;
}
bool Expr<Type<TypeCategory::Character>>::operator==(
const Expr<Type<TypeCategory::Character>> &that) const {
- return u == that.u;
+ return kind() == that.kind() && u == that.u;
}
bool Expr<Type<TypeCategory::Unsigned>>::operator==(
const Expr<Type<TypeCategory::Unsigned>> &that) const {
- return u == that.u;
+ return kind() == that.kind() && u == that.u;
}
template <TypeCategory CAT>
bool Expr<SomeKind<CAT>>::operator==(const Expr<SomeKind<CAT>> &that) const {
- return u == that.u;
+ return kind() == that.kind() && u == that.u;
}
bool Expr<SomeDerived>::operator==(const Expr<SomeDerived> &that) const {
- return u == that.u;
+ return kind() == that.kind() && u == that.u;
}
bool Expr<SomeCharacter>::operator==(const Expr<SomeCharacter> &that) const {
- return u == that.u;
+ return kind() == that.kind() && u == that.u;
}
bool Expr<SomeType>::operator==(const Expr<SomeType> &that) const {
- return u == that.u;
+ return kind() == that.kind() && u == that.u;
}
DynamicType StructureConstructor::GetType() const { return result_.GetType(); }
diff --git a/flang/lib/Evaluate/real-value-impl.cpp b/flang/lib/Evaluate/real-value-impl.cpp
index 1d55445b7b2ac..738f461af2d88 100644
--- a/flang/lib/Evaluate/real-value-impl.cpp
+++ b/flang/lib/Evaluate/real-value-impl.cpp
@@ -9,8 +9,8 @@
#include "real-value-impl.h"
#include "integer-value-impl.h"
#include "flang/Common/idioms.h"
-#include "flang/Evaluate/integer-value.h"
#include "flang/Decimal/decimal.h"
+#include "flang/Evaluate/integer-value.h"
#include "flang/Evaluate/real-value.h"
#include "flang/Evaluate/rounding-bits.h"
#include "llvm/Support/raw_ostream.h"
diff --git a/flang/lib/Lower/Support/Utils.cpp b/flang/lib/Lower/Support/Utils.cpp
index be139d5fc775b..b54bb9b3886dd 100644
--- a/flang/lib/Lower/Support/Utils.cpp
+++ b/flang/lib/Lower/Support/Utils.cpp
@@ -289,7 +289,7 @@ class HashEvaluateExpr {
}
static unsigned
getHashValue(const Fortran::evaluate::value::IntegerValue &x) {
- return static_cast<unsigned>(x.ToSInt());
+ return static_cast<unsigned>(x.ToInt64());
}
static unsigned getHashValue(const Fortran::evaluate::NullPointer &x) {
return ~179u;
More information about the llvm-branch-commits
mailing list