[flang-commits] [flang] [Flang] KIND De-Templatization (PR #206907)
Michael Kruse via flang-commits
flang-commits at lists.llvm.org
Tue Aug 11 01:18:17 PDT 2026
https://github.com/Meinersbur updated https://github.com/llvm/llvm-project/pull/206907
>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/3] [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/3] 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/3] 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
More information about the flang-commits
mailing list