[clang] [flang] [flang] Add UNSIGNED (PR #113504)
Peter Klausler via cfe-commits
cfe-commits at lists.llvm.org
Wed Oct 23 16:21:21 PDT 2024
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/113504
>From 6ad90f1a66f77ce38fb0977b82f3aff47a1c6d25 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 16 Oct 2024 14:12:09 -0700
Subject: [PATCH 1/2] [flang] Add UNSIGNED
Implement the UNSIGNED extension type and operations under control
of a language feature flag (-funsigned).
This is nearly identical to the UNSIGNED feature that has been
available in Sun Fortran for years, and now implemented in GNU
Fortran for gfortran 15, and proposed for ISO standardization
in J3/24-116.txt.
See the new documentation for details; but in short, this is C's
unsigned type, with guaranteed modular arithmetic for +, -, and *,
and the related transformational intrinsic functions SUM & al.
More tests to come.
---
clang/include/clang/Driver/Options.td | 1 +
clang/lib/Driver/ToolChains/Flang.cpp | 3 +-
flang/docs/Extensions.md | 1 +
flang/docs/Unsigned.md | 109 +++
flang/include/flang/Common/Fortran-features.h | 2 +-
flang/include/flang/Common/Fortran.h | 9 +-
flang/include/flang/Evaluate/expression.h | 47 +-
flang/include/flang/Evaluate/integer.h | 11 +-
flang/include/flang/Evaluate/tools.h | 10 +-
flang/include/flang/Evaluate/type.h | 40 +-
flang/include/flang/ISO_Fortran_binding.h | 7 +-
.../Optimizer/Builder/Runtime/RTBuilder.h | 74 ++
.../include/flang/Optimizer/Dialect/FIROps.td | 5 +-
.../flang/Optimizer/Dialect/FIRTypes.td | 19 +-
flang/include/flang/Optimizer/Support/Utils.h | 20 +-
flang/include/flang/Parser/dump-parse-tree.h | 4 +-
flang/include/flang/Parser/parse-tree.h | 20 +-
flang/include/flang/Runtime/cpp-type.h | 4 +
flang/include/flang/Runtime/numeric.h | 2 +-
flang/include/flang/Runtime/reduce.h | 83 ++
flang/include/flang/Runtime/reduction.h | 93 +++
flang/include/flang/Semantics/expression.h | 5 +-
flang/lib/Common/default-kinds.cpp | 1 +
flang/lib/Evaluate/expression.cpp | 6 +
flang/lib/Evaluate/fold-implementation.h | 33 +
flang/lib/Evaluate/fold-integer.cpp | 734 ++++++++++--------
flang/lib/Evaluate/fold-logical.cpp | 4 +
flang/lib/Evaluate/fold-matmul.h | 4 +-
flang/lib/Evaluate/fold-reduction.h | 19 +-
flang/lib/Evaluate/formatting.cpp | 9 +-
flang/lib/Evaluate/intrinsics.cpp | 188 +++--
flang/lib/Evaluate/target.cpp | 2 +
flang/lib/Evaluate/tools.cpp | 54 +-
flang/lib/Evaluate/type.cpp | 9 +
flang/lib/Frontend/CompilerInvocation.cpp | 6 +
flang/lib/Lower/ConvertConstant.cpp | 16 +-
flang/lib/Lower/ConvertExpr.cpp | 128 ++-
flang/lib/Lower/ConvertExprToHLFIR.cpp | 86 +-
flang/lib/Lower/ConvertType.cpp | 8 +-
flang/lib/Lower/IO.cpp | 30 +-
flang/lib/Lower/Mangler.cpp | 2 +
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 4 +
.../Optimizer/Builder/Runtime/Reduction.cpp | 191 +++++
flang/lib/Optimizer/Dialect/FIRType.cpp | 53 +-
flang/lib/Parser/Fortran-parsers.cpp | 25 +-
flang/lib/Parser/type-parsers.h | 1 +
flang/lib/Semantics/check-arithmeticif.cpp | 3 +
flang/lib/Semantics/check-case.cpp | 8 +-
flang/lib/Semantics/expression.cpp | 79 +-
flang/lib/Semantics/resolve-names.cpp | 6 +
flang/lib/Semantics/scope.cpp | 1 +
flang/lib/Semantics/tools.cpp | 4 +-
flang/module/iso_c_binding.f90 | 29 +
flang/module/iso_fortran_env.f90 | 3 +
flang/module/iso_fortran_env_impl.f90 | 30 +
flang/runtime/descriptor-io.h | 35 +-
flang/runtime/dot-product.cpp | 23 +
flang/runtime/edit-output.cpp | 14 +-
flang/runtime/edit-output.h | 14 +-
flang/runtime/extrema.cpp | 134 +++-
flang/runtime/io-api-minimal.cpp | 2 +-
flang/runtime/numeric.cpp | 4 +-
flang/runtime/reduce.cpp | 214 +++++
flang/runtime/tools.h | 2 +-
flang/runtime/type-code.cpp | 29 +
flang/runtime/type-info.cpp | 1 +
flang/test/Lower/Unsigned/unsigned-ops.f90 | 26 +
flang/test/Lower/allocatable-polymorphic.f90 | 2 +-
flang/test/Semantics/typeinfo01.f90 | 8 +-
flang/test/Semantics/typeinfo08.f90 | 2 +-
flang/test/Semantics/unsigned-errors.f90 | 77 ++
71 files changed, 2344 insertions(+), 588 deletions(-)
create mode 100644 flang/docs/Unsigned.md
create mode 100644 flang/test/Lower/Unsigned/unsigned-ops.f90
create mode 100644 flang/test/Semantics/unsigned-errors.f90
diff --git a/clang/include/clang/Driver/Options.td b/clang/include/clang/Driver/Options.td
index 6491e9ac73ce99..881a6b8386209a 100644
--- a/clang/include/clang/Driver/Options.td
+++ b/clang/include/clang/Driver/Options.td
@@ -6831,6 +6831,7 @@ defm underscoring : OptInFC1FFlag<"underscoring", "Appends one trailing undersco
defm ppc_native_vec_elem_order: BoolOptionWithoutMarshalling<"f", "ppc-native-vector-element-order",
PosFlag<SetTrue, [], [ClangOption], "Specifies PowerPC native vector element order (default)">,
NegFlag<SetFalse, [], [ClangOption], "Specifies PowerPC non-native vector element order">>;
+defm unsigned : OptInFC1FFlag<"unsigned", "Enables UNSIGNED type">;
def fno_automatic : Flag<["-"], "fno-automatic">, Group<f_Group>,
HelpText<"Implies the SAVE attribute for non-automatic local objects in subprograms unless RECURSIVE">;
diff --git a/clang/lib/Driver/ToolChains/Flang.cpp b/clang/lib/Driver/ToolChains/Flang.cpp
index e2f8f6e0cca1c6..89f0110c94d44c 100644
--- a/clang/lib/Driver/ToolChains/Flang.cpp
+++ b/clang/lib/Driver/ToolChains/Flang.cpp
@@ -120,7 +120,8 @@ void Flang::addOtherOptions(const ArgList &Args, ArgStringList &CmdArgs) const {
options::OPT_fintrinsic_modules_path, options::OPT_pedantic,
options::OPT_std_EQ, options::OPT_W_Joined,
options::OPT_fconvert_EQ, options::OPT_fpass_plugin_EQ,
- options::OPT_funderscoring, options::OPT_fno_underscoring});
+ options::OPT_funderscoring, options::OPT_fno_underscoring,
+ options::OPT_funsigned, options::OPT_fno_unsigned});
llvm::codegenoptions::DebugInfoKind DebugInfoKind;
if (Args.hasArg(options::OPT_gN_Group)) {
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index f85a3eb39ed191..5867d9a14c084c 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -417,6 +417,7 @@ end
[-fimplicit-none-type-never]
* Old-style `PARAMETER pi=3.14` statement without parentheses
[-falternative-parameter-statement]
+* `UNSIGNED` type (-funsigned)
### Extensions and legacy features deliberately not supported
diff --git a/flang/docs/Unsigned.md b/flang/docs/Unsigned.md
new file mode 100644
index 00000000000000..d9f8b78507dd3f
--- /dev/null
+++ b/flang/docs/Unsigned.md
@@ -0,0 +1,109 @@
+<!--===- docs/Unsigned.md
+
+ 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
+
+-->
+
+# Fortran Extensions supported by Flang
+
+```{contents}
+---
+local:
+---
+```
+
+For better compatibility with GNU Fortran and Sun Fortran,
+this compiler supports an option (`-funsigned`) that enables
+the `UNSIGNED` data type, constants, intrinsic functions,
+its use with intrinsic operations and `SELECT CASE`, and C
+language interoperability.
+
+## `UNSIGNED` type
+
+`UNSIGNED` is a numeric with the same kinds as `INTEGER`.
+It may appear as a type-spec in any context, including
+a type declaration statement, a type-decl in an array
+constructor or `ALLOCATE` statement, `IMPLICIT`, or a
+function statement's prefix.
+
+`UNSIGNED` constants are nonempty strings of decimal digits
+followed by the letter `U` and optionally a kind suffix with
+an underscore.
+
+## `UNSIGNED` operations
+
+`UNSIGNED` operands are accepted for unary negation (`-`),
+the basic four binary arithmetic intrinsic operations `+`, `-`, `*`, and `/`,
+and for numeric relational operators.
+The power operator `**` does not accept `UNSIGNED` operands.
+
+Mixed operations with other types are not allowed.
+Mixed operations with one `UNSIGNED` operand and one BOZ literal
+constant operand are allowed.
+When the operands' kinds differ, the smaller operand is zero-extended
+to the size of the larger.
+
+The arithmetic operations `u+v`, `-u`, `u-v`, and `u*v` are implemented
+modulo `MAX(HUGE(u),HUGE(v))+1`;
+informally speaking, they always truncate their results, or are
+guaranteed to "wrap".
+
+## `UNSIGNED` intrinsic functions
+
+`UNSIGNED` operands are accepted as operands to,
+or may be returned as results from,
+several intrinsic procedures.
+
+Bitwise operations:
+* `NOT`
+* `IAND`, `IOR`, `IEOR`, `IBCLR`, `IBSET`, `IBITS`, `MERGE_BITS`
+* `BTEST`
+* `ISHFT`, `ISHFTC`
+* `SHIFTA`, `SHIFTL`, `SHIFTR`
+* `TRANSFER`
+* `MVBITS`
+
+The existing unsigned comparisons `BLT`, `BLE`, `BGE`, and `BGT`.
+
+The inquiries `BIT_SIZE`, `DIGITS`, `HUGE`, and `RANGE`.
+
+Homogeneous `MAX` and `MIN`.
+
+The reducing transformationals:
+* `MAXVAL`, `MINVAL`
+* `SUM`, `PRODUCT`
+* `IALL`, `IANY`, `IPARITY`
+* `DOT_PRODUCT`, `MATMUL`
+
+All of the restructuring array transformational intrinsics: `CSHIFT`, `EOSHIFT`,
+ `PACK`, `RESHAPE`, `SPREAD`, `TRANSPOSE`, and `UNPACK`.
+
+The location transformationals `FINDLOC`, `MAXLOC`, and `MINLOC`.
+
+Support for `UNSIGNED` in the `OUT_OF_RANGE` predicate and `RANDOM_NUMBER`
+remains to be implemented.
+
+## Other usage
+
+`UNSIGNED` is allowed in `SELECT CASE`, but not in `DO` loop indices or
+limits, or an arithmetic `IF` expression.
+
+`UNSIGNED` array indices are not allowed.
+
+`UNSIGNED` data may be used as data items in I/O statements, including
+list-directed and `NAMELIST` I/O.
+Format-directed I/O may edit `UNSIGNED` data with `I`, `G`, `B`, `O`, and `Z`
+edit descriptors.
+
+## C interoperability
+
+`UNSIGNED` data map to type codes for C's `unsigned` types in the
+`type` member of a `cdesc_t` descriptor in the `ISO_Fortran_binding.h`
+header file.
+
+## Standard modules
+
+New definitions (`C_UNSIGNED`, `C_UINT8_T`, &c.) were added to ISO_C_BINDING
+and new constants (`UINT8`, `UINT16`, &c.) to ISO_FORTRAN_ENV.
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 2b57c7ae50642c..bd8f922cf3d440 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -53,7 +53,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
NonBindCInteroperability, CudaManaged, CudaUnified,
PolymorphicActualAllocatableOrPointerToMonomorphicDummy, RelaxedPureDummy,
UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram, PrintCptr,
- SavedLocalInSpecExpr, PrintNamelist)
+ SavedLocalInSpecExpr, PrintNamelist, Unsigned)
// Portability and suspicious usage warnings
ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
diff --git a/flang/include/flang/Common/Fortran.h b/flang/include/flang/Common/Fortran.h
index 5b2ed43a8f99c0..a4c20854eb7516 100644
--- a/flang/include/flang/Common/Fortran.h
+++ b/flang/include/flang/Common/Fortran.h
@@ -21,12 +21,15 @@
namespace Fortran::common {
class LanguageFeatureControl;
-// Fortran has five kinds of intrinsic data types, plus the derived types.
-ENUM_CLASS(TypeCategory, Integer, Real, Complex, Character, Logical, Derived)
+// Fortran has five kinds of standard intrinsic data types, the Unsigned
+// extension, and derived types.
+ENUM_CLASS(
+ TypeCategory, Integer, Unsigned, Real, Complex, Character, Logical, Derived)
ENUM_CLASS(VectorElementCategory, Integer, Unsigned, Real)
constexpr bool IsNumericTypeCategory(TypeCategory category) {
- return category == TypeCategory::Integer || category == TypeCategory::Real ||
+ return category == TypeCategory::Integer ||
+ category == TypeCategory::Unsigned || category == TypeCategory::Real ||
category == TypeCategory::Complex;
}
diff --git a/flang/include/flang/Evaluate/expression.h b/flang/include/flang/Evaluate/expression.h
index 2a40193e32306b..9ea037a2f7c429 100644
--- a/flang/include/flang/Evaluate/expression.h
+++ b/flang/include/flang/Evaluate/expression.h
@@ -209,10 +209,12 @@ template <typename TO, TypeCategory FROMCAT = TO::category>
struct Convert : public Operation<Convert<TO, FROMCAT>, TO, SomeKind<FROMCAT>> {
// Fortran doesn't have conversions between kinds of CHARACTER apart from
// assignments, and in those the data must be convertible to/from 7-bit ASCII.
- static_assert(((TO::category == TypeCategory::Integer ||
- TO::category == TypeCategory::Real) &&
- (FROMCAT == TypeCategory::Integer ||
- FROMCAT == TypeCategory::Real)) ||
+ static_assert(
+ ((TO::category == TypeCategory::Integer ||
+ TO::category == TypeCategory::Real ||
+ TO::category == TypeCategory::Unsigned) &&
+ (FROMCAT == TypeCategory::Integer || FROMCAT == TypeCategory::Real ||
+ FROMCAT == TypeCategory::Unsigned)) ||
TO::category == FROMCAT);
using Result = TO;
using Operand = SomeKind<FROMCAT>;
@@ -526,7 +528,8 @@ class Expr<Type<TypeCategory::Integer, KIND>>
private:
using Conversions = std::tuple<Convert<Result, TypeCategory::Integer>,
- Convert<Result, TypeCategory::Real>>;
+ Convert<Result, TypeCategory::Real>,
+ Convert<Result, TypeCategory::Unsigned>>;
using Operations = std::tuple<Parentheses<Result>, Negate<Result>,
Add<Result>, Subtract<Result>, Multiply<Result>, Divide<Result>,
Power<Result>, Extremum<Result>>;
@@ -547,6 +550,29 @@ class Expr<Type<TypeCategory::Integer, KIND>>
u;
};
+template <int KIND>
+class Expr<Type<TypeCategory::Unsigned, KIND>>
+ : public ExpressionBase<Type<TypeCategory::Unsigned, KIND>> {
+public:
+ using Result = Type<TypeCategory::Unsigned, KIND>;
+
+ EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
+
+private:
+ using Conversions = std::tuple<Convert<Result, TypeCategory::Integer>,
+ Convert<Result, TypeCategory::Real>,
+ Convert<Result, TypeCategory::Unsigned>>;
+ using Operations =
+ std::tuple<Parentheses<Result>, Negate<Result>, Add<Result>,
+ Subtract<Result>, Multiply<Result>, Divide<Result>, Extremum<Result>>;
+ using Others = std::tuple<Constant<Result>, ArrayConstructor<Result>,
+ Designator<Result>, FunctionRef<Result>>;
+
+public:
+ common::TupleToVariant<common::CombineTuples<Operations, Conversions, Others>>
+ u;
+};
+
template <int KIND>
class Expr<Type<TypeCategory::Real, KIND>>
: public ExpressionBase<Type<TypeCategory::Real, KIND>> {
@@ -560,7 +586,8 @@ class Expr<Type<TypeCategory::Real, KIND>>
// N.B. Real->Complex and Complex->Real conversions are done with CMPLX
// and part access operations (resp.).
using Conversions = std::variant<Convert<Result, TypeCategory::Integer>,
- Convert<Result, TypeCategory::Real>>;
+ Convert<Result, TypeCategory::Real>,
+ Convert<Result, TypeCategory::Unsigned>>;
using Operations = std::variant<ComplexComponent<KIND>, Parentheses<Result>,
Negate<Result>, Add<Result>, Subtract<Result>, Multiply<Result>,
Divide<Result>, Power<Result>, RealToIntPower<Result>, Extremum<Result>>;
@@ -590,6 +617,7 @@ class Expr<Type<TypeCategory::Complex, KIND>>
};
FOR_EACH_INTEGER_KIND(extern template class Expr, )
+FOR_EACH_UNSIGNED_KIND(extern template class Expr, )
FOR_EACH_REAL_KIND(extern template class Expr, )
FOR_EACH_COMPLEX_KIND(extern template class Expr, )
@@ -629,7 +657,8 @@ class Relational : public Operation<Relational<T>, LogicalResult, T, T> {
static_assert(Operand::category == TypeCategory::Integer ||
Operand::category == TypeCategory::Real ||
Operand::category == TypeCategory::Complex ||
- Operand::category == TypeCategory::Character);
+ Operand::category == TypeCategory::Character ||
+ Operand::category == TypeCategory::Unsigned);
CLASS_BOILERPLATE(Relational)
Relational(
RelationalOperator r, const Expr<Operand> &a, const Expr<Operand> &b)
@@ -642,7 +671,7 @@ class Relational : public Operation<Relational<T>, LogicalResult, T, T> {
template <> class Relational<SomeType> {
using DirectlyComparableTypes = common::CombineTuples<IntegerTypes, RealTypes,
- ComplexTypes, CharacterTypes>;
+ ComplexTypes, CharacterTypes, UnsignedTypes>;
public:
using Result = LogicalResult;
@@ -656,6 +685,7 @@ template <> class Relational<SomeType> {
};
FOR_EACH_INTEGER_KIND(extern template class Relational, )
+FOR_EACH_UNSIGNED_KIND(extern template class Relational, )
FOR_EACH_REAL_KIND(extern template class Relational, )
FOR_EACH_CHARACTER_KIND(extern template class Relational, )
extern template class Relational<SomeType>;
@@ -886,6 +916,7 @@ FOR_EACH_INTRINSIC_KIND(extern template class ArrayConstructor, )
FOR_EACH_INTRINSIC_KIND(template class Expr, ) \
FOR_EACH_CATEGORY_TYPE(template class Expr, ) \
FOR_EACH_INTEGER_KIND(template class Relational, ) \
+ FOR_EACH_UNSIGNED_KIND(template class Relational, ) \
FOR_EACH_REAL_KIND(template class Relational, ) \
FOR_EACH_CHARACTER_KIND(template class Relational, ) \
template class Relational<SomeType>; \
diff --git a/flang/include/flang/Evaluate/integer.h b/flang/include/flang/Evaluate/integer.h
index e420eb75e3dff0..fccc2ad774a8fc 100644
--- a/flang/include/flang/Evaluate/integer.h
+++ b/flang/include/flang/Evaluate/integer.h
@@ -33,6 +33,12 @@
namespace Fortran::evaluate::value {
+// Computes decimal range in the sense of SELECTED_INT_KIND
+static constexpr int DecimalRange(int bits) {
+ // This magic value is LOG10(2.)*1E12.
+ return static_cast<int>((bits * 301029995664) / 1000000000000);
+}
+
// Implements an integer as an assembly of smaller host integer parts
// that constitute the digits of a large-radix fixed-point number.
// For best performance, the type of these parts should be half of the
@@ -367,9 +373,8 @@ class Integer {
static constexpr int DIGITS{bits - 1}; // don't count the sign bit
static constexpr Integer HUGE() { return MASKR(bits - 1); }
static constexpr Integer Least() { return MASKL(1); }
- static constexpr int RANGE{// in the sense of SELECTED_INT_KIND
- // This magic value is LOG10(2.)*1E12.
- static_cast<int>(((bits - 1) * 301029995664) / 1000000000000)};
+ static constexpr int RANGE{DecimalRange(bits - 1)};
+ static constexpr int UnsignedRANGE{DecimalRange(bits)};
constexpr bool IsZero() const {
for (int j{0}; j < parts; ++j) {
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index f547138f5a116c..7a97a56b020ad9 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -582,7 +582,8 @@ Expr<TO> ConvertToType(Expr<Type<FROMCAT, FROMKIND>> &&x) {
template <typename TO> Expr<TO> ConvertToType(BOZLiteralConstant &&x) {
static_assert(IsSpecificIntrinsicType<TO>);
- if constexpr (TO::category == TypeCategory::Integer) {
+ if constexpr (TO::category == TypeCategory::Integer ||
+ TO::category == TypeCategory::Unsigned) {
return Expr<TO>{
Constant<TO>{Scalar<TO>::ConvertUnsigned(std::move(x)).value}};
} else {
@@ -754,11 +755,11 @@ Expr<SomeKind<CAT>> PromoteAndCombine(
// one of the operands to the type of the other. Handles special cases with
// typeless literal operands and with REAL/COMPLEX exponentiation to INTEGER
// powers.
-template <template <typename> class OPR>
+template <template <typename> class OPR, bool CAN_BE_UNSIGNED = true>
std::optional<Expr<SomeType>> NumericOperation(parser::ContextualMessages &,
Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
-extern template std::optional<Expr<SomeType>> NumericOperation<Power>(
+extern template std::optional<Expr<SomeType>> NumericOperation<Power, false>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
extern template std::optional<Expr<SomeType>> NumericOperation<Multiply>(
@@ -910,6 +911,9 @@ common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> TypedWrapper(
case TypeCategory::Integer:
return WrapperHelper<TypeCategory::Integer, WRAPPER, WRAPPED>(
dyType.kind(), std::move(x));
+ case TypeCategory::Unsigned:
+ return WrapperHelper<TypeCategory::Unsigned, WRAPPER, WRAPPED>(
+ dyType.kind(), std::move(x));
case TypeCategory::Real:
return WrapperHelper<TypeCategory::Real, WRAPPER, WRAPPED>(
dyType.kind(), std::move(x));
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index bd8887dbce4e82..1f9296ac4fea75 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -69,6 +69,7 @@ static constexpr bool IsValidKindOfIntrinsicType(
TypeCategory category, std::int64_t kind) {
switch (category) {
case TypeCategory::Integer:
+ case TypeCategory::Unsigned:
return kind == 1 || kind == 2 || kind == 4 || kind == 8 || kind == 16;
case TypeCategory::Real:
case TypeCategory::Complex:
@@ -287,6 +288,13 @@ class Type<TypeCategory::Integer, KIND>
using Scalar = value::Integer<8 * KIND>;
};
+template <int KIND>
+class Type<TypeCategory::Unsigned, KIND>
+ : public TypeBase<TypeCategory::Unsigned, KIND> {
+public:
+ using Scalar = value::Integer<8 * KIND>;
+};
+
template <int KIND>
class Type<TypeCategory::Real, KIND>
: public TypeBase<TypeCategory::Real, KIND> {
@@ -367,11 +375,13 @@ using RealTypes = CategoryTypes<TypeCategory::Real>;
using ComplexTypes = CategoryTypes<TypeCategory::Complex>;
using CharacterTypes = CategoryTypes<TypeCategory::Character>;
using LogicalTypes = CategoryTypes<TypeCategory::Logical>;
+using UnsignedTypes = CategoryTypes<TypeCategory::Unsigned>;
using FloatingTypes = common::CombineTuples<RealTypes, ComplexTypes>;
-using NumericTypes = common::CombineTuples<IntegerTypes, FloatingTypes>;
-using RelationalTypes =
- common::CombineTuples<IntegerTypes, RealTypes, CharacterTypes>;
+using NumericTypes =
+ common::CombineTuples<IntegerTypes, FloatingTypes, UnsignedTypes>;
+using RelationalTypes = common::CombineTuples<IntegerTypes, RealTypes,
+ CharacterTypes, UnsignedTypes>;
using AllIntrinsicTypes =
common::CombineTuples<NumericTypes, CharacterTypes, LogicalTypes>;
using LengthlessIntrinsicTypes =
@@ -397,11 +407,13 @@ template <TypeCategory CATEGORY> struct SomeKind {
}
};
-using NumericCategoryTypes = std::tuple<SomeKind<TypeCategory::Integer>,
- SomeKind<TypeCategory::Real>, SomeKind<TypeCategory::Complex>>;
-using AllIntrinsicCategoryTypes = std::tuple<SomeKind<TypeCategory::Integer>,
- SomeKind<TypeCategory::Real>, SomeKind<TypeCategory::Complex>,
- SomeKind<TypeCategory::Character>, SomeKind<TypeCategory::Logical>>;
+using NumericCategoryTypes =
+ std::tuple<SomeKind<TypeCategory::Integer>, SomeKind<TypeCategory::Real>,
+ SomeKind<TypeCategory::Complex>, SomeKind<TypeCategory::Unsigned>>;
+using AllIntrinsicCategoryTypes =
+ std::tuple<SomeKind<TypeCategory::Integer>, SomeKind<TypeCategory::Real>,
+ SomeKind<TypeCategory::Complex>, SomeKind<TypeCategory::Character>,
+ SomeKind<TypeCategory::Logical>, SomeKind<TypeCategory::Unsigned>>;
// Represents a completely generic type (or, for Expr<SomeType>, a typeless
// value like a BOZ literal or NULL() pointer).
@@ -448,9 +460,10 @@ using SomeReal = SomeKind<TypeCategory::Real>;
using SomeComplex = SomeKind<TypeCategory::Complex>;
using SomeCharacter = SomeKind<TypeCategory::Character>;
using SomeLogical = SomeKind<TypeCategory::Logical>;
+using SomeUnsigned = SomeKind<TypeCategory::Unsigned>;
using SomeDerived = SomeKind<TypeCategory::Derived>;
using SomeCategory = std::tuple<SomeInteger, SomeReal, SomeComplex,
- SomeCharacter, SomeLogical, SomeDerived>;
+ SomeCharacter, SomeLogical, SomeUnsigned, SomeDerived>;
using AllTypes =
common::CombineTuples<AllIntrinsicTypes, std::tuple<SomeDerived>>;
@@ -507,6 +520,7 @@ bool AreSameDerivedTypeIgnoringTypeParameters(
#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;
@@ -518,6 +532,8 @@ bool AreSameDerivedTypeIgnoringTypeParameters(
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;
#define FOR_EACH_INTEGER_KIND(PREFIX, SUFFIX) \
EXPAND_FOR_EACH_INTEGER_KIND(FOR_EACH_INTEGER_KIND_HELP, PREFIX, SUFFIX)
@@ -529,12 +545,15 @@ bool AreSameDerivedTypeIgnoringTypeParameters(
EXPAND_FOR_EACH_CHARACTER_KIND(FOR_EACH_CHARACTER_KIND_HELP, PREFIX, SUFFIX)
#define FOR_EACH_LOGICAL_KIND(PREFIX, SUFFIX) \
EXPAND_FOR_EACH_LOGICAL_KIND(FOR_EACH_LOGICAL_KIND_HELP, PREFIX, SUFFIX)
+#define FOR_EACH_UNSIGNED_KIND(PREFIX, SUFFIX) \
+ EXPAND_FOR_EACH_UNSIGNED_KIND(FOR_EACH_UNSIGNED_KIND_HELP, PREFIX, SUFFIX)
#define FOR_EACH_LENGTHLESS_INTRINSIC_KIND(PREFIX, SUFFIX) \
FOR_EACH_INTEGER_KIND(PREFIX, SUFFIX) \
FOR_EACH_REAL_KIND(PREFIX, SUFFIX) \
FOR_EACH_COMPLEX_KIND(PREFIX, SUFFIX) \
- FOR_EACH_LOGICAL_KIND(PREFIX, SUFFIX)
+ FOR_EACH_LOGICAL_KIND(PREFIX, SUFFIX) \
+ FOR_EACH_UNSIGNED_KIND(PREFIX, SUFFIX)
#define FOR_EACH_INTRINSIC_KIND(PREFIX, SUFFIX) \
FOR_EACH_LENGTHLESS_INTRINSIC_KIND(PREFIX, SUFFIX) \
FOR_EACH_CHARACTER_KIND(PREFIX, SUFFIX)
@@ -548,6 +567,7 @@ bool AreSameDerivedTypeIgnoringTypeParameters(
PREFIX<SomeComplex> SUFFIX; \
PREFIX<SomeCharacter> SUFFIX; \
PREFIX<SomeLogical> SUFFIX; \
+ PREFIX<SomeUnsigned> SUFFIX; \
PREFIX<SomeDerived> SUFFIX; \
PREFIX<SomeType> SUFFIX;
#define FOR_EACH_TYPE_AND_KIND(PREFIX, SUFFIX) \
diff --git a/flang/include/flang/ISO_Fortran_binding.h b/flang/include/flang/ISO_Fortran_binding.h
index 89a10ce69a2ba2..945f8fef89f0b4 100644
--- a/flang/include/flang/ISO_Fortran_binding.h
+++ b/flang/include/flang/ISO_Fortran_binding.h
@@ -96,7 +96,12 @@ typedef signed char CFI_type_t;
#define CFI_type_struct 42
#define CFI_type_char16_t 43 /* extension kind=2 */
#define CFI_type_char32_t 44 /* extension kind=4 */
-#define CFI_TYPE_LAST CFI_type_char32_t
+#define CFI_type_uint8_t 45 /* extension: unsigned */
+#define CFI_type_uint16_t 46
+#define CFI_type_uint32_t 47
+#define CFI_type_uint64_t 48
+#define CFI_type_uint128_t 49
+#define CFI_TYPE_LAST CFI_type_uint128_t
#define CFI_type_other (-1) // must be negative
/* Error code macros - skip some of the small values to avoid conflicts with
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
index 66e11b5585d521..76e219a79fb45a 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
@@ -400,6 +400,69 @@ constexpr TypeBuilderFunc getModel<bool &>() {
return fir::ReferenceType::get(f(context));
};
}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned short>() {
+ return getModel<short>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned char *>() {
+ return getModel<char *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<const unsigned char *>() {
+ return getModel<char *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned short *>() {
+ return getModel<short *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<const unsigned short *>() {
+ return getModel<short *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned *>() {
+ return getModel<int *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<const unsigned *>() {
+ return getModel<int *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned long *>() {
+ return getModel<long *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<const unsigned long *>() {
+ return getModel<long *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned long long *>() {
+ return getModel<long long *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<const unsigned long long *>() {
+ return getModel<long long *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<Fortran::common::uint128_t>() {
+ return getModel<Fortran::common::int128_t>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<Fortran::common::int128_t *>() {
+ return [](mlir::MLIRContext *context) -> mlir::Type {
+ TypeBuilderFunc f{getModel<Fortran::common::int128_t>()};
+ return fir::ReferenceType::get(f(context));
+ };
+}
+template <>
+constexpr TypeBuilderFunc getModel<Fortran::common::uint128_t *>() {
+ return getModel<Fortran::common::int128_t *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<const Fortran::common::uint128_t *>() {
+ return getModel<Fortran::common::int128_t *>();
+}
// getModel<std::complex<T>> are not implemented on purpose.
// Prefer passing/returning the complex by reference in the runtime to
@@ -512,6 +575,17 @@ REDUCTION_VALUE_OPERATION_MODEL(std::int64_t)
REDUCTION_REF_OPERATION_MODEL(Fortran::common::int128_t)
REDUCTION_VALUE_OPERATION_MODEL(Fortran::common::int128_t)
+REDUCTION_REF_OPERATION_MODEL(std::uint8_t)
+REDUCTION_VALUE_OPERATION_MODEL(std::uint8_t)
+REDUCTION_REF_OPERATION_MODEL(std::uint16_t)
+REDUCTION_VALUE_OPERATION_MODEL(std::uint16_t)
+REDUCTION_REF_OPERATION_MODEL(std::uint32_t)
+REDUCTION_VALUE_OPERATION_MODEL(std::uint32_t)
+REDUCTION_REF_OPERATION_MODEL(std::uint64_t)
+REDUCTION_VALUE_OPERATION_MODEL(std::uint64_t)
+REDUCTION_REF_OPERATION_MODEL(Fortran::common::uint128_t)
+REDUCTION_VALUE_OPERATION_MODEL(Fortran::common::uint128_t)
+
REDUCTION_REF_OPERATION_MODEL(float)
REDUCTION_VALUE_OPERATION_MODEL(float)
REDUCTION_REF_OPERATION_MODEL(double)
diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td
index d467f0ab4e1c1e..612725466f0ed8 100644
--- a/flang/include/flang/Optimizer/Dialect/FIROps.td
+++ b/flang/include/flang/Optimizer/Dialect/FIROps.td
@@ -2735,8 +2735,9 @@ def fir_ConvertOp : fir_SimpleOneResultOp<"convert", [NoMemoryEffect]> {
}
def FortranTypeAttr : Attr<And<[CPred<"mlir::isa<mlir::TypeAttr>($_self)">,
- Or<[CPred<"mlir::isa<fir::CharacterType, fir::IntegerType,"
- "fir::LogicalType, mlir::FloatType, mlir::ComplexType,"
+ Or<[CPred<"mlir::isa<fir::CharacterType, fir::IntegerType, "
+ "fir::UnsignedType, fir::LogicalType, mlir::FloatType, "
+ "mlir::ComplexType, "
"fir::RecordType>(mlir::cast<mlir::TypeAttr>($_self).getValue())"
>]>]>, "Fortran surface type"> {
let storageType = [{ ::mlir::TypeAttr }];
diff --git a/flang/include/flang/Optimizer/Dialect/FIRTypes.td b/flang/include/flang/Optimizer/Dialect/FIRTypes.td
index 7ac8e0822ecc88..4a52293c98fd00 100644
--- a/flang/include/flang/Optimizer/Dialect/FIRTypes.td
+++ b/flang/include/flang/Optimizer/Dialect/FIRTypes.td
@@ -213,6 +213,22 @@ def fir_IntegerType : FIR_Type<"Integer", "int"> {
}];
}
+def fir_UnsignedType : FIR_Type<"Unsigned", "unsigned"> {
+ let summary = "FIR unsigned type";
+
+ let description = [{
+ Model of a Fortran UNSIGNED extension intrinsic type, including
+ the KIND type parameter.
+ }];
+
+ let parameters = (ins "KindTy":$fKind);
+ let hasCustomAssemblyFormat = 1;
+
+ let extraClassDeclaration = [{
+ using KindTy = unsigned;
+ }];
+}
+
def fir_LenType : FIR_Type<"Len", "len"> {
let summary = "A LEN parameter (in a RecordType) argument's type";
@@ -554,7 +570,8 @@ def fir_BaseBoxType : Type<IsBaseBoxTypePred, "fir.box or fir.class type">;
// Generalized FIR and standard dialect types representing intrinsic types
def AnyIntegerLike : TypeConstraint<Or<[SignlessIntegerLike.predicate,
- AnySignedInteger.predicate, fir_IntegerType.predicate]>, "any integer">;
+ AnySignedInteger.predicate, AnyUnsignedInteger.predicate,
+ fir_IntegerType.predicate, fir_UnsignedType.predicate]>, "any integer">;
def AnyLogicalLike : TypeConstraint<Or<[BoolLike.predicate,
fir_LogicalType.predicate]>, "any logical">;
def AnyRealLike : TypeConstraint<FloatLike.predicate, "any real">;
diff --git a/flang/include/flang/Optimizer/Support/Utils.h b/flang/include/flang/Optimizer/Support/Utils.h
index 2e25ef5f19bbe1..50024b10273118 100644
--- a/flang/include/flang/Optimizer/Support/Utils.h
+++ b/flang/include/flang/Optimizer/Support/Utils.h
@@ -162,15 +162,25 @@ mlirTypeToCategoryKind(mlir::Location loc, mlir::Type type) {
if (std::optional<int> kind = mlirFloatTypeToKind(cplxTy.getElementType()))
return {Fortran::common::TypeCategory::Complex, *kind};
} else if (type.isInteger(8))
- return {Fortran::common::TypeCategory::Integer, 1};
+ return {type.isUnsignedInteger() ? Fortran::common::TypeCategory::Unsigned
+ : Fortran::common::TypeCategory::Integer,
+ 1};
else if (type.isInteger(16))
- return {Fortran::common::TypeCategory::Integer, 2};
+ return {type.isUnsignedInteger() ? Fortran::common::TypeCategory::Unsigned
+ : Fortran::common::TypeCategory::Integer,
+ 2};
else if (type.isInteger(32))
- return {Fortran::common::TypeCategory::Integer, 4};
+ return {type.isUnsignedInteger() ? Fortran::common::TypeCategory::Unsigned
+ : Fortran::common::TypeCategory::Integer,
+ 4};
else if (type.isInteger(64))
- return {Fortran::common::TypeCategory::Integer, 8};
+ return {type.isUnsignedInteger() ? Fortran::common::TypeCategory::Unsigned
+ : Fortran::common::TypeCategory::Integer,
+ 8};
else if (type.isInteger(128))
- return {Fortran::common::TypeCategory::Integer, 16};
+ return {type.isUnsignedInteger() ? Fortran::common::TypeCategory::Unsigned
+ : Fortran::common::TypeCategory::Integer,
+ 16};
else if (auto logicalType = mlir::dyn_cast<fir::LogicalType>(type))
return {Fortran::common::TypeCategory::Logical, logicalType.getFKind()};
else if (auto charType = mlir::dyn_cast<fir::CharacterType>(type))
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 5d243b4e5d3e9a..f50aba83f6528e 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -745,6 +745,7 @@ class ParseTreeDumper {
NODE(Union, EndUnionStmt)
NODE(Union, UnionStmt)
NODE(parser, UnlockStmt)
+ NODE(parser, UnsignedLiteralConstant)
NODE(parser, UnsignedTypeSpec)
NODE(parser, UseStmt)
NODE_ENUM(UseStmt, ModuleNature)
@@ -867,7 +868,8 @@ class ParseTreeDumper {
asFortran_->call(ss, *x.typedCall);
}
} else if constexpr (std::is_same_v<T, IntLiteralConstant> ||
- std::is_same_v<T, SignedIntLiteralConstant>) {
+ std::is_same_v<T, SignedIntLiteralConstant> ||
+ std::is_same_v<T, UnsignedLiteralConstant>) {
ss << std::get<CharBlock>(x.t);
} else if constexpr (std::is_same_v<T, RealLiteralConstant::Real>) {
ss << x.source;
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 21b4a344dbc438..5b5c8261a59e04 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -655,6 +655,8 @@ struct KindSelector {
// R705 integer-type-spec -> INTEGER [kind-selector]
WRAPPER_CLASS(IntegerTypeSpec, std::optional<KindSelector>);
+WRAPPER_CLASS(UnsignedTypeSpec, std::optional<KindSelector>);
+
// R723 char-length -> ( type-param-value ) | digit-string
struct CharLength {
UNION_CLASS_BOILERPLATE(CharLength);
@@ -692,7 +694,7 @@ struct CharSelector {
// integer-type-spec | REAL [kind-selector] | DOUBLE PRECISION |
// COMPLEX [kind-selector] | CHARACTER [char-selector] |
// LOGICAL [kind-selector]
-// Extensions: DOUBLE COMPLEX
+// Extensions: DOUBLE COMPLEX & UNSIGNED [kind-selector]
struct IntrinsicTypeSpec {
UNION_CLASS_BOILERPLATE(IntrinsicTypeSpec);
struct Real {
@@ -717,13 +719,12 @@ struct IntrinsicTypeSpec {
std::optional<KindSelector> kind;
};
EMPTY_CLASS(DoubleComplex);
- std::variant<IntegerTypeSpec, Real, DoublePrecision, Complex, Character,
- Logical, DoubleComplex>
+ std::variant<IntegerTypeSpec, UnsignedTypeSpec, Real, DoublePrecision,
+ Complex, Character, Logical, DoubleComplex>
u;
};
// Extension: Vector type
-WRAPPER_CLASS(UnsignedTypeSpec, std::optional<KindSelector>);
struct VectorElementType {
UNION_CLASS_BOILERPLATE(VectorElementType);
std::variant<IntegerTypeSpec, IntrinsicTypeSpec::Real, UnsignedTypeSpec> u;
@@ -801,6 +802,12 @@ struct IntLiteralConstant {
std::tuple<CharBlock, std::optional<KindParam>> t;
};
+// extension: unsigned-literal-constant -> digit-string U [_ kind-param]
+struct UnsignedLiteralConstant {
+ TUPLE_CLASS_BOILERPLATE(UnsignedLiteralConstant);
+ std::tuple<CharBlock, std::optional<KindParam>> t;
+};
+
// R712 sign -> + | -
enum class Sign { Positive, Negative };
@@ -892,7 +899,7 @@ struct LiteralConstant {
UNION_CLASS_BOILERPLATE(LiteralConstant);
std::variant<HollerithLiteralConstant, IntLiteralConstant,
RealLiteralConstant, ComplexLiteralConstant, BOZLiteralConstant,
- CharLiteralConstant, LogicalLiteralConstant>
+ CharLiteralConstant, LogicalLiteralConstant, UnsignedLiteralConstant>
u;
};
@@ -1466,7 +1473,8 @@ struct DataStmtConstant {
mutable TypedExpr typedExpr;
std::variant<LiteralConstant, SignedIntLiteralConstant,
SignedRealLiteralConstant, SignedComplexLiteralConstant, NullInit,
- common::Indirection<Designator>, StructureConstructor>
+ common::Indirection<Designator>, StructureConstructor,
+ UnsignedLiteralConstant>
u;
};
diff --git a/flang/include/flang/Runtime/cpp-type.h b/flang/include/flang/Runtime/cpp-type.h
index f6180b4a9ab60c..132c685b431967 100644
--- a/flang/include/flang/Runtime/cpp-type.h
+++ b/flang/include/flang/Runtime/cpp-type.h
@@ -47,6 +47,10 @@ template <int KIND> struct CppTypeForHelper<TypeCategory::Integer, KIND> {
using type = common::HostSignedIntType<8 * KIND>;
};
+template <int KIND> struct CppTypeForHelper<TypeCategory::Unsigned, KIND> {
+ using type = common::HostUnsignedIntType<8 * KIND>;
+};
+
#if HAS_FP16
template <> struct CppTypeForHelper<TypeCategory::Real, 2> {
using type = std::float16_t;
diff --git a/flang/include/flang/Runtime/numeric.h b/flang/include/flang/Runtime/numeric.h
index 9e6bf357861e75..794c8f4768826e 100644
--- a/flang/include/flang/Runtime/numeric.h
+++ b/flang/include/flang/Runtime/numeric.h
@@ -374,7 +374,7 @@ CppTypeFor<TypeCategory::Real, 16> RTDECL(Scale16)(
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedCharKind)(
const char *, int, const char *, std::size_t);
-// SELECTED_INT_KIND
+// SELECTED_INT_KIND and SELECTED_UNSIGNED_KIND
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedIntKind)(
const char *, int, void *, int);
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedIntKindMasked)(
diff --git a/flang/include/flang/Runtime/reduce.h b/flang/include/flang/Runtime/reduce.h
index c63782b85f22f5..26a61be455b123 100644
--- a/flang/include/flang/Runtime/reduce.h
+++ b/flang/include/flang/Runtime/reduce.h
@@ -123,6 +123,89 @@ void RTDECL(ReduceInteger16DimValue)(Descriptor &result,
const common::int128_t *identity = nullptr, bool ordered = true);
#endif
+std::uint8_t RTDECL(ReduceUnsigned1Ref)(const Descriptor &,
+ ReferenceReductionOperation<std::uint8_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint8_t *identity = nullptr, bool ordered = true);
+std::uint8_t RTDECL(ReduceUnsigned1Value)(const Descriptor &,
+ ValueReductionOperation<std::uint8_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint8_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned1DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint8_t>, const char *source, int line,
+ int dim, const Descriptor *mask = nullptr,
+ const std::uint8_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned1DimValue)(Descriptor &result,
+ const Descriptor &array, ValueReductionOperation<std::uint8_t>,
+ const char *source, int line, int dim, const Descriptor *mask = nullptr,
+ const std::uint8_t *identity = nullptr, bool ordered = true);
+std::uint16_t RTDECL(ReduceUnsigned2Ref)(const Descriptor &,
+ ReferenceReductionOperation<std::uint16_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint16_t *identity = nullptr, bool ordered = true);
+std::uint16_t RTDECL(ReduceUnsigned2Value)(const Descriptor &,
+ ValueReductionOperation<std::uint16_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint16_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned2DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint16_t>, const char *source, int line,
+ int dim, const Descriptor *mask = nullptr,
+ const std::uint16_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned2DimValue)(Descriptor &result,
+ const Descriptor &array, ValueReductionOperation<std::uint16_t>,
+ const char *source, int line, int dim, const Descriptor *mask = nullptr,
+ const std::uint16_t *identity = nullptr, bool ordered = true);
+std::uint32_t RTDECL(ReduceUnsigned4Ref)(const Descriptor &,
+ ReferenceReductionOperation<std::uint32_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint32_t *identity = nullptr, bool ordered = true);
+std::uint32_t RTDECL(ReduceUnsigned4Value)(const Descriptor &,
+ ValueReductionOperation<std::uint32_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint32_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned4DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint32_t>, const char *source, int line,
+ int dim, const Descriptor *mask = nullptr,
+ const std::uint32_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned4DimValue)(Descriptor &result,
+ const Descriptor &array, ValueReductionOperation<std::uint32_t>,
+ const char *source, int line, int dim, const Descriptor *mask = nullptr,
+ const std::uint32_t *identity = nullptr, bool ordered = true);
+std::uint64_t RTDECL(ReduceUnsigned8Ref)(const Descriptor &,
+ ReferenceReductionOperation<std::uint64_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint64_t *identity = nullptr, bool ordered = true);
+std::uint64_t RTDECL(ReduceUnsigned8Value)(const Descriptor &,
+ ValueReductionOperation<std::uint64_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint64_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned8DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint64_t>, const char *source, int line,
+ int dim, const Descriptor *mask = nullptr,
+ const std::uint64_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned8DimValue)(Descriptor &result,
+ const Descriptor &array, ValueReductionOperation<std::uint64_t>,
+ const char *source, int line, int dim, const Descriptor *mask = nullptr,
+ const std::uint64_t *identity = nullptr, bool ordered = true);
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDECL(ReduceUnsigned16Ref)(const Descriptor &,
+ ReferenceReductionOperation<common::uint128_t>, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr,
+ const common::uint128_t *identity = nullptr, bool ordered = true);
+common::uint128_t RTDECL(ReduceUnsigned16Value)(const Descriptor &,
+ ValueReductionOperation<common::uint128_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const common::uint128_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned16DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<common::uint128_t>, const char *source,
+ int line, int dim, const Descriptor *mask = nullptr,
+ const common::uint128_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned16DimValue)(Descriptor &result,
+ const Descriptor &array, ValueReductionOperation<common::uint128_t>,
+ const char *source, int line, int dim, const Descriptor *mask = nullptr,
+ const common::uint128_t *identity = nullptr, bool ordered = true);
+#endif
+
// REAL/COMPLEX(2 & 3) return 32-bit float results for the caller to downconvert
float RTDECL(ReduceReal2Ref)(const Descriptor &,
ReferenceReductionOperation<float>, const char *source, int line,
diff --git a/flang/include/flang/Runtime/reduction.h b/flang/include/flang/Runtime/reduction.h
index 91811581f645d5..6945ed4a653204 100644
--- a/flang/include/flang/Runtime/reduction.h
+++ b/flang/include/flang/Runtime/reduction.h
@@ -58,6 +58,18 @@ std::int64_t RTDECL(SumInteger8)(const Descriptor &, const char *source,
common::int128_t RTDECL(SumInteger16)(const Descriptor &, const char *source,
int line, int dim = 0, const Descriptor *mask = nullptr);
#endif
+std::uint8_t RTDECL(SumUnsigned1)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint16_t RTDECL(SumUnsigned2)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint32_t RTDECL(SumUnsigned4)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint64_t RTDECL(SumUnsigned8)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDECL(SumUnsigned16)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+#endif
// REAL/COMPLEX(2 & 3) return 32-bit float results for the caller to downconvert
float RTDECL(SumReal2)(const Descriptor &, const char *source, int line,
@@ -119,6 +131,19 @@ common::int128_t RTDECL(ProductInteger16)(const Descriptor &,
const char *source, int line, int dim = 0,
const Descriptor *mask = nullptr);
#endif
+std::uint8_t RTDECL(ProductUnsigned1)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint16_t RTDECL(ProductUnsigned2)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint32_t RTDECL(ProductUnsigned4)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint64_t RTDECL(ProductUnsigned8)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDECL(ProductUnsigned16)(const Descriptor &,
+ const char *source, int line, int dim = 0,
+ const Descriptor *mask = nullptr);
+#endif
// REAL/COMPLEX(2 & 3) return 32-bit float results for the caller to downconvert
float RTDECL(ProductReal2)(const Descriptor &, const char *source, int line,
@@ -239,6 +264,21 @@ void RTDECL(MaxlocInteger8)(Descriptor &, const Descriptor &, int kind,
void RTDECL(MaxlocInteger16)(Descriptor &, const Descriptor &, int kind,
const char *source, int line, const Descriptor *mask = nullptr,
bool back = false);
+void RTDECL(MaxlocUnsigned1)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MaxlocUnsigned2)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MaxlocUnsigned4)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MaxlocUnsigned8)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MaxlocUnsigned16)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
void RTDECL(MaxlocReal4)(Descriptor &, const Descriptor &, int kind,
const char *source, int line, const Descriptor *mask = nullptr,
bool back = false);
@@ -272,6 +312,21 @@ void RTDECL(MinlocInteger8)(Descriptor &, const Descriptor &, int kind,
void RTDECL(MinlocInteger16)(Descriptor &, const Descriptor &, int kind,
const char *source, int line, const Descriptor *mask = nullptr,
bool back = false);
+void RTDECL(MinlocUnsigned1)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MinlocUnsigned2)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MinlocUnsigned4)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MinlocUnsigned8)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MinlocUnsigned16)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
void RTDECL(MinlocReal4)(Descriptor &, const Descriptor &, int kind,
const char *source, int line, const Descriptor *mask = nullptr,
bool back = false);
@@ -301,6 +356,19 @@ std::int64_t RTDECL(MaxvalInteger8)(const Descriptor &, const char *source,
common::int128_t RTDECL(MaxvalInteger16)(const Descriptor &, const char *source,
int line, int dim = 0, const Descriptor *mask = nullptr);
#endif
+std::uint8_t RTDECL(MaxvalUnsigned1)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint16_t RTDECL(MaxvalUnsigned2)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint32_t RTDECL(MaxvalUnsigned4)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint64_t RTDECL(MaxvalUnsigned8)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDECL(MaxvalUnsigned16)(const Descriptor &,
+ const char *source, int line, int dim = 0,
+ const Descriptor *mask = nullptr);
+#endif
float RTDECL(MaxvalReal2)(const Descriptor &, const char *source, int line,
int dim = 0, const Descriptor *mask = nullptr);
float RTDECL(MaxvalReal3)(const Descriptor &, const char *source, int line,
@@ -333,6 +401,19 @@ std::int64_t RTDECL(MinvalInteger8)(const Descriptor &, const char *source,
common::int128_t RTDECL(MinvalInteger16)(const Descriptor &, const char *source,
int line, int dim = 0, const Descriptor *mask = nullptr);
#endif
+std::uint8_t RTDECL(MinvalUnsigned1)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint16_t RTDECL(MinvalUnsigned2)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint32_t RTDECL(MinvalUnsigned4)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint64_t RTDECL(MinvalUnsigned8)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDECL(MinvalUnsigned16)(const Descriptor &,
+ const char *source, int line, int dim = 0,
+ const Descriptor *mask = nullptr);
+#endif
float RTDECL(MinvalReal2)(const Descriptor &, const char *source, int line,
int dim = 0, const Descriptor *mask = nullptr);
float RTDECL(MinvalReal3)(const Descriptor &, const char *source, int line,
@@ -409,6 +490,18 @@ std::int64_t RTDECL(DotProductInteger8)(const Descriptor &, const Descriptor &,
common::int128_t RTDECL(DotProductInteger16)(const Descriptor &,
const Descriptor &, const char *source = nullptr, int line = 0);
#endif
+std::uint8_t RTDECL(DotProductUnsigned1)(const Descriptor &, const Descriptor &,
+ const char *source = nullptr, int line = 0);
+std::uint16_t RTDECL(DotProductUnsigned2)(const Descriptor &,
+ const Descriptor &, const char *source = nullptr, int line = 0);
+std::uint32_t RTDECL(DotProductUnsigned4)(const Descriptor &,
+ const Descriptor &, const char *source = nullptr, int line = 0);
+std::uint64_t RTDECL(DotProductUnsigned8)(const Descriptor &,
+ const Descriptor &, const char *source = nullptr, int line = 0);
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDECL(DotProductUnsigned16)(const Descriptor &,
+ const Descriptor &, const char *source = nullptr, int line = 0);
+#endif
float RTDECL(DotProductReal2)(const Descriptor &, const Descriptor &,
const char *source = nullptr, int line = 0);
float RTDECL(DotProductReal3)(const Descriptor &, const Descriptor &,
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index a90801db7338cc..bb1674a9f88778 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -274,6 +274,7 @@ class ExpressionAnalyzer {
}
MaybeExpr Analyze(const parser::IntLiteralConstant &, bool negated = false);
+ MaybeExpr Analyze(const parser::UnsignedLiteralConstant &);
MaybeExpr Analyze(const parser::RealLiteralConstant &);
MaybeExpr Analyze(const parser::ComplexPart &);
MaybeExpr Analyze(const parser::ComplexLiteralConstant &);
@@ -327,8 +328,8 @@ class ExpressionAnalyzer {
const std::optional<parser::KindParam> &, int defaultKind);
template <typename PARSED>
MaybeExpr ExprOrVariable(const PARSED &, parser::CharBlock source);
- template <typename PARSED>
- MaybeExpr IntLiteralConstant(const PARSED &, bool negated = false);
+ template <typename TYPES, TypeCategory CAT, typename PARSED>
+ MaybeExpr IntLiteralConstant(const PARSED &, bool isNegated = false);
MaybeExpr AnalyzeString(std::string &&, int kind);
std::optional<Expr<SubscriptInteger>> AsSubscript(MaybeExpr &&);
std::optional<Expr<SubscriptInteger>> TripletPart(
diff --git a/flang/lib/Common/default-kinds.cpp b/flang/lib/Common/default-kinds.cpp
index 0c708fcd605094..fbafd827ff0d0b 100644
--- a/flang/lib/Common/default-kinds.cpp
+++ b/flang/lib/Common/default-kinds.cpp
@@ -68,6 +68,7 @@ IntrinsicTypeDefaultKinds &IntrinsicTypeDefaultKinds::set_defaultLogicalKind(
int IntrinsicTypeDefaultKinds::GetDefaultKind(TypeCategory category) const {
switch (category) {
case TypeCategory::Integer:
+ case TypeCategory::Unsigned:
return defaultIntegerKind_;
case TypeCategory::Real:
case TypeCategory::Complex:
diff --git a/flang/lib/Evaluate/expression.cpp b/flang/lib/Evaluate/expression.cpp
index 1a65d4c7362fea..9514ac8e3f6565 100644
--- a/flang/lib/Evaluate/expression.cpp
+++ b/flang/lib/Evaluate/expression.cpp
@@ -229,6 +229,12 @@ bool Expr<Type<TypeCategory::Character, KIND>>::operator==(
return u == that.u;
}
+template <int KIND>
+bool Expr<Type<TypeCategory::Unsigned, KIND>>::operator==(
+ const Expr<Type<TypeCategory::Unsigned, KIND>> &that) const {
+ return u == that.u;
+}
+
template <TypeCategory CAT>
bool Expr<SomeKind<CAT>>::operator==(const Expr<SomeKind<CAT>> &that) const {
return u == that.u;
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index b9c75448b75422..b6370239311d4b 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -1086,6 +1086,7 @@ template <typename T>
Expr<T> FoldMINorMAX(
FoldingContext &context, FunctionRef<T> &&funcRef, Ordering order) {
static_assert(T::category == TypeCategory::Integer ||
+ T::category == TypeCategory::Unsigned ||
T::category == TypeCategory::Real ||
T::category == TypeCategory::Character);
auto &args{funcRef.arguments()};
@@ -1191,6 +1192,10 @@ Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction(
template <int KIND>
Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
FoldingContext &context, FunctionRef<Type<TypeCategory::Logical, KIND>> &&);
+template <int KIND>
+Expr<Type<TypeCategory::Unsigned, KIND>> FoldIntrinsicFunction(
+ FoldingContext &context,
+ FunctionRef<Type<TypeCategory::Unsigned, KIND>> &&);
template <typename T>
Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) {
@@ -1869,6 +1874,8 @@ Expr<T> FoldOperation(FoldingContext &context, Negate<T> &&x) {
"INTEGER(%d) negation overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{std::move(negated.value)}};
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ return Expr<T>{Constant<T>{std::move(value->Negate().value)}};
} else {
// REAL & COMPLEX negation: no exceptions possible
return Expr<T>{Constant<T>{value->Negate()}};
@@ -1911,6 +1918,9 @@ Expr<T> FoldOperation(FoldingContext &context, Add<T> &&x) {
"INTEGER(%d) addition overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{sum.value}};
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ return Expr<T>{
+ Constant<T>{folded->first.AddUnsigned(folded->second).value}};
} else {
auto sum{folded->first.Add(
folded->second, context.targetCharacteristics().roundingMode())};
@@ -1939,6 +1949,9 @@ Expr<T> FoldOperation(FoldingContext &context, Subtract<T> &&x) {
"INTEGER(%d) subtraction overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{difference.value}};
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ return Expr<T>{
+ Constant<T>{folded->first.SubtractSigned(folded->second).value}};
} else {
auto difference{folded->first.Subtract(
folded->second, context.targetCharacteristics().roundingMode())};
@@ -1967,6 +1980,9 @@ Expr<T> FoldOperation(FoldingContext &context, Multiply<T> &&x) {
"INTEGER(%d) multiplication overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{product.lower}};
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ return Expr<T>{
+ Constant<T>{folded->first.MultiplyUnsigned(folded->second).lower}};
} else {
auto product{folded->first.Multiply(
folded->second, context.targetCharacteristics().roundingMode())};
@@ -2021,6 +2037,17 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) {
"INTEGER(%d) division overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{quotAndRem.quotient}};
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ auto quotAndRem{folded->first.DivideUnsigned(folded->second)};
+ if (quotAndRem.divisionByZero) {
+ if (context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingException)) {
+ context.messages().Say(common::UsageWarning::FoldingException,
+ "UNSIGNED(%d) division by zero"_warn_en_US, T::kind);
+ }
+ return Expr<T>{std::move(x)};
+ }
+ return Expr<T>{Constant<T>{quotAndRem.quotient}};
} else {
auto quotient{folded->first.Divide(
folded->second, context.targetCharacteristics().roundingMode())};
@@ -2121,6 +2148,10 @@ Expr<T> FoldOperation(FoldingContext &context, Extremum<T> &&x) {
if (folded->first.CompareSigned(folded->second) == x.ordering) {
return Expr<T>{Constant<T>{folded->first}};
}
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ if (folded->first.CompareUnsigned(folded->second) == x.ordering) {
+ return Expr<T>{Constant<T>{folded->first}};
+ }
} else if constexpr (T::category == TypeCategory::Real) {
if (folded->first.IsNotANumber() ||
(folded->first.Compare(folded->second) == Relation::Less) ==
@@ -2166,6 +2197,8 @@ Expr<Type<TypeCategory::Real, KIND>> ToReal(
context.messages().Say(common::UsageWarning::FoldingValueChecks,
"Nonzero bits truncated from BOZ literal constant in REAL intrinsic"_warn_en_US);
}
+ } else if constexpr (std::is_same_v<From, Expr<SomeUnsigned>>) {
+ common::die("ToReal: unsigned");
} else if constexpr (IsNumericCategoryExpr<From>()) {
result = Fold(context, ConvertToType<Result>(std::move(x)));
} else {
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 594a614a5f2e76..e90fb12017b73e 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -535,7 +535,8 @@ template <typename T>
static Expr<T> FoldBitReduction(FoldingContext &context, FunctionRef<T> &&ref,
Scalar<T> (Scalar<T>::*operation)(const Scalar<T> &) const,
Scalar<T> identity) {
- static_assert(T::category == TypeCategory::Integer);
+ 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,
@@ -547,78 +548,17 @@ static Expr<T> FoldBitReduction(FoldingContext &context, FunctionRef<T> &&ref,
return Expr<T>{std::move(ref)};
}
-template <int KIND>
-Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
- FoldingContext &context,
- FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
- using T = Type<TypeCategory::Integer, KIND>;
- using Int4 = Type<TypeCategory::Integer, 4>;
+// Common cases for INTEGER and UNSIGNED
+template <typename T>
+std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
+ FoldingContext &context, FunctionRef<T> &funcRef) {
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};
- if (result.ToInt64() != n &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::FoldingException)) {
- context.messages().Say(common::UsageWarning::FoldingException,
- "Result of intrinsic function '%s' (%jd) overflows its result type"_warn_en_US,
- name, std::intmax_t{n});
- }
- return result;
- }};
- 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> {
- typename Scalar<T>::ValueWithOverflow j{i.ABS()};
- if (j.overflow &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::FoldingException)) {
- context.messages().Say(common::UsageWarning::FoldingException,
- "abs(integer(kind=%d)) folding overflowed"_warn_en_US, KIND);
- }
- return j.value;
- }));
- } else if (name == "bit_size") {
+ using Int4 = Type<TypeCategory::Integer, 4>;
+ if (name == "bit_size") {
return Expr<T>{Scalar<T>::bits};
- } else if (name == "ceiling" || name == "floor" || name == "nint") {
- if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
- // NINT rounds ties away from zero, not to even
- common::RoundingMode mode{name == "ceiling" ? common::RoundingMode::Up
- : name == "floor" ? common::RoundingMode::Down
- : common::RoundingMode::TiesAwayFromZero};
- 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)};
- if (y.flags.test(RealFlag::Overflow) &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::FoldingException)) {
- context.messages().Say(
- common::UsageWarning::FoldingException,
- "%s intrinsic folding overflow"_warn_en_US, name);
- }
- return y.value;
- }));
- },
- 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));
- }
} else if (name == "digits") {
if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
return Expr<T>{common::visit(
@@ -626,6 +566,12 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return Scalar<ResultType<decltype(kx)>>::DIGITS;
},
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)};
} else if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
return Expr<T>{common::visit(
[](const auto &kx) {
@@ -639,19 +585,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
},
cx->u)};
}
- } else if (name == "dim") {
- return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
- ScalarFunc<T, T, T>([&context](const Scalar<T> &x,
- const Scalar<T> &y) -> Scalar<T> {
- auto result{x.DIM(y)};
- if (result.overflow &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::FoldingException)) {
- context.messages().Say(common::UsageWarning::FoldingException,
- "DIM intrinsic folding overflow"_warn_en_US);
- }
- return result.value;
- }));
} else if (name == "dot_product") {
return FoldDotProduct<T>(context, std::move(funcRef));
} else if (name == "dshiftl" || name == "dshiftr") {
@@ -682,66 +615,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
const Scalar<Int4> &shift) -> Scalar<T> {
return std::invoke(fptr, i, j, static_cast<int>(shift.ToInt64()));
}));
- } else if (name == "exponent") {
- if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
- return common::visit(
- [&funcRef, &context](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>>);
- },
- sx->u);
- } else {
- DIE("exponent argument must be real");
- }
- } else if (name == "findloc") {
- return FoldLocation<WhichLocation::Findloc, T>(context, std::move(funcRef));
- } else if (name == "huge") {
- return Expr<T>{Scalar<T>::HUGE()};
- } else if (name == "iachar" || name == "ichar") {
- auto *someChar{UnwrapExpr<Expr<SomeCharacter>>(args[0])};
- CHECK(someChar);
- if (auto len{ToInt64(someChar->LEN())}) {
- if (len.value() < 1) {
- context.messages().Say(
- "Character in intrinsic function %s must have length one"_err_en_US,
- name);
- } else if (len.value() > 1 &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::Portability)) {
- // Do not die, this was not checked before
- context.messages().Say(common::UsageWarning::Portability,
- "Character in intrinsic function %s should have length one"_port_en_US,
- name);
- } else {
- return common::visit(
- [&funcRef, &context, &FromInt64](const auto &str) -> Expr<T> {
- using Char = typename std::decay_t<decltype(str)>::Result;
- (void)FromInt64;
- return FoldElementalIntrinsic<T, Char>(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)));
- }));
-#else // _MSC_VER
- // MSVC 14 get confused by the original code above and
- // ends up emitting an error about passing a std::string
- // to the std::u16string instantiation of
- // 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));
- }));
-#endif // _MSC_VER
- },
- someChar->u);
- }
- }
} else if (name == "iand" || name == "ior" || name == "ieor") {
auto fptr{&Scalar<T>::IAND};
if (name == "iand") { // done in fptr declaration
@@ -827,13 +700,343 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
}
}
- return FoldElementalIntrinsic<T, T, Int4, Int4>(context, std::move(funcRef),
- ScalarFunc<T, T, Int4, Int4>(
- [&](const Scalar<T> &i, const Scalar<Int4> &pos,
- const Scalar<Int4> &len) -> Scalar<T> {
- return i.IBITS(static_cast<int>(pos.ToInt64()),
- static_cast<int>(len.ToInt64()));
- }));
+ return FoldElementalIntrinsic<T, T, Int4, Int4>(context, std::move(funcRef),
+ ScalarFunc<T, T, Int4, Int4>(
+ [&](const Scalar<T> &i, const Scalar<Int4> &pos,
+ const Scalar<Int4> &len) -> Scalar<T> {
+ return i.IBITS(static_cast<int>(pos.ToInt64()),
+ static_cast<int>(len.ToInt64()));
+ }));
+ } else if (name == "int" || name == "uint") {
+ if (auto *expr{UnwrapExpr<Expr<SomeType>>(args[0])}) {
+ return common::visit(
+ [&](auto &&x) -> Expr<T> {
+ 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)));
+ }
+ DIE("int() argument type not valid");
+ },
+ std::move(expr->u));
+ }
+ } else if (name == "iparity") {
+ return FoldBitReduction(
+ context, std::move(funcRef), &Scalar<T>::IEOR, Scalar<T>{});
+ } 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 *shiftVals{shiftCon ? &shiftCon->values() : nullptr};
+ const auto *sizeCon{args.size() == 3
+ ? Folder<Int4>{context, /*forOptionalArgument=*/true}.Folding(
+ args[2])
+ : nullptr};
+ const auto *sizeVals{sizeCon ? &sizeCon->values() : nullptr};
+ if ((argCon && argCon->empty()) || !shiftVals || shiftVals->empty() ||
+ (sizeVals && sizeVals->empty())) {
+ // size= and shift= values don't need to be checked
+ } else {
+ for (const auto &scalar : *shiftVals) {
+ std::int64_t shiftVal{scalar.ToInt64()};
+ if (shiftVal < -T::Scalar::bits) {
+ context.messages().Say(
+ "SHIFT=%jd count for %s is less than %d"_err_en_US,
+ std::intmax_t{shiftVal}, name, -T::Scalar::bits);
+ break;
+ } else if (shiftVal > T::Scalar::bits) {
+ context.messages().Say(
+ "SHIFT=%jd count for %s is greater than %d"_err_en_US,
+ std::intmax_t{shiftVal}, name, T::Scalar::bits);
+ break;
+ }
+ }
+ if (sizeVals) {
+ for (const auto &scalar : *sizeVals) {
+ std::int64_t sizeVal{scalar.ToInt64()};
+ if (sizeVal <= 0) {
+ context.messages().Say(
+ "SIZE=%jd count for ishftc is not positive"_err_en_US,
+ std::intmax_t{sizeVal}, name);
+ break;
+ } else if (sizeVal > T::Scalar::bits) {
+ context.messages().Say(
+ "SIZE=%jd count for ishftc is greater than %d"_err_en_US,
+ std::intmax_t{sizeVal}, T::Scalar::bits);
+ break;
+ }
+ }
+ if (shiftVals->size() == 1 || sizeVals->size() == 1 ||
+ shiftVals->size() == sizeVals->size()) {
+ auto iters{std::max(shiftVals->size(), sizeVals->size())};
+ for (std::size_t j{0}; j < iters; ++j) {
+ auto shiftVal{static_cast<int>(
+ (*shiftVals)[j % shiftVals->size()].ToInt64())};
+ auto sizeVal{
+ static_cast<int>((*sizeVals)[j % sizeVals->size()].ToInt64())};
+ if (sizeVal > 0 && std::abs(shiftVal) > sizeVal) {
+ context.messages().Say(
+ "SHIFT=%jd count for ishftc is greater in magnitude than SIZE=%jd"_err_en_US,
+ std::intmax_t{shiftVal}, std::intmax_t{sizeVal});
+ break;
+ }
+ }
+ }
+ }
+ }
+ if (name == "ishft") {
+ return FoldElementalIntrinsic<T, T, Int4>(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),
+ 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),
+ ScalarFunc<T, T, Int4, Int4>(
+ [&](const Scalar<T> &i, const Scalar<Int4> &shift,
+ const Scalar<Int4> &size) -> Scalar<T> {
+ auto shiftVal{static_cast<int>(shift.ToInt64())};
+ auto sizeVal{static_cast<int>(size.ToInt64())};
+ return i.ISHFTC(shiftVal, sizeVal);
+ }),
+ /*hasOptionalArgument=*/true);
+ }
+ } else if (name == "izext" || name == "jzext") {
+ if (args.size() == 1) {
+ 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))};
+ *expr =
+ Fold(context, Expr<SomeKind<T::category>>{std::move(converted)});
+ args.emplace_back(AsGenericExpr(Expr<T>{Scalar<T>{255}}));
+ return FoldIntrinsicFunction(context, std::move(funcRef));
+ }
+ }
+ } else if (name == "maskl" || name == "maskr") {
+ // Argument can be of any kind but value has to be smaller than BIT_SIZE.
+ // It can be safely converted to Int4 to simplify.
+ const auto fptr{name == "maskl" ? &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()));
+ }));
+ } 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),
+ RelationalOperator::GT, T::Scalar::Least());
+ } else if (name == "merge_bits") {
+ return FoldElementalIntrinsic<T, T, T, T>(
+ 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), RelationalOperator::LT, T::Scalar::HUGE());
+ } else if (name == "not") {
+ return FoldElementalIntrinsic<T, T>(
+ context, std::move(funcRef), &Scalar<T>::NOT);
+ } else if (name == "product") {
+ return FoldProduct<T>(context, std::move(funcRef), Scalar<T>{1});
+ } else if (name == "radix") {
+ return Expr<T>{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.
+ auto fptr{&Scalar<T>::SHIFTA};
+ if (name == "shifta") { // done in fptr definition
+ } else if (name == "shiftr") {
+ fptr = &Scalar<T>::SHIFTR;
+ } else if (name == "shiftl") {
+ fptr = &Scalar<T>::SHIFTL;
+ } else {
+ common::die("missing case to fold intrinsic function %s", name.c_str());
+ }
+ if (const auto *argCon{Folder<T>(context).Folding(args[0])};
+ argCon && argCon->empty()) {
+ } else if (const auto *shiftCon{Folder<Int4>(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);
+ break;
+ } else if (shiftVal > T::Scalar::bits) {
+ context.messages().Say(
+ "SHIFT=%jd count for %s is greater than %d"_err_en_US,
+ std::intmax_t{shiftVal}, name, T::Scalar::bits);
+ break;
+ }
+ }
+ }
+ return FoldElementalIntrinsic<T, T, Int4>(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()));
+ }));
+ } else if (name == "sum") {
+ return FoldSum<T>(context, std::move(funcRef));
+ }
+ return std::nullopt;
+}
+
+template <int KIND>
+Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
+ FoldingContext &context,
+ FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
+ 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};
+ if (result.ToInt64() != n &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingException)) {
+ context.messages().Say(common::UsageWarning::FoldingException,
+ "Result of intrinsic function '%s' (%jd) overflows its result type"_warn_en_US,
+ name, std::intmax_t{n});
+ }
+ return result;
+ }};
+
+ 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> {
+ typename Scalar<T>::ValueWithOverflow j{i.ABS()};
+ if (j.overflow &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingException)) {
+ context.messages().Say(common::UsageWarning::FoldingException,
+ "abs(integer(kind=%d)) folding overflowed"_warn_en_US, KIND);
+ }
+ return j.value;
+ }));
+ } else if (name == "ceiling" || name == "floor" || name == "nint") {
+ if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
+ // NINT rounds ties away from zero, not to even
+ common::RoundingMode mode{name == "ceiling" ? common::RoundingMode::Up
+ : name == "floor" ? common::RoundingMode::Down
+ : common::RoundingMode::TiesAwayFromZero};
+ 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)};
+ if (y.flags.test(RealFlag::Overflow) &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingException)) {
+ context.messages().Say(
+ common::UsageWarning::FoldingException,
+ "%s intrinsic folding overflow"_warn_en_US, name);
+ }
+ return y.value;
+ }));
+ },
+ 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));
+ }
+ } else if (name == "dim") {
+ return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
+ ScalarFunc<T, T, T>(
+ [&context](const Scalar<T> &x, const Scalar<T> &y) -> Scalar<T> {
+ auto result{x.DIM(y)};
+ if (result.overflow &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingException)) {
+ context.messages().Say(common::UsageWarning::FoldingException,
+ "DIM intrinsic folding overflow"_warn_en_US);
+ }
+ return result.value;
+ }));
+ } else if (name == "exponent") {
+ if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
+ return common::visit(
+ [&funcRef, &context](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>>);
+ },
+ sx->u);
+ } else {
+ DIE("exponent argument must be real");
+ }
+ } else if (name == "findloc") {
+ return FoldLocation<WhichLocation::Findloc, T>(context, std::move(funcRef));
+ } else if (name == "huge") {
+ return Expr<T>{Scalar<T>::HUGE()};
+ } else if (name == "iachar" || name == "ichar") {
+ auto *someChar{UnwrapExpr<Expr<SomeCharacter>>(args[0])};
+ CHECK(someChar);
+ if (auto len{ToInt64(someChar->LEN())}) {
+ if (len.value() < 1) {
+ context.messages().Say(
+ "Character in intrinsic function %s must have length one"_err_en_US,
+ name);
+ } else if (len.value() > 1 &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::Portability)) {
+ // Do not die, this was not checked before
+ context.messages().Say(common::UsageWarning::Portability,
+ "Character in intrinsic function %s should have length one"_port_en_US,
+ name);
+ } else {
+ return common::visit(
+ [&funcRef, &context, &FromInt64](const auto &str) -> Expr<T> {
+ using Char = typename std::decay_t<decltype(str)>::Result;
+ (void)FromInt64;
+ return FoldElementalIntrinsic<T, Char>(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)));
+ }));
+#else // _MSC_VER
+ // MSVC 14 get confused by the original code above and
+ // ends up emitting an error about passing a std::string
+ // to the std::u16string instantiation of
+ // 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));
+ }));
+#endif // _MSC_VER
+ },
+ someChar->u);
+ }
+ }
} else if (name == "index" || name == "scan" || name == "verify") {
if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
return common::visit(
@@ -873,19 +1076,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
} else {
DIE("first argument must be CHARACTER");
}
- } else if (name == "int") {
- if (auto *expr{UnwrapExpr<Expr<SomeType>>(args[0])}) {
- return common::visit(
- [&](auto &&x) -> Expr<T> {
- 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)));
- }
- DIE("int() argument type not valid");
- },
- std::move(expr->u));
- }
} else if (name == "int_ptr_kind") {
return Expr<T>{8};
} else if (name == "kind") {
@@ -906,109 +1096,11 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return Expr<T>{dyType->kind()};
}
}
- } else if (name == "iparity") {
- return FoldBitReduction(
- context, std::move(funcRef), &Scalar<T>::IEOR, Scalar<T>{});
- } 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 *shiftVals{shiftCon ? &shiftCon->values() : nullptr};
- const auto *sizeCon{args.size() == 3
- ? Folder<Int4>{context, /*forOptionalArgument=*/true}.Folding(
- args[2])
- : nullptr};
- const auto *sizeVals{sizeCon ? &sizeCon->values() : nullptr};
- if ((argCon && argCon->empty()) || !shiftVals || shiftVals->empty() ||
- (sizeVals && sizeVals->empty())) {
- // size= and shift= values don't need to be checked
- } else {
- for (const auto &scalar : *shiftVals) {
- std::int64_t shiftVal{scalar.ToInt64()};
- if (shiftVal < -T::Scalar::bits) {
- context.messages().Say(
- "SHIFT=%jd count for %s is less than %d"_err_en_US,
- std::intmax_t{shiftVal}, name, -T::Scalar::bits);
- break;
- } else if (shiftVal > T::Scalar::bits) {
- context.messages().Say(
- "SHIFT=%jd count for %s is greater than %d"_err_en_US,
- std::intmax_t{shiftVal}, name, T::Scalar::bits);
- break;
- }
- }
- if (sizeVals) {
- for (const auto &scalar : *sizeVals) {
- std::int64_t sizeVal{scalar.ToInt64()};
- if (sizeVal <= 0) {
- context.messages().Say(
- "SIZE=%jd count for ishftc is not positive"_err_en_US,
- std::intmax_t{sizeVal}, name);
- break;
- } else if (sizeVal > T::Scalar::bits) {
- context.messages().Say(
- "SIZE=%jd count for ishftc is greater than %d"_err_en_US,
- std::intmax_t{sizeVal}, T::Scalar::bits);
- break;
- }
- }
- if (shiftVals->size() == 1 || sizeVals->size() == 1 ||
- shiftVals->size() == sizeVals->size()) {
- auto iters{std::max(shiftVals->size(), sizeVals->size())};
- for (std::size_t j{0}; j < iters; ++j) {
- auto shiftVal{static_cast<int>(
- (*shiftVals)[j % shiftVals->size()].ToInt64())};
- auto sizeVal{
- static_cast<int>((*sizeVals)[j % sizeVals->size()].ToInt64())};
- if (sizeVal > 0 && std::abs(shiftVal) > sizeVal) {
- context.messages().Say(
- "SHIFT=%jd count for ishftc is greater in magnitude than SIZE=%jd"_err_en_US,
- std::intmax_t{shiftVal}, std::intmax_t{sizeVal});
- break;
- }
- }
- }
- }
- }
- if (name == "ishft") {
- return FoldElementalIntrinsic<T, T, Int4>(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),
- 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),
- ScalarFunc<T, T, Int4, Int4>(
- [&](const Scalar<T> &i, const Scalar<Int4> &shift,
- const Scalar<Int4> &size) -> Scalar<T> {
- auto shiftVal{static_cast<int>(shift.ToInt64())};
- auto sizeVal{static_cast<int>(size.ToInt64())};
- return i.ISHFTC(shiftVal, sizeVal);
- }),
- /*hasOptionalArgument=*/true);
- }
- } else if (name == "izext" || name == "jzext") {
- if (args.size() == 1) {
- if (auto *expr{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
- // Rewrite to IAND(INT(n,k),255_k) for k=KIND(T)
- intrinsic->name = "iand";
- auto converted{ConvertToType<T>(std::move(*expr))};
- *expr = Fold(context, Expr<SomeInteger>{std::move(converted)});
- args.emplace_back(AsGenericExpr(Expr<T>{Scalar<T>{255}}));
- return FoldIntrinsicFunction(context, std::move(funcRef));
- }
- }
} else if (name == "lbound") {
return LBOUND(context, std::move(funcRef));
} else if (name == "leadz" || name == "trailz" || name == "poppar" ||
name == "popcnt") {
- if (auto *sn{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
+ if (auto *sn{UnwrapExpr<Expr<SomeKind<T::category>>>(args[0])}) {
return common::visit(
[&funcRef, &context, &name](const auto &n) -> Expr<T> {
using TI = typename std::decay_t<decltype(n)>::Result;
@@ -1072,18 +1164,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
} else {
DIE("len_trim() argument must be of character type");
}
- } else if (name == "maskl" || name == "maskr") {
- // Argument can be of any kind but value has to be smaller than BIT_SIZE.
- // It can be safely converted to Int4 to simplify.
- const auto fptr{name == "maskl" ? &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()));
- }));
- } 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 == "max0" || name == "max1") {
return RewriteSpecificMINorMAX(context, std::move(funcRef));
} else if (name == "maxexponent") {
@@ -1097,14 +1177,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
} else if (name == "maxloc") {
return FoldLocation<WhichLocation::Maxloc, T>(context, std::move(funcRef));
- } else if (name == "maxval") {
- return FoldMaxvalMinval<T>(context, std::move(funcRef),
- RelationalOperator::GT, T::Scalar::Least());
- } else if (name == "merge_bits") {
- return FoldElementalIntrinsic<T, T, T, T>(
- context, std::move(funcRef), &Scalar<T>::MERGE_BITS);
- } else if (name == "min") {
- return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
} else if (name == "min0" || name == "min1") {
return RewriteSpecificMINorMAX(context, std::move(funcRef));
} else if (name == "minexponent") {
@@ -1118,9 +1190,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
} else if (name == "minloc") {
return FoldLocation<WhichLocation::Minloc, T>(context, std::move(funcRef));
- } else if (name == "minval") {
- return FoldMaxvalMinval<T>(
- context, std::move(funcRef), RelationalOperator::LT, T::Scalar::HUGE());
} else if (name == "mod") {
bool badPConst{false};
if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
@@ -1179,9 +1248,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
return result.value;
}));
- } else if (name == "not") {
- return FoldElementalIntrinsic<T, T>(
- context, std::move(funcRef), &Scalar<T>::NOT);
} else if (name == "precision") {
if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
return Expr<T>{common::visit(
@@ -1196,10 +1262,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
},
cx->u)};
}
- } else if (name == "product") {
- return FoldProduct<T>(context, std::move(funcRef), Scalar<T>{1});
- } else if (name == "radix") {
- return Expr<T>{2};
} else if (name == "range") {
if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
return Expr<T>{common::visit(
@@ -1207,6 +1269,12 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return Scalar<ResultType<decltype(kx)>>::RANGE;
},
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)};
} else if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
return Expr<T>{common::visit(
[](const auto &kx) {
@@ -1246,7 +1314,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return Expr<T>{SelectedCharKind(*value, defaultKind)};
}
}
- } else if (name == "selected_int_kind") {
+ } else if (name == "selected_int_kind" || name == "selected_unsigned_kind") {
if (auto p{ToInt64(args[0])}) {
return Expr<T>{context.targetCharacteristics().SelectedIntKind(*p)};
}
@@ -1270,40 +1338,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return Fold(context, ConvertToType<T>(std::move(*shapeExpr)));
}
}
- } 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.
- auto fptr{&Scalar<T>::SHIFTA};
- if (name == "shifta") { // done in fptr definition
- } else if (name == "shiftr") {
- fptr = &Scalar<T>::SHIFTR;
- } else if (name == "shiftl") {
- fptr = &Scalar<T>::SHIFTL;
- } else {
- common::die("missing case to fold intrinsic function %s", name.c_str());
- }
- if (const auto *argCon{Folder<T>(context).Folding(args[0])};
- argCon && argCon->empty()) {
- } else if (const auto *shiftCon{Folder<Int4>(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);
- break;
- } else if (shiftVal > T::Scalar::bits) {
- context.messages().Say(
- "SHIFT=%jd count for %s is greater than %d"_err_en_US,
- std::intmax_t{shiftVal}, name, T::Scalar::bits);
- break;
- }
- }
- }
- return FoldElementalIntrinsic<T, T, Int4>(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()));
- }));
} else if (name == "sign") {
return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
ScalarFunc<T, T, T>([&context](const Scalar<T> &j,
@@ -1353,8 +1387,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
Fold(context, Expr<T>{8} * ConvertToType<T>(std::move(*bytes)))};
}
}
- } else if (name == "sum") {
- return FoldSum<T>(context, std::move(funcRef));
} else if (name == "ubound") {
return UBOUND(context, std::move(funcRef));
} else if (name == "__builtin_numeric_storage_size") {
@@ -1382,6 +1414,52 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return Expr<T>{std::move(funcRef)};
}
+template <int KIND>
+Expr<Type<TypeCategory::Unsigned, KIND>> FoldIntrinsicFunction(
+ FoldingContext &context,
+ FunctionRef<Type<TypeCategory::Unsigned, KIND>> &&funcRef) {
+ 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()};
+ } else if (name == "mod" || name == "modulo") {
+ bool badPConst{false};
+ if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
+ *pExpr = Fold(context, std::move(*pExpr));
+ if (auto pConst{GetScalarConstantValue<T>(*pExpr)}; pConst &&
+ pConst->IsZero() &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
+ context.messages().Say(common::UsageWarning::FoldingAvoidsRuntimeCrash,
+ "%s: P argument is zero"_warn_en_US, name);
+ badPConst = true;
+ }
+ }
+ return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
+ ScalarFuncWithContext<T, T, T>(
+ [badPConst, &name](FoldingContext &context, const Scalar<T> &x,
+ const Scalar<T> &y) -> Scalar<T> {
+ auto quotRem{x.DivideUnsigned(y)};
+ if (context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
+ if (!badPConst && quotRem.divisionByZero) {
+ context.messages().Say(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash,
+ "%s() by zero"_warn_en_US, name);
+ }
+ }
+ return quotRem.remainder;
+ }));
+ }
+ return Expr<T>{std::move(funcRef)};
+}
+
// Substitutes a bare type parameter reference with its value if it has one now
// in an instantiation. Bare LEN type parameters are substituted only when
// the known value is constant.
@@ -1460,5 +1538,7 @@ std::optional<std::int64_t> ToInt64(const ActualArgument &arg) {
#pragma warning(disable : 4661)
#endif
FOR_EACH_INTEGER_KIND(template class ExpressionBase, )
+FOR_EACH_UNSIGNED_KIND(template class ExpressionBase, )
template class ExpressionBase<SomeInteger>;
+template class ExpressionBase<SomeUnsigned>;
} // namespace Fortran::evaluate
diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp
index f5bbe7e4293359..2c12abf0a887a3 100644
--- a/flang/lib/Evaluate/fold-logical.cpp
+++ b/flang/lib/Evaluate/fold-logical.cpp
@@ -44,6 +44,7 @@ static Expr<T> FoldAllAnyParity(FoldingContext &context, FunctionRef<T> &&ref,
// OUT_OF_RANGE(x,mold[,round]) references are entirely rewritten here into
// expressions, which are then folded into constants when 'x' and 'round'
// 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) {
@@ -912,6 +913,9 @@ Expr<LogicalResult> FoldOperation(
if constexpr (T::category == TypeCategory::Integer) {
result =
Satisfies(relation.opr, folded->first.CompareSigned(folded->second));
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ result = Satisfies(
+ relation.opr, folded->first.CompareUnsigned(folded->second));
} else if constexpr (T::category == TypeCategory::Real) {
result = Satisfies(relation.opr, folded->first.Compare(folded->second));
} else if constexpr (T::category == TypeCategory::Complex) {
diff --git a/flang/lib/Evaluate/fold-matmul.h b/flang/lib/Evaluate/fold-matmul.h
index be9c547d45286c..36a1aff1a5eff1 100644
--- a/flang/lib/Evaluate/fold-matmul.h
+++ b/flang/lib/Evaluate/fold-matmul.h
@@ -75,13 +75,13 @@ static Expr<T> FoldMatmul(FoldingContext &context, FunctionRef<T> &&funcRef) {
sum = std::move(added.value);
}
} else if constexpr (T::category == TypeCategory::Integer) {
- // Don't use Kahan summation in numeric MATMUL folding;
- // the runtime doesn't use it, and results should match.
auto product{aElt.MultiplySigned(bElt)};
overflow |= product.SignedMultiplicationOverflowed();
auto added{sum.AddSigned(product.lower)};
overflow |= added.overflow;
sum = std::move(added.value);
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ sum = sum.AddUnsigned(aElt.MultiplyUnsigned(bElt).lower).value;
} else {
static_assert(T::category == TypeCategory::Logical);
sum = sum.OR(aElt.AND(bElt));
diff --git a/flang/lib/Evaluate/fold-reduction.h b/flang/lib/Evaluate/fold-reduction.h
index 8ca0794ab0fc7c..75134100cfa235 100644
--- a/flang/lib/Evaluate/fold-reduction.h
+++ b/flang/lib/Evaluate/fold-reduction.h
@@ -81,6 +81,13 @@ static Expr<T> FoldDotProduct(
overflow |= next.overflow;
sum = std::move(next.value);
}
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ Expr<T> products{
+ Fold(context, Expr<T>{Constant<T>{*va}} * Expr<T>{Constant<T>{*vb}})};
+ Constant<T> &cProducts{DEREF(UnwrapConstantValue<T>(products))};
+ for (const Element &x : cProducts.values()) {
+ sum = sum.AddUnsigned(x).value;
+ }
} else {
static_assert(T::category == TypeCategory::Real);
Expr<T> products{
@@ -273,13 +280,14 @@ template <typename T>
static Expr<T> FoldMaxvalMinval(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 accumulator{opr, context, arrayAndMask->array};
+ MaxvalMinvalAccumulator<T> accumulator{opr, context, arrayAndMask->array};
return Expr<T>{DoReduction<T>(
arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)};
}
@@ -296,6 +304,8 @@ template <typename T> class ProductAccumulator {
auto prod{element.MultiplySigned(array_.At(at))};
overflow_ |= prod.SignedMultiplicationOverflowed();
element = prod.lower;
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ element = element.MultiplyUnsigned(array_.At(at)).lower;
} else { // Real & Complex
auto prod{element.Multiply(array_.At(at))};
overflow_ |= prod.flags.test(RealFlag::Overflow);
@@ -314,6 +324,7 @@ template <typename T>
static Expr<T> FoldProduct(
FoldingContext &context, FunctionRef<T> &&ref, Scalar<T> identity) {
static_assert(T::category == TypeCategory::Integer ||
+ T::category == TypeCategory::Unsigned ||
T::category == TypeCategory::Real ||
T::category == TypeCategory::Complex);
std::optional<int> dim;
@@ -347,6 +358,8 @@ template <typename T> class SumAccumulator {
auto sum{element.AddSigned(array_.At(at))};
overflow_ |= sum.overflow;
element = sum.value;
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ element = element.AddUnsigned(array_.At(at)).value;
} else { // Real & Complex: use Kahan summation
auto next{array_.At(at).Add(correction_, rounding_)};
overflow_ |= next.flags.test(RealFlag::Overflow);
@@ -361,7 +374,8 @@ template <typename T> class SumAccumulator {
}
bool overflow() const { return overflow_; }
void Done([[maybe_unused]] Element &element) {
- if constexpr (T::category != TypeCategory::Integer) {
+ if constexpr (T::category != TypeCategory::Integer &&
+ T::category != TypeCategory::Unsigned) {
auto corrected{element.Add(correction_, rounding_)};
overflow_ |= corrected.flags.test(RealFlag::Overflow);
correction_ = Scalar<T>{};
@@ -379,6 +393,7 @@ template <typename T> class SumAccumulator {
template <typename T>
static Expr<T> FoldSum(FoldingContext &context, FunctionRef<T> &&ref) {
static_assert(T::category == TypeCategory::Integer ||
+ T::category == TypeCategory::Unsigned ||
T::category == TypeCategory::Real ||
T::category == TypeCategory::Complex);
using Element = typename Constant<T>::Element;
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index 3581b9c96c19bf..cc9046cf452bb9 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -85,6 +85,8 @@ llvm::raw_ostream &ConstantBase<RESULT, VALUE>::AsFortran(
} else {
o << ".false." << '_' << Result::kind;
}
+ } else if constexpr (Result::category == TypeCategory::Unsigned) {
+ o << value.UnsignedDecimal() << "U_" << Result::kind;
} else {
StructureConstructor{result_.derivedTypeSpec(), value}.AsFortran(o);
}
@@ -478,7 +480,8 @@ llvm::raw_ostream &Convert<TO, FROMCAT>::AsFortran(llvm::raw_ostream &o) const {
TO::category == TypeCategory::Real ||
TO::category == TypeCategory::Complex ||
TO::category == TypeCategory::Character ||
- TO::category == TypeCategory::Logical,
+ TO::category == TypeCategory::Logical ||
+ TO::category == TypeCategory::Unsigned,
"Convert<> to bad category!");
if constexpr (TO::category == TypeCategory::Character) {
this->left().AsFortran(o << "achar(iachar(") << ')';
@@ -488,8 +491,10 @@ llvm::raw_ostream &Convert<TO, FROMCAT>::AsFortran(llvm::raw_ostream &o) const {
this->left().AsFortran(o << "real(");
} else if constexpr (TO::category == TypeCategory::Complex) {
this->left().AsFortran(o << "cmplx(");
- } else {
+ } else if constexpr (TO::category == TypeCategory::Logical) {
this->left().AsFortran(o << "logical(");
+ } else {
+ this->left().AsFortran(o << "uint(");
}
return o << ",kind=" << TO::kind << ')';
}
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 4271faa0db12bf..86c2cd24f57cd0 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -60,19 +60,25 @@ class FoldingContext;
// AnyType + Rank::arrayOrAssumedRank, or AnyType + Kind::addressable.
using CategorySet = common::EnumSet<TypeCategory, 8>;
static constexpr CategorySet IntType{TypeCategory::Integer};
+static constexpr CategorySet UnsignedType{TypeCategory::Unsigned};
static constexpr CategorySet RealType{TypeCategory::Real};
static constexpr CategorySet ComplexType{TypeCategory::Complex};
static constexpr CategorySet CharType{TypeCategory::Character};
static constexpr CategorySet LogicalType{TypeCategory::Logical};
+static constexpr CategorySet IntOrUnsignedType{IntType | UnsignedType};
static constexpr CategorySet IntOrRealType{IntType | RealType};
+static constexpr CategorySet IntUnsignedOrRealType{
+ IntType | UnsignedType | RealType};
static constexpr CategorySet IntOrRealOrCharType{IntType | RealType | CharType};
static constexpr CategorySet IntOrLogicalType{IntType | LogicalType};
static constexpr CategorySet FloatingType{RealType | ComplexType};
-static constexpr CategorySet NumericType{IntType | RealType | ComplexType};
-static constexpr CategorySet RelatableType{IntType | RealType | CharType};
+static constexpr CategorySet NumericType{
+ IntType | UnsignedType | RealType | ComplexType};
+static constexpr CategorySet RelatableType{
+ IntType | UnsignedType | RealType | CharType};
static constexpr CategorySet DerivedType{TypeCategory::Derived};
static constexpr CategorySet IntrinsicType{
- IntType | RealType | ComplexType | CharType | LogicalType};
+ IntType | UnsignedType | RealType | ComplexType | CharType | LogicalType};
static constexpr CategorySet AnyType{IntrinsicType | DerivedType};
ENUM_CLASS(KindCode, none, defaultIntegerKind,
@@ -135,8 +141,12 @@ static constexpr TypePattern SubscriptInt{IntType, KindCode::subscript};
// Match any kind of some intrinsic or derived types
static constexpr TypePattern AnyInt{IntType, KindCode::any};
+static constexpr TypePattern AnyUnsigned{UnsignedType, KindCode::any};
+static constexpr TypePattern AnyIntOrUnsigned{IntOrUnsignedType, KindCode::any};
static constexpr TypePattern AnyReal{RealType, KindCode::any};
static constexpr TypePattern AnyIntOrReal{IntOrRealType, KindCode::any};
+static constexpr TypePattern AnyIntUnsignedOrReal{
+ IntUnsignedOrRealType, KindCode::any};
static constexpr TypePattern AnyIntOrRealOrChar{
IntOrRealOrCharType, KindCode::any};
static constexpr TypePattern AnyIntOrLogical{IntOrLogicalType, KindCode::any};
@@ -158,8 +168,12 @@ static constexpr TypePattern Addressable{AnyType, KindCode::addressable};
// Can be used to specify a result so long as at least one argument is
// a "Same".
static constexpr TypePattern SameInt{IntType, KindCode::same};
+static constexpr TypePattern SameIntOrUnsigned{
+ IntOrUnsignedType, KindCode::same};
static constexpr TypePattern SameReal{RealType, KindCode::same};
static constexpr TypePattern SameIntOrReal{IntOrRealType, KindCode::same};
+static constexpr TypePattern SameIntUnsignedOrReal{
+ IntUnsignedOrRealType, KindCode::same};
static constexpr TypePattern SameComplex{ComplexType, KindCode::same};
static constexpr TypePattern SameFloating{FloatingType, KindCode::same};
static constexpr TypePattern SameNumeric{NumericType, KindCode::same};
@@ -178,7 +192,12 @@ static constexpr TypePattern SameType{AnyType, KindCode::same};
// universal extension feature.
static constexpr TypePattern OperandReal{RealType, KindCode::operand};
static constexpr TypePattern OperandInt{IntType, KindCode::operand};
+static constexpr TypePattern OperandUnsigned{UnsignedType, KindCode::operand};
+static constexpr TypePattern OperandIntOrUnsigned{
+ IntOrUnsignedType, KindCode::operand};
static constexpr TypePattern OperandIntOrReal{IntOrRealType, KindCode::operand};
+static constexpr TypePattern OperandIntUnsignedOrReal{
+ IntUnsignedOrRealType, KindCode::operand};
// For ASSOCIATED, the first argument is a typeless pointer
static constexpr TypePattern AnyPointer{AnyType, KindCode::nullPointerType};
@@ -189,6 +208,8 @@ static constexpr TypePattern ResultNumeric{NumericType, KindCode::likeMultiply};
// Result types with known category and KIND=
static constexpr TypePattern KINDInt{IntType, KindCode::effectiveKind};
+static constexpr TypePattern KINDUnsigned{
+ UnsignedType, KindCode::effectiveKind};
static constexpr TypePattern KINDReal{RealType, KindCode::effectiveKind};
static constexpr TypePattern KINDComplex{ComplexType, KindCode::effectiveKind};
static constexpr TypePattern KINDChar{CharType, KindCode::effectiveKind};
@@ -366,24 +387,24 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"x", SameReal, Rank::scalar}},
SameReal, Rank::vector, IntrinsicClass::transformationalFunction},
{"bge",
- {{"i", AnyInt, Rank::elementalOrBOZ},
- {"j", AnyInt, Rank::elementalOrBOZ}},
+ {{"i", AnyIntOrUnsigned, Rank::elementalOrBOZ},
+ {"j", AnyIntOrUnsigned, Rank::elementalOrBOZ}},
DefaultLogical},
{"bgt",
- {{"i", AnyInt, Rank::elementalOrBOZ},
- {"j", AnyInt, Rank::elementalOrBOZ}},
+ {{"i", AnyIntOrUnsigned, Rank::elementalOrBOZ},
+ {"j", AnyIntOrUnsigned, Rank::elementalOrBOZ}},
DefaultLogical},
{"bit_size",
{{"i", SameInt, Rank::anyOrAssumedRank, Optionality::required,
common::Intent::In, {ArgFlag::canBeMoldNull}}},
SameInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"ble",
- {{"i", AnyInt, Rank::elementalOrBOZ},
- {"j", AnyInt, Rank::elementalOrBOZ}},
+ {{"i", AnyIntOrUnsigned, Rank::elementalOrBOZ},
+ {"j", AnyIntOrUnsigned, Rank::elementalOrBOZ}},
DefaultLogical},
{"blt",
- {{"i", AnyInt, Rank::elementalOrBOZ},
- {"j", AnyInt, Rank::elementalOrBOZ}},
+ {{"i", AnyIntOrUnsigned, Rank::elementalOrBOZ},
+ {"j", AnyIntOrUnsigned, Rank::elementalOrBOZ}},
DefaultLogical},
{"btest", {{"i", AnyInt, Rank::elementalOrBOZ}, {"pos", AnyInt}},
DefaultLogical},
@@ -409,8 +430,9 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
SameType, Rank::conformable, IntrinsicClass::transformationalFunction},
{"dble", {{"a", AnyNumeric, Rank::elementalOrBOZ}}, DoublePrecision},
{"digits",
- {{"x", AnyIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
+ {{"x", AnyIntUnsignedOrReal, Rank::anyOrAssumedRank,
+ Optionality::required, common::Intent::In,
+ {ArgFlag::canBeMoldNull}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"dim", {{"x", OperandIntOrReal}, {"y", OperandIntOrReal}},
OperandIntOrReal},
@@ -429,15 +451,17 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
ResultNumeric, Rank::scalar, IntrinsicClass::transformationalFunction},
{"dprod", {{"x", DefaultReal}, {"y", DefaultReal}}, DoublePrecision},
{"dshiftl",
- {{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ},
- {"shift", AnyInt}},
- SameInt},
- {"dshiftl", {{"i", BOZ}, {"j", SameInt}, {"shift", AnyInt}}, SameInt},
+ {{"i", SameIntOrUnsigned},
+ {"j", SameIntOrUnsigned, Rank::elementalOrBOZ}, {"shift", AnyInt}},
+ SameIntOrUnsigned},
+ {"dshiftl", {{"i", BOZ}, {"j", SameIntOrUnsigned}, {"shift", AnyInt}},
+ SameIntOrUnsigned},
{"dshiftr",
- {{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ},
+ {{"i", SameIntOrUnsigned}, {"j", SameInt, Rank::elementalOrBOZ},
{"shift", AnyInt}},
- SameInt},
- {"dshiftr", {{"i", BOZ}, {"j", SameInt}, {"shift", AnyInt}}, SameInt},
+ SameIntOrUnsigned},
+ {"dshiftr", {{"i", BOZ}, {"j", SameIntOrUnsigned}, {"shift", AnyInt}},
+ SameIntOrUnsigned},
{"eoshift",
{{"array", SameIntrinsic, Rank::array},
{"shift", AnyInt, Rank::dimRemovedOrScalar},
@@ -527,33 +551,53 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"getpid", {}, DefaultInt},
{"getuid", {}, DefaultInt},
{"huge",
- {{"x", SameIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
- SameIntOrReal, Rank::scalar, IntrinsicClass::inquiryFunction},
+ {{"x", SameIntUnsignedOrReal, Rank::anyOrAssumedRank,
+ Optionality::required, common::Intent::In,
+ {ArgFlag::canBeMoldNull}}},
+ SameIntUnsignedOrReal, Rank::scalar, IntrinsicClass::inquiryFunction},
{"hypot", {{"x", OperandReal}, {"y", OperandReal}}, OperandReal},
{"iachar", {{"c", AnyChar}, DefaultingKIND}, KINDInt},
- {"iall", {{"array", SameInt, Rank::array}, RequiredDIM, OptionalMASK},
- SameInt, Rank::dimReduced, IntrinsicClass::transformationalFunction},
- {"iall", {{"array", SameInt, Rank::array}, MissingDIM, OptionalMASK},
- SameInt, Rank::scalar, IntrinsicClass::transformationalFunction},
- {"iany", {{"array", SameInt, Rank::array}, RequiredDIM, OptionalMASK},
- SameInt, Rank::dimReduced, IntrinsicClass::transformationalFunction},
- {"iany", {{"array", SameInt, Rank::array}, MissingDIM, OptionalMASK},
- SameInt, Rank::scalar, IntrinsicClass::transformationalFunction},
- {"iparity", {{"array", SameInt, Rank::array}, RequiredDIM, OptionalMASK},
- SameInt, Rank::dimReduced, IntrinsicClass::transformationalFunction},
- {"iparity", {{"array", SameInt, Rank::array}, MissingDIM, OptionalMASK},
- SameInt, Rank::scalar, IntrinsicClass::transformationalFunction},
+ {"iall",
+ {{"array", SameIntOrUnsigned, Rank::array}, RequiredDIM, OptionalMASK},
+ SameIntOrUnsigned, Rank::dimReduced,
+ IntrinsicClass::transformationalFunction},
+ {"iall",
+ {{"array", SameIntOrUnsigned, Rank::array}, MissingDIM, OptionalMASK},
+ SameIntOrUnsigned, Rank::scalar,
+ IntrinsicClass::transformationalFunction},
+ {"iany",
+ {{"array", SameIntOrUnsigned, Rank::array}, RequiredDIM, OptionalMASK},
+ SameIntOrUnsigned, Rank::dimReduced,
+ IntrinsicClass::transformationalFunction},
+ {"iany",
+ {{"array", SameIntOrUnsigned, Rank::array}, MissingDIM, OptionalMASK},
+ SameIntOrUnsigned, Rank::scalar,
+ IntrinsicClass::transformationalFunction},
+ {"iparity",
+ {{"array", SameIntOrUnsigned, Rank::array}, RequiredDIM, OptionalMASK},
+ SameIntOrUnsigned, Rank::dimReduced,
+ IntrinsicClass::transformationalFunction},
+ {"iparity",
+ {{"array", SameIntOrUnsigned, Rank::array}, MissingDIM, OptionalMASK},
+ SameIntOrUnsigned, Rank::scalar,
+ IntrinsicClass::transformationalFunction},
{"iand", {{"i", OperandInt}, {"j", OperandInt, Rank::elementalOrBOZ}},
OperandInt},
- {"iand", {{"i", BOZ}, {"j", SameInt}}, SameInt},
- {"ibclr", {{"i", SameInt}, {"pos", AnyInt}}, SameInt},
- {"ibits", {{"i", SameInt}, {"pos", AnyInt}, {"len", AnyInt}}, SameInt},
- {"ibset", {{"i", SameInt}, {"pos", AnyInt}}, SameInt},
+ {"iand",
+ {{"i", OperandUnsigned}, {"j", OperandUnsigned, Rank::elementalOrBOZ}},
+ OperandUnsigned},
+ {"iand", {{"i", BOZ}, {"j", SameIntOrUnsigned}}, SameIntOrUnsigned},
+ {"ibclr", {{"i", SameIntOrUnsigned}, {"pos", AnyInt}}, SameIntOrUnsigned},
+ {"ibits", {{"i", SameIntOrUnsigned}, {"pos", AnyInt}, {"len", AnyInt}},
+ SameIntOrUnsigned},
+ {"ibset", {{"i", SameIntOrUnsigned}, {"pos", AnyInt}}, SameIntOrUnsigned},
{"ichar", {{"c", AnyChar}, DefaultingKIND}, KINDInt},
{"ieor", {{"i", OperandInt}, {"j", OperandInt, Rank::elementalOrBOZ}},
OperandInt},
- {"ieor", {{"i", BOZ}, {"j", SameInt}}, SameInt},
+ {"ieor",
+ {{"i", OperandUnsigned}, {"j", OperandUnsigned, Rank::elementalOrBOZ}},
+ OperandUnsigned},
+ {"ieor", {{"i", BOZ}, {"j", SameIntOrUnsigned}}, SameIntOrUnsigned},
{"image_index",
{{"coarray", AnyData, Rank::coarray}, {"sub", AnyInt, Rank::vector}},
DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
@@ -575,12 +619,15 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"int_ptr_kind", {}, DefaultInt, Rank::scalar},
{"ior", {{"i", OperandInt}, {"j", OperandInt, Rank::elementalOrBOZ}},
OperandInt},
- {"ior", {{"i", BOZ}, {"j", SameInt}}, SameInt},
- {"ishft", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
+ {"ior",
+ {{"i", OperandUnsigned}, {"j", OperandUnsigned, Rank::elementalOrBOZ}},
+ OperandUnsigned},
+ {"ior", {{"i", BOZ}, {"j", SameIntOrUnsigned}}, SameIntOrUnsigned},
+ {"ishft", {{"i", SameIntOrUnsigned}, {"shift", AnyInt}}, SameIntOrUnsigned},
{"ishftc",
- {{"i", SameInt}, {"shift", AnyInt},
+ {{"i", SameIntOrUnsigned}, {"shift", AnyInt},
{"size", AnyInt, Rank::elemental, Optionality::optional}},
- SameInt},
+ SameIntOrUnsigned},
{"isnan", {{"a", AnyFloating}}, DefaultLogical},
{"is_contiguous", {{"array", Addressable, Rank::anyOrAssumedRank}},
DefaultLogical, Rank::elemental, IntrinsicClass::inquiryFunction},
@@ -650,9 +697,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"maskl", {{"i", AnyInt}, DefaultingKIND}, KINDInt},
{"maskr", {{"i", AnyInt}, DefaultingKIND}, KINDInt},
{"max",
- {{"a1", OperandIntOrReal}, {"a2", OperandIntOrReal},
- {"a3", OperandIntOrReal, Rank::elemental, Optionality::repeats}},
- OperandIntOrReal},
+ {{"a1", OperandIntUnsignedOrReal}, {"a2", OperandIntUnsignedOrReal},
+ {"a3", OperandIntUnsignedOrReal, Rank::elemental,
+ Optionality::repeats}},
+ OperandIntUnsignedOrReal},
{"max",
{{"a1", SameCharNoLen}, {"a2", SameCharNoLen},
{"a3", SameCharNoLen, Rank::elemental, Optionality::repeats}},
@@ -682,16 +730,19 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{{"tsource", SameType}, {"fsource", SameType}, {"mask", AnyLogical}},
SameType},
{"merge_bits",
- {{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ},
- {"mask", SameInt, Rank::elementalOrBOZ}},
+ {{"i", SameIntOrUnsigned},
+ {"j", SameIntOrUnsigned, Rank::elementalOrBOZ},
+ {"mask", SameIntOrUnsigned, Rank::elementalOrBOZ}},
SameInt},
{"merge_bits",
- {{"i", BOZ}, {"j", SameInt}, {"mask", SameInt, Rank::elementalOrBOZ}},
- SameInt},
+ {{"i", BOZ}, {"j", SameIntOrUnsigned},
+ {"mask", SameIntOrUnsigned, Rank::elementalOrBOZ}},
+ SameIntOrUnsigned},
{"min",
- {{"a1", OperandIntOrReal}, {"a2", OperandIntOrReal},
- {"a3", OperandIntOrReal, Rank::elemental, Optionality::repeats}},
- OperandIntOrReal},
+ {{"a1", OperandIntUnsignedOrReal}, {"a2", OperandIntUnsignedOrReal},
+ {"a3", OperandIntUnsignedOrReal, Rank::elemental,
+ Optionality::repeats}},
+ OperandIntUnsignedOrReal},
{"min",
{{"a1", SameCharNoLen}, {"a2", SameCharNoLen},
{"a3", SameCharNoLen, Rank::elemental, Optionality::repeats}},
@@ -717,10 +768,11 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"minval",
{{"array", SameRelatable, Rank::array}, MissingDIM, OptionalMASK},
SameRelatable, Rank::scalar, IntrinsicClass::transformationalFunction},
- {"mod", {{"a", OperandIntOrReal}, {"p", OperandIntOrReal}},
- OperandIntOrReal},
- {"modulo", {{"a", OperandIntOrReal}, {"p", OperandIntOrReal}},
- OperandIntOrReal},
+ {"mod", {{"a", OperandIntUnsignedOrReal}, {"p", OperandIntUnsignedOrReal}},
+ OperandIntUnsignedOrReal},
+ {"modulo",
+ {{"a", OperandIntUnsignedOrReal}, {"p", OperandIntUnsignedOrReal}},
+ OperandIntUnsignedOrReal},
{"nearest", {{"x", SameReal}, {"s", AnyReal}}, SameReal},
{"new_line",
{{"a", SameCharNoLen, Rank::anyOrAssumedRank, Optionality::required,
@@ -731,7 +783,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
Rank::dimReduced, IntrinsicClass::transformationalFunction},
{"norm2", {{"x", SameReal, Rank::array}, MissingDIM}, SameReal,
Rank::scalar, IntrinsicClass::transformationalFunction},
- {"not", {{"i", SameInt}}, SameInt},
+ {"not", {{"i", SameIntOrUnsigned}}, SameIntOrUnsigned},
// NULL() is a special case handled in Probe() below
{"num_images", {}, DefaultInt, Rank::scalar,
IntrinsicClass::transformationalFunction},
@@ -847,12 +899,17 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"r", AnyInt, Rank::scalar, Optionality::optional},
{"radix", AnyInt, Rank::scalar}},
DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
+ {"selected_unsigned_kind", {{"r", AnyInt, Rank::scalar}}, DefaultInt,
+ Rank::scalar, IntrinsicClass::transformationalFunction},
{"set_exponent", {{"x", SameReal}, {"i", AnyInt}}, SameReal},
{"shape", {{"source", AnyData, Rank::anyOrAssumedRank}, SizeDefaultKIND},
KINDInt, Rank::vector, IntrinsicClass::inquiryFunction},
- {"shifta", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
- {"shiftl", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
- {"shiftr", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
+ {"shifta", {{"i", SameIntOrUnsigned}, {"shift", AnyInt}},
+ SameIntOrUnsigned},
+ {"shiftl", {{"i", SameIntOrUnsigned}, {"shift", AnyInt}},
+ SameIntOrUnsigned},
+ {"shiftr", {{"i", SameIntOrUnsigned}, {"shift", AnyInt}},
+ SameIntOrUnsigned},
{"sign", {{"a", SameInt}, {"b", AnyInt}}, SameInt},
{"sign", {{"a", SameReal}, {"b", AnyReal}}, SameReal},
{"sin", {{"x", SameFloating}}, SameFloating},
@@ -925,6 +982,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"ucobound",
{{"coarray", AnyData, Rank::coarray}, OptionalDIM, SizeDefaultKIND},
KINDInt, Rank::scalarIfDim, IntrinsicClass::inquiryFunction},
+ {"uint", {{"a", AnyNumeric, Rank::elementalOrBOZ}, DefaultingKIND},
+ KINDUnsigned},
{"unpack",
{{"vector", SameType, Rank::vector}, {"mask", AnyLogical, Rank::array},
{"field", SameType, Rank::conformable}},
@@ -1015,6 +1074,7 @@ static const std::pair<const char *, const char *> genericAlias[]{
{"lshift", "shiftl"},
{"or", "ior"},
{"rshift", "shifta"},
+ {"unsigned", "uint"}, // Sun vs gfortran names
{"xor", "ieor"},
{"__builtin_ieee_selected_real_kind", "selected_real_kind"},
};
@@ -1463,8 +1523,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{
common::Intent::InOut}},
{}, Rank::elemental, IntrinsicClass::pureSubroutine},
{"mvbits",
- {{"from", SameInt}, {"frompos", AnyInt}, {"len", AnyInt},
- {"to", SameInt, Rank::elemental, Optionality::required,
+ {{"from", SameIntOrUnsigned}, {"frompos", AnyInt}, {"len", AnyInt},
+ {"to", SameIntOrUnsigned, Rank::elemental, Optionality::required,
common::Intent::Out},
{"topos", AnyInt}},
{}, Rank::elemental, IntrinsicClass::elementalSubroutine}, // elemental
diff --git a/flang/lib/Evaluate/target.cpp b/flang/lib/Evaluate/target.cpp
index 1e2cf6b0d298d4..f2aa43be5a5b44 100644
--- a/flang/lib/Evaluate/target.cpp
+++ b/flang/lib/Evaluate/target.cpp
@@ -44,6 +44,7 @@ TargetCharacteristics::TargetCharacteristics() {
enableCategoryKinds(TypeCategory::Complex);
enableCategoryKinds(TypeCategory::Character);
enableCategoryKinds(TypeCategory::Logical);
+ enableCategoryKinds(TypeCategory::Unsigned);
isBigEndian_ = !isHostLittleEndian;
@@ -113,6 +114,7 @@ void TargetCharacteristics::set_roundingMode(Rounding rounding) {
}
// SELECTED_INT_KIND() -- F'2018 16.9.169
+// and SELECTED_UNSIGNED_KIND() extension (same results)
class SelectedIntKindVisitor {
public:
SelectedIntKindVisitor(
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 4d98220a7065ca..b1cdab6c947867 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -437,7 +437,7 @@ Expr<SomeComplex> PromoteMixedComplexReal(
// N.B. When a "typeless" BOZ literal constant appears as one (not both!) of
// the operands to a dyadic operation where one is permitted, it assumes the
// type and kind of the other operand.
-template <template <typename> class OPR>
+template <template <typename> class OPR, bool CAN_BE_UNSIGNED>
std::optional<Expr<SomeType>> NumericOperation(
parser::ContextualMessages &messages, Expr<SomeType> &&x,
Expr<SomeType> &&y, int defaultRealKind) {
@@ -451,6 +451,15 @@ std::optional<Expr<SomeType>> NumericOperation(
return Package(PromoteAndCombine<OPR, TypeCategory::Real>(
std::move(rx), std::move(ry)));
},
+ [&](Expr<SomeUnsigned> &&ix, Expr<SomeUnsigned> &&iy) {
+ if constexpr (CAN_BE_UNSIGNED) {
+ return Package(PromoteAndCombine<OPR, TypeCategory::Unsigned>(
+ std::move(ix), std::move(iy)));
+ } else {
+ messages.Say("Operands must not be UNSIGNED"_err_en_US);
+ return NoExpr();
+ }
+ },
// Mixed REAL/INTEGER operations
[](Expr<SomeReal> &&rx, Expr<SomeInteger> &&iy) {
return MixedRealLeft<OPR>(std::move(rx), std::move(iy));
@@ -508,24 +517,44 @@ std::optional<Expr<SomeType>> NumericOperation(
},
// Operations with one typeless operand
[&](BOZLiteralConstant &&bx, Expr<SomeInteger> &&iy) {
- return NumericOperation<OPR>(messages,
+ return NumericOperation<OPR, CAN_BE_UNSIGNED>(messages,
+ AsGenericExpr(ConvertTo(iy, std::move(bx))), std::move(y),
+ defaultRealKind);
+ },
+ [&](BOZLiteralConstant &&bx, Expr<SomeUnsigned> &&iy) {
+ return NumericOperation<OPR, CAN_BE_UNSIGNED>(messages,
AsGenericExpr(ConvertTo(iy, std::move(bx))), std::move(y),
defaultRealKind);
},
[&](BOZLiteralConstant &&bx, Expr<SomeReal> &&ry) {
- return NumericOperation<OPR>(messages,
+ return NumericOperation<OPR, CAN_BE_UNSIGNED>(messages,
AsGenericExpr(ConvertTo(ry, std::move(bx))), std::move(y),
defaultRealKind);
},
[&](Expr<SomeInteger> &&ix, BOZLiteralConstant &&by) {
- return NumericOperation<OPR>(messages, std::move(x),
- AsGenericExpr(ConvertTo(ix, std::move(by))), defaultRealKind);
+ return NumericOperation<OPR, CAN_BE_UNSIGNED>(messages,
+ std::move(x), AsGenericExpr(ConvertTo(ix, std::move(by))),
+ defaultRealKind);
+ },
+ [&](Expr<SomeUnsigned> &&ix, BOZLiteralConstant &&by) {
+ return NumericOperation<OPR, CAN_BE_UNSIGNED>(messages,
+ std::move(x), AsGenericExpr(ConvertTo(ix, std::move(by))),
+ defaultRealKind);
},
[&](Expr<SomeReal> &&rx, BOZLiteralConstant &&by) {
- return NumericOperation<OPR>(messages, std::move(x),
- AsGenericExpr(ConvertTo(rx, std::move(by))), defaultRealKind);
+ return NumericOperation<OPR, CAN_BE_UNSIGNED>(messages,
+ std::move(x), AsGenericExpr(ConvertTo(rx, std::move(by))),
+ defaultRealKind);
+ },
+ // Error cases
+ [&](Expr<SomeUnsigned> &&, auto &&) {
+ messages.Say("Both operands must be UNSIGNED"_err_en_US);
+ return NoExpr();
+ },
+ [&](auto &&, Expr<SomeUnsigned> &&) {
+ messages.Say("Both operands must be UNSIGNED"_err_en_US);
+ return NoExpr();
},
- // Default case
[&](auto &&, auto &&) {
messages.Say("non-numeric operands to numeric operation"_err_en_US);
return NoExpr();
@@ -534,7 +563,7 @@ std::optional<Expr<SomeType>> NumericOperation(
std::move(x.u), std::move(y.u));
}
-template std::optional<Expr<SomeType>> NumericOperation<Power>(
+template std::optional<Expr<SomeType>> NumericOperation<Power, false>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
template std::optional<Expr<SomeType>> NumericOperation<Multiply>(
@@ -581,6 +610,7 @@ std::optional<Expr<SomeType>> Negation(
messages.Say("LOGICAL cannot be negated"_err_en_US);
return NoExpr();
},
+ [&](Expr<SomeUnsigned> &&x) { return Package(-std::move(x)); },
[&](Expr<SomeDerived> &&) {
messages.Say("Operand cannot be negated"_err_en_US);
return NoExpr();
@@ -718,6 +748,12 @@ std::optional<Expr<SomeType>> ConvertToType(
ConvertToKind<TypeCategory::Integer>(type.kind(), std::move(*boz))};
}
return ConvertToNumeric<TypeCategory::Integer>(type.kind(), std::move(x));
+ case TypeCategory::Unsigned:
+ if (auto *cx{UnwrapExpr<Expr<SomeUnsigned>>(x)}) {
+ return Expr<SomeType>{
+ ConvertToKind<TypeCategory::Unsigned>(type.kind(), std::move(*cx))};
+ }
+ break;
case TypeCategory::Real:
if (auto *boz{std::get_if<BOZLiteralConstant>(&x.u)}) {
return Expr<SomeType>{
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index c00688853cd006..0034e5f802cb1e 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -181,6 +181,7 @@ std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
std::optional<std::int64_t> charLength) const {
switch (category_) {
case TypeCategory::Integer:
+ case TypeCategory::Unsigned:
case TypeCategory::Real:
case TypeCategory::Complex:
case TypeCategory::Logical:
@@ -682,6 +683,14 @@ DynamicType DynamicType::ResultTypeForMultiply(const DynamicType &that) const {
CRASH_NO_CASE;
}
break;
+ case TypeCategory::Unsigned:
+ switch (that.category_) {
+ case TypeCategory::Unsigned:
+ return DynamicType{TypeCategory::Unsigned, std::max(kind(), that.kind())};
+ default:
+ CRASH_NO_CASE;
+ }
+ break;
case TypeCategory::Real:
switch (that.category_) {
case TypeCategory::Integer:
diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp
index 4607a33ffda6cc..733d272dac82a4 100644
--- a/flang/lib/Frontend/CompilerInvocation.cpp
+++ b/flang/lib/Frontend/CompilerInvocation.cpp
@@ -737,6 +737,12 @@ static bool parseFrontendArgs(FrontendOptions &opts, llvm::opt::ArgList &args,
clang::driver::options::OPT_fno_logical_abbreviations,
false));
+ // -f{no-}unsigned
+ opts.features.Enable(Fortran::common::LanguageFeature::Unsigned,
+ args.hasFlag(clang::driver::options::OPT_funsigned,
+ clang::driver::options::OPT_fno_unsigned,
+ false));
+
// -f{no-}xor-operator
opts.features.Enable(
Fortran::common::LanguageFeature::XOROperator,
diff --git a/flang/lib/Lower/ConvertConstant.cpp b/flang/lib/Lower/ConvertConstant.cpp
index 748be508235f17..415567187ab767 100644
--- a/flang/lib/Lower/ConvertConstant.cpp
+++ b/flang/lib/Lower/ConvertConstant.cpp
@@ -226,12 +226,18 @@ template <Fortran::common::TypeCategory TC, int KIND>
static mlir::Value genScalarLit(
fir::FirOpBuilder &builder, mlir::Location loc,
const Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>> &value) {
- if constexpr (TC == Fortran::common::TypeCategory::Integer) {
- mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND,
- std::nullopt);
+ 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,
+ std::nullopt);
if (KIND == 16) {
- auto bigInt =
- llvm::APInt(ty.getIntOrFloatBitWidth(), value.SignedDecimal(), 10);
+ auto bigInt = llvm::APInt(ty.getIntOrFloatBitWidth(),
+ TC == Fortran::common::TypeCategory::Unsigned
+ ? value.UnsignedDecimal()
+ : value.SignedDecimal(),
+ 10);
return builder.create<mlir::arith::ConstantOp>(
loc, ty, mlir::IntegerAttr::get(ty, bigInt));
}
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 87e2114e413059..cdb7c883f6be9f 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -194,7 +194,7 @@ enum class ConstituentSemantics {
/// Convert parser's INTEGER relational operators to MLIR. TODO: using
/// unordered, but we may want to cons ordered in certain situation.
static mlir::arith::CmpIPredicate
-translateRelational(Fortran::common::RelationalOperator rop) {
+translateSignedRelational(Fortran::common::RelationalOperator rop) {
switch (rop) {
case Fortran::common::RelationalOperator::LT:
return mlir::arith::CmpIPredicate::slt;
@@ -212,6 +212,25 @@ translateRelational(Fortran::common::RelationalOperator rop) {
llvm_unreachable("unhandled INTEGER relational operator");
}
+static mlir::arith::CmpIPredicate
+translateUnsignedRelational(Fortran::common::RelationalOperator rop) {
+ switch (rop) {
+ case Fortran::common::RelationalOperator::LT:
+ return mlir::arith::CmpIPredicate::ult;
+ case Fortran::common::RelationalOperator::LE:
+ return mlir::arith::CmpIPredicate::ule;
+ case Fortran::common::RelationalOperator::EQ:
+ return mlir::arith::CmpIPredicate::eq;
+ case Fortran::common::RelationalOperator::NE:
+ return mlir::arith::CmpIPredicate::ne;
+ case Fortran::common::RelationalOperator::GT:
+ return mlir::arith::CmpIPredicate::ugt;
+ case Fortran::common::RelationalOperator::GE:
+ return mlir::arith::CmpIPredicate::uge;
+ }
+ llvm_unreachable("unhandled UNSIGNED relational operator");
+}
+
/// Convert parser's REAL relational operators to MLIR.
/// The choice of order (O prefix) vs unorder (U prefix) follows Fortran 2018
/// requirements in the IEEE context (table 17.1 of F2018). This choice is
@@ -1049,6 +1068,18 @@ class ScalarExprLowering {
return builder.create<mlir::arith::SubIOp>(getLoc(), zero, input);
}
template <int KIND>
+ ExtValue genval(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
+ Fortran::common::TypeCategory::Unsigned, KIND>> &op) {
+ auto loc = getLoc();
+ mlir::Type signlessType =
+ converter.genType(Fortran::common::TypeCategory::Integer, KIND);
+ mlir::Value input = genunbox(op.left());
+ mlir::Value signless = builder.createConvert(loc, signlessType, input);
+ mlir::Value zero = genIntegerConstant<KIND>(builder.getContext(), 0);
+ mlir::Value neg = builder.create<mlir::arith::SubIOp>(loc, zero, signless);
+ return builder.createConvert(loc, input.getType(), neg);
+ }
+ template <int KIND>
ExtValue genval(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Real, KIND>> &op) {
return builder.create<mlir::arith::NegFOp>(getLoc(), genunbox(op.left()));
@@ -1059,19 +1090,30 @@ class ScalarExprLowering {
return builder.create<fir::NegcOp>(getLoc(), genunbox(op.left()));
}
- template <typename OpTy>
+ template <typename OpTy, int KIND>
mlir::Value createBinaryOp(const ExtValue &left, const ExtValue &right) {
assert(fir::isUnboxedValue(left) && fir::isUnboxedValue(right));
mlir::Value lhs = fir::getBase(left);
mlir::Value rhs = fir::getBase(right);
assert(lhs.getType() == rhs.getType() && "types must be the same");
- return builder.create<OpTy>(getLoc(), lhs, rhs);
+ auto loc = getLoc();
+ if (!std::is_same_v<OpTy, mlir::arith::DivUIOp> &&
+ lhs.getType().isUnsignedInteger()) {
+ // convert Unsigned -> Signless before and back afterwards
+ mlir::Type signlessType =
+ converter.genType(Fortran::common::TypeCategory::Integer, KIND);
+ mlir::Value lhsSL = builder.createConvert(loc, signlessType, lhs);
+ mlir::Value rhsSL = builder.createConvert(loc, signlessType, rhs);
+ mlir::Value op = builder.create<OpTy>(loc, lhsSL, rhsSL);
+ return builder.createConvert(loc, lhs.getType(), op);
+ }
+ return builder.create<OpTy>(loc, lhs, rhs);
}
- template <typename OpTy, typename A>
+ template <typename OpTy, int KIND, typename A>
mlir::Value createBinaryOp(const A &ex) {
ExtValue left = genval(ex.left());
- return createBinaryOp<OpTy>(left, genval(ex.right()));
+ return createBinaryOp<OpTy, KIND>(left, genval(ex.right()));
}
#undef GENBIN
@@ -1079,19 +1121,23 @@ class ScalarExprLowering {
template <int KIND> \
ExtValue genval(const Fortran::evaluate::GenBinEvOp<Fortran::evaluate::Type< \
Fortran::common::TypeCategory::GenBinTyCat, KIND>> &x) { \
- return createBinaryOp<GenBinFirOp>(x); \
+ return createBinaryOp<GenBinFirOp, KIND>(x); \
}
GENBIN(Add, Integer, mlir::arith::AddIOp)
+ GENBIN(Add, Unsigned, mlir::arith::AddIOp)
GENBIN(Add, Real, mlir::arith::AddFOp)
GENBIN(Add, Complex, fir::AddcOp)
GENBIN(Subtract, Integer, mlir::arith::SubIOp)
+ GENBIN(Subtract, Unsigned, mlir::arith::SubIOp)
GENBIN(Subtract, Real, mlir::arith::SubFOp)
GENBIN(Subtract, Complex, fir::SubcOp)
GENBIN(Multiply, Integer, mlir::arith::MulIOp)
+ GENBIN(Multiply, Unsigned, mlir::arith::MulIOp)
GENBIN(Multiply, Real, mlir::arith::MulFOp)
GENBIN(Multiply, Complex, fir::MulcOp)
GENBIN(Divide, Integer, mlir::arith::DivSIOp)
+ GENBIN(Divide, Unsigned, mlir::arith::DivUIOp)
GENBIN(Divide, Real, mlir::arith::DivFOp)
template <int KIND>
@@ -1200,8 +1246,14 @@ class ScalarExprLowering {
template <int KIND>
ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Integer, KIND>> &op) {
- return createCompareOp<mlir::arith::CmpIOp>(op,
- translateRelational(op.opr));
+ return createCompareOp<mlir::arith::CmpIOp>(
+ op, translateSignedRelational(op.opr));
+ }
+ template <int KIND>
+ ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
+ Fortran::common::TypeCategory::Unsigned, KIND>> &op) {
+ return createCompareOp<mlir::arith::CmpIOp>(
+ op, translateUnsignedRelational(op.opr));
}
template <int KIND>
ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
@@ -1217,7 +1269,7 @@ class ScalarExprLowering {
template <int KIND>
ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Character, KIND>> &op) {
- return createCharCompare(op, translateRelational(op.opr));
+ return createCharCompare(op, translateSignedRelational(op.opr));
}
ExtValue
@@ -1281,9 +1333,9 @@ class ScalarExprLowering {
mlir::Value rhs = builder.createConvert(getLoc(), i1Type, srhs);
switch (op.logicalOperator) {
case Fortran::evaluate::LogicalOperator::And:
- return createBinaryOp<mlir::arith::AndIOp>(lhs, rhs);
+ return createBinaryOp<mlir::arith::AndIOp, KIND>(lhs, rhs);
case Fortran::evaluate::LogicalOperator::Or:
- return createBinaryOp<mlir::arith::OrIOp>(lhs, rhs);
+ return createBinaryOp<mlir::arith::OrIOp, KIND>(lhs, rhs);
case Fortran::evaluate::LogicalOperator::Eqv:
return createCompareOp<mlir::arith::CmpIOp>(
mlir::arith::CmpIPredicate::eq, lhs, rhs);
@@ -5100,20 +5152,36 @@ class ArrayExprLowering {
return fir::substBase(val, newBase);
};
}
- template <int KIND>
- CC genarr(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
- Fortran::common::TypeCategory::Integer, KIND>> &x) {
+ template <Fortran::common::TypeCategory CAT, int KIND>
+ CC genarrIntNeg(
+ const Fortran::evaluate::Expr<Fortran::evaluate::Type<CAT, KIND>> &left) {
mlir::Location loc = getLoc();
- auto f = genarr(x.left());
+ auto f = genarr(left);
return [=](IterSpace iters) -> ExtValue {
mlir::Value val = fir::getBase(f(iters));
mlir::Type ty =
converter.genType(Fortran::common::TypeCategory::Integer, KIND);
mlir::Value zero = builder.createIntegerConstant(loc, ty, 0);
+ if constexpr (CAT == Fortran::common::TypeCategory::Unsigned) {
+ mlir::Value signless = builder.createConvert(loc, ty, val);
+ mlir::Value neg =
+ builder.create<mlir::arith::SubIOp>(loc, zero, signless);
+ return builder.createConvert(loc, val.getType(), neg);
+ }
return builder.create<mlir::arith::SubIOp>(loc, zero, val);
};
}
template <int KIND>
+ CC genarr(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
+ Fortran::common::TypeCategory::Integer, KIND>> &x) {
+ return genarrIntNeg(x.left());
+ }
+ template <int KIND>
+ CC genarr(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
+ Fortran::common::TypeCategory::Unsigned, KIND>> &x) {
+ return genarrIntNeg(x.left());
+ }
+ template <int KIND>
CC genarr(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Real, KIND>> &x) {
mlir::Location loc = getLoc();
@@ -5136,7 +5204,7 @@ class ArrayExprLowering {
// Binary elemental ops
//===--------------------------------------------------------------------===//
- template <typename OP, typename A>
+ template <typename OP, int KIND, typename A>
CC createBinaryOp(const A &evEx) {
mlir::Location loc = getLoc();
auto lambda = genarr(evEx.left());
@@ -5144,6 +5212,17 @@ class ArrayExprLowering {
return [=](IterSpace iters) -> ExtValue {
mlir::Value left = fir::getBase(lambda(iters));
mlir::Value right = fir::getBase(rf(iters));
+ assert(left.getType() == right.getType() && "types must be the same");
+ if (!std::is_same_v<OP, mlir::arith::DivUIOp> &&
+ left.getType().isUnsignedInteger()) {
+ // convert Unsigned -> Signless before and back afterwards
+ mlir::Type signlessType =
+ converter.genType(Fortran::common::TypeCategory::Integer, KIND);
+ mlir::Value lhsSL = builder.createConvert(loc, signlessType, left);
+ mlir::Value rhsSL = builder.createConvert(loc, signlessType, right);
+ mlir::Value op = builder.create<OP>(loc, lhsSL, rhsSL);
+ return builder.createConvert(loc, left.getType(), op);
+ }
return builder.create<OP>(loc, left, right);
};
}
@@ -5153,19 +5232,23 @@ class ArrayExprLowering {
template <int KIND> \
CC genarr(const Fortran::evaluate::GenBinEvOp<Fortran::evaluate::Type< \
Fortran::common::TypeCategory::GenBinTyCat, KIND>> &x) { \
- return createBinaryOp<GenBinFirOp>(x); \
+ return createBinaryOp<GenBinFirOp, KIND>(x); \
}
GENBIN(Add, Integer, mlir::arith::AddIOp)
+ GENBIN(Add, Unsigned, mlir::arith::AddIOp)
GENBIN(Add, Real, mlir::arith::AddFOp)
GENBIN(Add, Complex, fir::AddcOp)
GENBIN(Subtract, Integer, mlir::arith::SubIOp)
+ GENBIN(Subtract, Unsigned, mlir::arith::SubIOp)
GENBIN(Subtract, Real, mlir::arith::SubFOp)
GENBIN(Subtract, Complex, fir::SubcOp)
GENBIN(Multiply, Integer, mlir::arith::MulIOp)
+ GENBIN(Multiply, Unsigned, mlir::arith::MulIOp)
GENBIN(Multiply, Real, mlir::arith::MulFOp)
GENBIN(Multiply, Complex, fir::MulcOp)
GENBIN(Divide, Integer, mlir::arith::DivSIOp)
+ GENBIN(Divide, Unsigned, mlir::arith::DivUIOp)
GENBIN(Divide, Real, mlir::arith::DivFOp)
template <int KIND>
@@ -6570,12 +6653,19 @@ class ArrayExprLowering {
template <int KIND>
CC genarr(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Integer, KIND>> &x) {
- return createCompareOp<mlir::arith::CmpIOp>(translateRelational(x.opr), x);
+ return createCompareOp<mlir::arith::CmpIOp>(
+ translateSignedRelational(x.opr), x);
+ }
+ template <int KIND>
+ CC genarr(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
+ Fortran::common::TypeCategory::Unsigned, KIND>> &x) {
+ return createCompareOp<mlir::arith::CmpIOp>(
+ translateUnsignedRelational(x.opr), x);
}
template <int KIND>
CC genarr(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Character, KIND>> &x) {
- return createCompareCharOp(translateRelational(x.opr), x);
+ return createCompareCharOp(translateSignedRelational(x.opr), x);
}
template <int KIND>
CC genarr(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index 93b78fd3357fac..e0c1b59d3928a5 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -968,21 +968,41 @@ struct BinaryOp {};
fir::FirOpBuilder &builder, \
const Op &, hlfir::Entity lhs, \
hlfir::Entity rhs) { \
- return hlfir::EntityWithAttributes{ \
- builder.create<GenBinFirOp>(loc, lhs, rhs)}; \
+ if constexpr (Fortran::common::TypeCategory::GenBinTyCat == \
+ Fortran::common::TypeCategory::Unsigned && \
+ !std::is_same_v<GenBinFirOp, mlir::arith::DivUIOp>) { \
+ int bits = \
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, \
+ KIND>::Scalar::bits; \
+ auto signlessType = mlir::IntegerType::get( \
+ builder.getContext(), bits, \
+ mlir::IntegerType::SignednessSemantics::Signless); \
+ auto lhsSL = builder.createConvert(loc, signlessType, lhs); \
+ auto rhsSL = builder.createConvert(loc, signlessType, rhs); \
+ auto res = builder.create<GenBinFirOp>(loc, lhsSL, rhsSL); \
+ return hlfir::EntityWithAttributes( \
+ builder.createConvert(loc, lhs.getType(), res)); \
+ } else { \
+ return hlfir::EntityWithAttributes{ \
+ builder.create<GenBinFirOp>(loc, lhs, rhs)}; \
+ } \
} \
};
GENBIN(Add, Integer, mlir::arith::AddIOp)
+GENBIN(Add, Unsigned, mlir::arith::AddIOp)
GENBIN(Add, Real, mlir::arith::AddFOp)
GENBIN(Add, Complex, fir::AddcOp)
GENBIN(Subtract, Integer, mlir::arith::SubIOp)
+GENBIN(Subtract, Unsigned, mlir::arith::SubIOp)
GENBIN(Subtract, Real, mlir::arith::SubFOp)
GENBIN(Subtract, Complex, fir::SubcOp)
GENBIN(Multiply, Integer, mlir::arith::MulIOp)
+GENBIN(Multiply, Unsigned, mlir::arith::MulIOp)
GENBIN(Multiply, Real, mlir::arith::MulFOp)
GENBIN(Multiply, Complex, fir::MulcOp)
GENBIN(Divide, Integer, mlir::arith::DivSIOp)
+GENBIN(Divide, Unsigned, mlir::arith::DivUIOp)
GENBIN(Divide, Real, mlir::arith::DivFOp)
template <int KIND>
@@ -1067,7 +1087,7 @@ struct BinaryOp<Fortran::evaluate::Extremum<
/// Convert parser's INTEGER relational operators to MLIR.
static mlir::arith::CmpIPredicate
-translateRelational(Fortran::common::RelationalOperator rop) {
+translateSignedRelational(Fortran::common::RelationalOperator rop) {
switch (rop) {
case Fortran::common::RelationalOperator::LT:
return mlir::arith::CmpIPredicate::slt;
@@ -1085,6 +1105,25 @@ translateRelational(Fortran::common::RelationalOperator rop) {
llvm_unreachable("unhandled INTEGER relational operator");
}
+static mlir::arith::CmpIPredicate
+translateUnsignedRelational(Fortran::common::RelationalOperator rop) {
+ switch (rop) {
+ case Fortran::common::RelationalOperator::LT:
+ return mlir::arith::CmpIPredicate::ult;
+ case Fortran::common::RelationalOperator::LE:
+ return mlir::arith::CmpIPredicate::ule;
+ case Fortran::common::RelationalOperator::EQ:
+ return mlir::arith::CmpIPredicate::eq;
+ case Fortran::common::RelationalOperator::NE:
+ return mlir::arith::CmpIPredicate::ne;
+ case Fortran::common::RelationalOperator::GT:
+ return mlir::arith::CmpIPredicate::ugt;
+ case Fortran::common::RelationalOperator::GE:
+ return mlir::arith::CmpIPredicate::uge;
+ }
+ llvm_unreachable("unhandled UNSIGNED relational operator");
+}
+
/// Convert parser's REAL relational operators to MLIR.
/// The choice of order (O prefix) vs unorder (U prefix) follows Fortran 2018
/// requirements in the IEEE context (table 17.1 of F2018). This choice is
@@ -1122,7 +1161,22 @@ struct BinaryOp<Fortran::evaluate::Relational<
const Op &op, hlfir::Entity lhs,
hlfir::Entity rhs) {
auto cmp = builder.create<mlir::arith::CmpIOp>(
- loc, translateRelational(op.opr), lhs, rhs);
+ loc, translateSignedRelational(op.opr), lhs, rhs);
+ return hlfir::EntityWithAttributes{cmp};
+ }
+};
+
+template <int KIND>
+struct BinaryOp<Fortran::evaluate::Relational<
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> {
+ using Op = Fortran::evaluate::Relational<
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>;
+ static hlfir::EntityWithAttributes gen(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ const Op &op, hlfir::Entity lhs,
+ hlfir::Entity rhs) {
+ auto cmp = builder.create<mlir::arith::CmpIOp>(
+ loc, translateUnsignedRelational(op.opr), lhs, rhs);
return hlfir::EntityWithAttributes{cmp};
}
};
@@ -1171,7 +1225,7 @@ struct BinaryOp<Fortran::evaluate::Relational<
auto [rhsExv, rhsCleanUp] =
hlfir::translateToExtendedValue(loc, builder, rhs);
auto cmp = fir::runtime::genCharCompare(
- builder, loc, translateRelational(op.opr), lhsExv, rhsExv);
+ builder, loc, translateSignedRelational(op.opr), lhsExv, rhsExv);
if (lhsCleanUp)
(*lhsCleanUp)();
if (rhsCleanUp)
@@ -1312,6 +1366,28 @@ struct UnaryOp<Fortran::evaluate::Negate<
}
};
+template <int KIND>
+struct UnaryOp<Fortran::evaluate::Negate<
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> {
+ using Op = Fortran::evaluate::Negate<
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>;
+ 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;
+ mlir::Type signlessType = mlir::IntegerType::get(
+ builder.getContext(), bits,
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
+ mlir::Value signless = builder.createConvert(loc, signlessType, lhs);
+ mlir::Value negated =
+ builder.create<mlir::arith::SubIOp>(loc, zero, signless);
+ return hlfir::EntityWithAttributes(
+ builder.createConvert(loc, lhs.getType(), negated));
+ }
+};
+
template <int KIND>
struct UnaryOp<Fortran::evaluate::Negate<
Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>> {
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 8664477b50078a..452ddda426fa10 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -76,7 +76,7 @@ static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind,
return mlir::IntegerType::get(context, getIntegerBits<16>(), signedness);
}
}
- llvm_unreachable("INTEGER kind not translated");
+ llvm_unreachable("INTEGER or UNSIGNED kind not translated");
}
static mlir::Type genLogicalType(mlir::MLIRContext *context, int KIND) {
@@ -107,7 +107,9 @@ genFIRType(mlir::MLIRContext *context, Fortran::common::TypeCategory tc,
case Fortran::common::TypeCategory::Real:
return genRealType(context, kind);
case Fortran::common::TypeCategory::Integer:
- return genIntegerType(context, kind);
+ return genIntegerType(context, kind, false);
+ case Fortran::common::TypeCategory::Unsigned:
+ return genIntegerType(context, kind, true);
case Fortran::common::TypeCategory::Complex:
return genComplexType(context, kind);
case Fortran::common::TypeCategory::Logical:
@@ -156,7 +158,7 @@ struct TypeBuilderImpl {
} else if (category == Fortran::common::TypeCategory::Derived) {
baseType = genDerivedType(dynamicType->GetDerivedTypeSpec());
} else {
- // LOGICAL, INTEGER, REAL, COMPLEX, CHARACTER
+ // INTEGER, UNSIGNED, REAL, COMPLEX, CHARACTER, LOGICAL
llvm::SmallVector<Fortran::lower::LenParameterTy> params;
translateLenParameters(params, category, expr);
baseType = genFIRType(context, category, dynamicType->kind(), params);
diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 1894b0cfd1bec2..3dfa2b248994d1 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -661,21 +661,23 @@ static mlir::func::FuncOp getOutputFunc(mlir::Location loc,
if (!isFormatted)
return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder);
if (auto ty = mlir::dyn_cast<mlir::IntegerType>(type)) {
- switch (ty.getWidth()) {
- case 1:
- return getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder);
- case 8:
- return getIORuntimeFunc<mkIOKey(OutputInteger8)>(loc, builder);
- case 16:
- return getIORuntimeFunc<mkIOKey(OutputInteger16)>(loc, builder);
- case 32:
- return getIORuntimeFunc<mkIOKey(OutputInteger32)>(loc, builder);
- case 64:
- return getIORuntimeFunc<mkIOKey(OutputInteger64)>(loc, builder);
- case 128:
- return getIORuntimeFunc<mkIOKey(OutputInteger128)>(loc, builder);
+ if (!ty.isUnsigned()) {
+ switch (ty.getWidth()) {
+ case 1:
+ return getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder);
+ case 8:
+ return getIORuntimeFunc<mkIOKey(OutputInteger8)>(loc, builder);
+ case 16:
+ return getIORuntimeFunc<mkIOKey(OutputInteger16)>(loc, builder);
+ case 32:
+ return getIORuntimeFunc<mkIOKey(OutputInteger32)>(loc, builder);
+ case 64:
+ return getIORuntimeFunc<mkIOKey(OutputInteger64)>(loc, builder);
+ case 128:
+ return getIORuntimeFunc<mkIOKey(OutputInteger128)>(loc, builder);
+ }
+ llvm_unreachable("unknown OutputInteger kind");
}
- llvm_unreachable("unknown OutputInteger kind");
}
if (auto ty = mlir::dyn_cast<mlir::FloatType>(type)) {
if (auto width = ty.getWidth(); width == 32)
diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp
index a66dae8851a866..1165417ef89a28 100644
--- a/flang/lib/Lower/Mangler.cpp
+++ b/flang/lib/Lower/Mangler.cpp
@@ -266,6 +266,8 @@ static std::string typeToString(Fortran::common::TypeCategory cat, int kind,
switch (cat) {
case Fortran::common::TypeCategory::Integer:
return "i" + std::to_string(kind);
+ case Fortran::common::TypeCategory::Unsigned:
+ return "u" + std::to_string(kind);
case Fortran::common::TypeCategory::Real:
return "r" + std::to_string(kind);
case Fortran::common::TypeCategory::Complex:
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index e6143275ce1d44..d52d5a27f84b6b 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -604,6 +604,10 @@ static constexpr IntrinsicHandler handlers[]{
{"range", asAddr, handleDynamicOptional},
{"radix", asAddr, handleDynamicOptional}}},
/*isElemental=*/false},
+ {"selected_unsigned_kind",
+ &I::genSelectedIntKind, // same results as selected_int_kind
+ {{{"scalar", asAddr}}},
+ /*isElemental=*/false},
{"set_exponent", &I::genSetExponent},
{"shape",
&I::genShape,
diff --git a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
index b39824428c78a9..83042f82847160 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
@@ -71,6 +71,24 @@ struct ForcedMaxvalInteger16 {
}
};
+/// Placeholder for unsigned*16 version of Maxval Intrinsic
+struct ForcedMaxvalUnsigned16 {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(MaxvalUnsigned16));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
+ {ty});
+ };
+ }
+};
+
/// Placeholder for real*10 version of Minval Intrinsic
struct ForcedMinvalReal10 {
static constexpr const char *name = ExpandAndQuoteKey(RTNAME(MinvalReal10));
@@ -120,15 +138,35 @@ struct ForcedMinvalInteger16 {
}
};
+/// Placeholder for unsigned*16 version of Minval Intrinsic
+struct ForcedMinvalUnsigned16 {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(MinvalUnsigned16));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
+ {ty});
+ };
+ }
+};
+
// Maxloc/Minloc take descriptor, so these runtime signature are not ifdef
// and the mkRTKey can safely be used here. Define alias so that the
// REAL_INTRINSIC_INSTANCES macro works with them too
using ForcedMaxlocReal10 = mkRTKey(MaxlocReal10);
using ForcedMaxlocReal16 = mkRTKey(MaxlocReal16);
using ForcedMaxlocInteger16 = mkRTKey(MaxlocInteger16);
+using ForcedMaxlocUnsigned16 = mkRTKey(MaxlocUnsigned16);
using ForcedMinlocReal10 = mkRTKey(MinlocReal10);
using ForcedMinlocReal16 = mkRTKey(MinlocReal16);
using ForcedMinlocInteger16 = mkRTKey(MinlocInteger16);
+using ForcedMinlocUnsigned16 = mkRTKey(MinlocUnsigned16);
/// Placeholder for real*10 version of Norm2 Intrinsic
struct ForcedNorm2Real10 {
@@ -225,6 +263,24 @@ struct ForcedProductInteger16 {
}
};
+/// Placeholder for unsigned*16 version of Product Intrinsic
+struct ForcedProductUnsigned16 {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(ProductUnsigned16));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
+ {ty});
+ };
+ }
+};
+
/// Placeholder for complex(10) version of Product Intrinsic
struct ForcedProductComplex10 {
static constexpr const char *name =
@@ -345,6 +401,23 @@ struct ForcedDotProductInteger16 {
}
};
+/// Placeholder for unsigned*16 version of DotProduct Intrinsic
+struct ForcedDotProductUnsigned16 {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(DotProductUnsigned16));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ return mlir::FunctionType::get(ctx, {boxTy, boxTy, strTy, intTy}, {ty});
+ };
+ }
+};
+
/// Placeholder for real*10 version of Sum Intrinsic
struct ForcedSumReal10 {
static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SumReal10));
@@ -393,6 +466,23 @@ struct ForcedSumInteger16 {
}
};
+/// Placeholder for unsigned*16 version of Sum Intrinsic
+struct ForcedSumUnsigned16 {
+ static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SumUnsigned16));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
+ {ty});
+ };
+ }
+};
+
/// Placeholder for complex(10) version of Sum Intrinsic
struct ForcedSumComplex10 {
static constexpr const char *name =
@@ -665,6 +755,26 @@ struct ForcedReduceInteger16Ref {
}
};
+/// Placeholder for unsigned*16 version of Reduce Intrinsic
+struct ForcedReduceUnsigned16Ref {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(ReduceUnsigned16Ref));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(ctx, 128);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto refTy = fir::ReferenceType::get(ty);
+ auto opTy = mlir::FunctionType::get(ctx, {refTy, refTy}, refTy);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ auto i1Ty = mlir::IntegerType::get(ctx, 1);
+ return mlir::FunctionType::get(
+ ctx, {boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty}, {ty});
+ };
+ }
+};
+
/// Placeholder for integer*16 with value version of Reduce Intrinsic
struct ForcedReduceInteger16Value {
static constexpr const char *name =
@@ -685,6 +795,26 @@ struct ForcedReduceInteger16Value {
}
};
+/// Placeholder for unsigned*16 with value version of Reduce Intrinsic
+struct ForcedReduceUnsigned16Value {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(ReduceUnsigned16Value));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(ctx, 128);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto refTy = fir::ReferenceType::get(ty);
+ auto opTy = mlir::FunctionType::get(ctx, {ty, ty}, refTy);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ auto i1Ty = mlir::IntegerType::get(ctx, 1);
+ return mlir::FunctionType::get(
+ ctx, {boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty}, {ty});
+ };
+ }
+};
+
/// Placeholder for DIM integer*16 version of Reduce Intrinsic
struct ForcedReduceInteger16DimRef {
static constexpr const char *name =
@@ -707,6 +837,29 @@ struct ForcedReduceInteger16DimRef {
}
};
+/// Placeholder for DIM unsigned*16 version of Reduce Intrinsic
+struct ForcedReduceUnsigned16DimRef {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(ReduceUnsigned16DimRef));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto refTy = fir::ReferenceType::get(ty);
+ auto opTy = mlir::FunctionType::get(ctx, {refTy, refTy}, refTy);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ auto refBoxTy = fir::ReferenceType::get(boxTy);
+ auto i1Ty = mlir::IntegerType::get(ctx, 1);
+ return mlir::FunctionType::get(
+ ctx, {refBoxTy, boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty},
+ {});
+ };
+ }
+};
+
/// Placeholder for DIM integer*16 with value version of Reduce Intrinsic
struct ForcedReduceInteger16DimValue {
static constexpr const char *name =
@@ -729,6 +882,29 @@ struct ForcedReduceInteger16DimValue {
}
};
+/// Placeholder for DIM unsigned*16 with value version of Reduce Intrinsic
+struct ForcedReduceUnsigned16DimValue {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(ReduceUnsigned16DimValue));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto refTy = fir::ReferenceType::get(ty);
+ auto opTy = mlir::FunctionType::get(ctx, {ty, ty}, refTy);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ auto refBoxTy = fir::ReferenceType::get(boxTy);
+ auto i1Ty = mlir::IntegerType::get(ctx, 1);
+ return mlir::FunctionType::get(
+ ctx, {refBoxTy, boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty},
+ {});
+ };
+ }
+};
+
/// Placeholder for complex(10) version of Reduce Intrinsic
struct ForcedReduceComplex10Ref {
static constexpr const char *name =
@@ -919,6 +1095,13 @@ struct ForcedReduceComplex16DimValue {
INTRINSIC_INSTANCE(NAME, Integer, 8, SUFFIX) \
FORCED_INTRINSIC_INSTANCE(NAME, Integer, 16, SUFFIX)
+#define UNSIGNED_INTRINSIC_INSTANCES(NAME, SUFFIX) \
+ INTRINSIC_INSTANCE(NAME, Unsigned, 1, SUFFIX) \
+ INTRINSIC_INSTANCE(NAME, Unsigned, 2, SUFFIX) \
+ INTRINSIC_INSTANCE(NAME, Unsigned, 4, SUFFIX) \
+ INTRINSIC_INSTANCE(NAME, Unsigned, 8, SUFFIX) \
+ FORCED_INTRINSIC_INSTANCE(NAME, Unsigned, 16, SUFFIX)
+
#define REAL_INTRINSIC_INSTANCES(NAME, SUFFIX) \
INTRINSIC_INSTANCE(NAME, Real, 4, SUFFIX) \
INTRINSIC_INSTANCE(NAME, Real, 8, SUFFIX) \
@@ -933,6 +1116,7 @@ struct ForcedReduceComplex16DimValue {
#define NUMERICAL_INTRINSIC_INSTANCES(NAME) \
INTEGER_INTRINSIC_INSTANCES(NAME, ) \
+ UNSIGNED_INTRINSIC_INSTANCES(NAME, ) \
REAL_INTRINSIC_INSTANCES(NAME, ) \
COMPLEX_INTRINSIC_INSTANCES(NAME, )
@@ -944,6 +1128,7 @@ struct ForcedReduceComplex16DimValue {
#define NUMERICAL_AND_LOGICAL_INSTANCES(NAME, SUFFIX) \
INTEGER_INTRINSIC_INSTANCES(NAME, SUFFIX) \
+ UNSIGNED_INTRINSIC_INSTANCES(NAME, SUFFIX) \
REAL_INTRINSIC_INSTANCES(NAME, SUFFIX) \
COMPLEX_INTRINSIC_INSTANCES(NAME, SUFFIX) \
LOGICAL_INTRINSIC_INSTANCES(NAME, SUFFIX)
@@ -1163,6 +1348,7 @@ void fir::runtime::genMaxloc(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::func::FuncOp func;
REAL_INTRINSIC_INSTANCES(Maxloc, )
INTEGER_INTRINSIC_INSTANCES(Maxloc, )
+ UNSIGNED_INTRINSIC_INSTANCES(Maxloc, )
if (charHelper.isCharacterScalar(eleTy))
func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocCharacter)>(loc, builder);
if (!func)
@@ -1195,6 +1381,7 @@ mlir::Value fir::runtime::genMaxval(fir::FirOpBuilder &builder,
mlir::func::FuncOp func;
REAL_INTRINSIC_INSTANCES(Maxval, )
INTEGER_INTRINSIC_INSTANCES(Maxval, )
+ UNSIGNED_INTRINSIC_INSTANCES(Maxval, )
if (!func)
fir::intrinsicTypeTODO(builder, eleTy, loc, "MAXVAL");
@@ -1246,6 +1433,7 @@ void fir::runtime::genMinloc(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::func::FuncOp func;
REAL_INTRINSIC_INSTANCES(Minloc, )
INTEGER_INTRINSIC_INSTANCES(Minloc, )
+ UNSIGNED_INTRINSIC_INSTANCES(Minloc, )
fir::factory::CharacterExprHelper charHelper{builder, loc};
if (charHelper.isCharacterScalar(eleTy))
func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocCharacter)>(loc, builder);
@@ -1305,6 +1493,7 @@ mlir::Value fir::runtime::genMinval(fir::FirOpBuilder &builder,
mlir::func::FuncOp func;
REAL_INTRINSIC_INSTANCES(Minval, )
INTEGER_INTRINSIC_INSTANCES(Minval, )
+ UNSIGNED_INTRINSIC_INSTANCES(Minval, )
if (!func)
fir::intrinsicTypeTODO(builder, eleTy, loc, "MINVAL");
@@ -1659,11 +1848,13 @@ mlir::Value fir::runtime::genReduce(fir::FirOpBuilder &builder,
REAL_2_3_INTRINSIC_INSTANCES(Reduce, Ref)
REAL_INTRINSIC_INSTANCES(Reduce, Ref)
INTEGER_INTRINSIC_INSTANCES(Reduce, Ref)
+ UNSIGNED_INTRINSIC_INSTANCES(Reduce, Ref)
LOGICAL_INTRINSIC_INSTANCES(Reduce, Ref)
} else {
REAL_2_3_INTRINSIC_INSTANCES(Reduce, Value)
REAL_INTRINSIC_INSTANCES(Reduce, Value)
INTEGER_INTRINSIC_INSTANCES(Reduce, Value)
+ UNSIGNED_INTRINSIC_INSTANCES(Reduce, Value)
LOGICAL_INTRINSIC_INSTANCES(Reduce, Value)
}
if (!func)
diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp
index 70c0fd66d18aee..cba7fa64128502 100644
--- a/flang/lib/Optimizer/Dialect/FIRType.cpp
+++ b/flang/lib/Optimizer/Dialect/FIRType.cpp
@@ -442,19 +442,35 @@ unsigned getBoxRank(mlir::Type boxTy) {
/// Return the ISO_C_BINDING intrinsic module value of type \p ty.
int getTypeCode(mlir::Type ty, const fir::KindMapping &kindMap) {
if (mlir::IntegerType intTy = mlir::dyn_cast<mlir::IntegerType>(ty)) {
- switch (intTy.getWidth()) {
- case 8:
- return CFI_type_int8_t;
- case 16:
- return CFI_type_int16_t;
- case 32:
- return CFI_type_int32_t;
- case 64:
- return CFI_type_int64_t;
- case 128:
- return CFI_type_int128_t;
+ if (intTy.isUnsigned()) {
+ switch (intTy.getWidth()) {
+ case 8:
+ return CFI_type_uint8_t;
+ case 16:
+ return CFI_type_uint16_t;
+ case 32:
+ return CFI_type_uint32_t;
+ case 64:
+ return CFI_type_uint64_t;
+ case 128:
+ return CFI_type_uint128_t;
+ }
+ llvm_unreachable("unsupported integer type");
+ } else {
+ switch (intTy.getWidth()) {
+ case 8:
+ return CFI_type_int8_t;
+ case 16:
+ return CFI_type_int16_t;
+ case 32:
+ return CFI_type_int32_t;
+ case 64:
+ return CFI_type_int64_t;
+ case 128:
+ return CFI_type_int128_t;
+ }
+ llvm_unreachable("unsupported integer type");
}
- llvm_unreachable("unsupported integer type");
}
if (fir::LogicalType logicalTy = mlir::dyn_cast<fir::LogicalType>(ty)) {
switch (kindMap.getLogicalBitsize(logicalTy.getFKind())) {
@@ -804,6 +820,19 @@ void fir::IntegerType::print(mlir::AsmPrinter &printer) const {
printer << "<" << getFKind() << '>';
}
+//===----------------------------------------------------------------------===//
+// UnsignedType
+//===----------------------------------------------------------------------===//
+
+// `unsigned` `<` kind `>`
+mlir::Type fir::UnsignedType::parse(mlir::AsmParser &parser) {
+ return parseKindSingleton<fir::UnsignedType>(parser);
+}
+
+void fir::UnsignedType::print(mlir::AsmPrinter &printer) const {
+ printer << "<" << getFKind() << '>';
+}
+
//===----------------------------------------------------------------------===//
// LogicalType
//===----------------------------------------------------------------------===//
diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp
index 0bdc4c4e033c76..451b74fb589697 100644
--- a/flang/lib/Parser/Fortran-parsers.cpp
+++ b/flang/lib/Parser/Fortran-parsers.cpp
@@ -134,7 +134,8 @@ TYPE_CONTEXT_PARSER("internal subprogram part"_en_US,
// R605 literal-constant ->
// int-literal-constant | real-literal-constant |
// complex-literal-constant | logical-literal-constant |
-// char-literal-constant | boz-literal-constant
+// char-literal-constant | boz-literal-constant |
+// unsigned-literal-constant
TYPE_PARSER(
first(construct<LiteralConstant>(Parser<HollerithLiteralConstant>{}),
construct<LiteralConstant>(realLiteralConstant),
@@ -142,7 +143,8 @@ TYPE_PARSER(
construct<LiteralConstant>(Parser<ComplexLiteralConstant>{}),
construct<LiteralConstant>(Parser<BOZLiteralConstant>{}),
construct<LiteralConstant>(charLiteralConstant),
- construct<LiteralConstant>(Parser<LogicalLiteralConstant>{})))
+ construct<LiteralConstant>(Parser<LogicalLiteralConstant>{}),
+ construct<LiteralConstant>(unsignedLiteralConstant)))
// R606 named-constant -> name
TYPE_PARSER(construct<NamedConstant>(name))
@@ -219,7 +221,10 @@ TYPE_CONTEXT_PARSER("intrinsic type spec"_en_US,
construct<IntrinsicTypeSpec::DoubleComplex>())),
extension<LanguageFeature::Byte>("nonstandard usage: BYTE"_port_en_US,
construct<IntrinsicTypeSpec>(construct<IntegerTypeSpec>(
- "BYTE" >> construct<std::optional<KindSelector>>(pure(1)))))))
+ "BYTE" >> construct<std::optional<KindSelector>>(pure(1))))),
+ extension<LanguageFeature::Unsigned>(
+ "nonstandard usage: UNSIGNED"_port_en_US,
+ construct<IntrinsicTypeSpec>(unsignedTypeSpec))))
// Extension: Vector type
// VECTOR(intrinsic-type-spec) | __VECTOR_PAIR | __VECTOR_QUAD
@@ -233,7 +238,7 @@ TYPE_CONTEXT_PARSER("vector type spec"_en_US,
construct<VectorTypeSpec::QuadVectorTypeSpec>()))))
// VECTOR(integer-type-spec) | VECTOR(real-type-spec) |
-// VECTOR(unsigend-type-spec) |
+// VECTOR(unsigned-type-spec) |
TYPE_PARSER(construct<IntrinsicVectorTypeSpec>("VECTOR" >>
parenthesized(construct<VectorElementType>(integerTypeSpec) ||
construct<VectorElementType>(unsignedTypeSpec) ||
@@ -266,7 +271,11 @@ TYPE_PARSER(sourced(
// R708 int-literal-constant -> digit-string [_ kind-param]
// The negated look-ahead for a trailing underscore prevents misrecognition
// when the digit string is a numeric kind parameter of a character literal.
-TYPE_PARSER(construct<IntLiteralConstant>(space >> digitString,
+TYPE_PARSER(construct<IntLiteralConstant>(space >> digitString / !"u"_tok,
+ maybe(underscore >> noSpace >> kindParam) / !underscore))
+
+// unsigned-literal-constant -> digit-string U [_ kind-param]
+TYPE_PARSER(construct<UnsignedLiteralConstant>(space >> digitString / "u",
maybe(underscore >> noSpace >> kindParam) / !underscore))
// R709 kind-param -> digit-string | scalar-int-constant-name
@@ -1026,8 +1035,10 @@ constexpr auto implicitSpecDeclarationTypeSpecRetry{
construct<IntrinsicTypeSpec::Complex>("COMPLEX" >> noKindSelector)),
construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Character>(
"CHARACTER" >> construct<std::optional<CharSelector>>())),
- construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Logical>(
- "LOGICAL" >> noKindSelector))))};
+ construct<IntrinsicTypeSpec>(
+ construct<IntrinsicTypeSpec::Logical>("LOGICAL" >> noKindSelector)),
+ construct<IntrinsicTypeSpec>(
+ construct<UnsignedTypeSpec>("UNSIGNED" >> noKindSelector))))};
TYPE_PARSER(construct<ImplicitSpec>(declarationTypeSpec,
parenthesized(nonemptyList(Parser<LetterSpec>{}))) ||
diff --git a/flang/lib/Parser/type-parsers.h b/flang/lib/Parser/type-parsers.h
index da7d017d597681..32ae3c1be0df16 100644
--- a/flang/lib/Parser/type-parsers.h
+++ b/flang/lib/Parser/type-parsers.h
@@ -59,6 +59,7 @@ constexpr Parser<IntegerTypeSpec> integerTypeSpec; // R705
constexpr Parser<KindSelector> kindSelector; // R706
constexpr Parser<SignedIntLiteralConstant> signedIntLiteralConstant; // R707
constexpr Parser<IntLiteralConstant> intLiteralConstant; // R708
+constexpr Parser<UnsignedLiteralConstant> unsignedLiteralConstant;
constexpr Parser<KindParam> kindParam; // R709
constexpr Parser<RealLiteralConstant> realLiteralConstant; // R714
constexpr Parser<CharLength> charLength; // R723
diff --git a/flang/lib/Semantics/check-arithmeticif.cpp b/flang/lib/Semantics/check-arithmeticif.cpp
index f87a0045fff5b5..8559bef6ce2f71 100644
--- a/flang/lib/Semantics/check-arithmeticif.cpp
+++ b/flang/lib/Semantics/check-arithmeticif.cpp
@@ -32,6 +32,9 @@ void ArithmeticIfStmtChecker::Leave(
} else if (ExprHasTypeCategory(*expr, common::TypeCategory::Complex)) {
context_.Say(parsedExpr.source,
"ARITHMETIC IF expression must not be a COMPLEX expression"_err_en_US);
+ } else if (ExprHasTypeCategory(*expr, common::TypeCategory::Unsigned)) {
+ context_.Say(parsedExpr.source,
+ "ARITHMETIC IF expression must not be an UNSIGNED expression"_err_en_US);
} else if (!IsNumericExpr(*expr)) {
context_.Say(parsedExpr.source,
"ARITHMETIC IF expression must be a numeric expression"_err_en_US);
diff --git a/flang/lib/Semantics/check-case.cpp b/flang/lib/Semantics/check-case.cpp
index caa8f8b6e70be8..5ce143c9aec91a 100644
--- a/flang/lib/Semantics/check-case.cpp
+++ b/flang/lib/Semantics/check-case.cpp
@@ -253,6 +253,10 @@ void CaseChecker::Enter(const parser::CaseConstruct &construct) {
common::SearchTypes(
TypeVisitor<TypeCategory::Integer>{context_, *exprType, caseList});
return;
+ case TypeCategory::Unsigned:
+ common::SearchTypes(
+ TypeVisitor<TypeCategory::Unsigned>{context_, *exprType, caseList});
+ return;
case TypeCategory::Logical:
CaseValues<evaluate::Type<TypeCategory::Logical, 1>>{context_, *exprType}
.Check(caseList);
@@ -266,6 +270,8 @@ void CaseChecker::Enter(const parser::CaseConstruct &construct) {
}
}
context_.Say(selectExpr.source,
- "SELECT CASE expression must be integer, logical, or character"_err_en_US);
+ context_.IsEnabled(common::LanguageFeature::Unsigned)
+ ? "SELECT CASE expression must be integer, unsigned, logical, or character"_err_en_US
+ : "SELECT CASE expression must be integer, logical, or character"_err_en_US);
}
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index c70c8a8aecc2f8..4289b7f85edf0f 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -650,10 +650,11 @@ int ExpressionAnalyzer::AnalyzeKindParam(
return static_cast<int>(kind);
}
-// Common handling of parser::IntLiteralConstant and SignedIntLiteralConstant
-struct IntTypeVisitor {
+// Common handling of parser::IntLiteralConstant, SignedIntLiteralConstant,
+// and UnsignedLiteralConstant
+template <typename TYPES, TypeCategory CAT> struct IntTypeVisitor {
using Result = MaybeExpr;
- using Types = IntegerTypes;
+ using Types = TYPES;
template <typename T> Result Test() {
if (T::kind >= kind) {
const char *p{digits.begin()};
@@ -668,7 +669,7 @@ struct IntTypeVisitor {
"negated maximum INTEGER(KIND=%d) literal"_port_en_US, T::kind);
}
} else {
- num = Int::Read(p, 10, true /*signed*/);
+ num = Int::Read(p, 10, /*isSigned=*/CAT == TypeCategory::Integer);
}
if (!num.overflow) {
if (T::kind > kind) {
@@ -676,14 +677,16 @@ struct IntTypeVisitor {
!analyzer.context().IsEnabled(LanguageFeature::BigIntLiterals)) {
return std::nullopt;
} else {
+ const char *typeName{
+ CAT == TypeCategory::Integer ? "INTEGER" : "UNSIGNED"};
analyzer.Warn(LanguageFeature::BigIntLiterals, digits,
- "Integer literal is too large for default INTEGER(KIND=%d); "
- "assuming INTEGER(KIND=%d)"_port_en_US,
- kind, T::kind);
+ "Integer literal is too large for default %s(KIND=%d); "
+ "assuming %s(KIND=%d)"_port_en_US,
+ typeName, kind, typeName, T::kind);
}
}
return Expr<SomeType>{
- Expr<SomeInteger>{Expr<T>{Constant<T>{std::move(num.value)}}}};
+ Expr<SomeKind<CAT>>{Expr<T>{Constant<T>{std::move(num.value)}}}};
}
}
return std::nullopt;
@@ -695,24 +698,25 @@ struct IntTypeVisitor {
bool isNegated;
};
-template <typename PARSED>
+template <typename TYPES, TypeCategory CAT, typename PARSED>
MaybeExpr ExpressionAnalyzer::IntLiteralConstant(
const PARSED &x, bool isNegated) {
const auto &kindParam{std::get<std::optional<parser::KindParam>>(x.t)};
bool isDefaultKind{!kindParam};
- int kind{AnalyzeKindParam(kindParam, GetDefaultKind(TypeCategory::Integer))};
- if (CheckIntrinsicKind(TypeCategory::Integer, kind)) {
+ int kind{AnalyzeKindParam(kindParam, GetDefaultKind(CAT))};
+ 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{*this, digits, kind, isDefaultKind, isNegated})}) {
+ if (MaybeExpr result{common::SearchTypes(IntTypeVisitor<TYPES, CAT>{
+ *this, digits, kind, isDefaultKind, isNegated})}) {
return result;
} else if (isDefaultKind) {
Say(digits,
- "Integer literal is too large for any allowable "
- "kind of INTEGER"_err_en_US);
+ "Integer literal is too large for any allowable kind of %s"_err_en_US,
+ typeName);
} else {
- Say(digits, "Integer literal is too large for INTEGER(KIND=%d)"_err_en_US,
- kind);
+ Say(digits, "Integer literal is too large for %s(KIND=%d)"_err_en_US,
+ typeName, kind);
}
}
return std::nullopt;
@@ -722,13 +726,20 @@ MaybeExpr ExpressionAnalyzer::Analyze(
const parser::IntLiteralConstant &x, bool isNegated) {
auto restorer{
GetContextualMessages().SetLocation(std::get<parser::CharBlock>(x.t))};
- return IntLiteralConstant(x, isNegated);
+ return IntLiteralConstant<IntegerTypes, TypeCategory::Integer>(x, isNegated);
}
MaybeExpr ExpressionAnalyzer::Analyze(
const parser::SignedIntLiteralConstant &x) {
auto restorer{GetContextualMessages().SetLocation(x.source)};
- return IntLiteralConstant(x);
+ return IntLiteralConstant<IntegerTypes, TypeCategory::Integer>(x);
+}
+
+MaybeExpr ExpressionAnalyzer::Analyze(
+ const parser::UnsignedLiteralConstant &x) {
+ auto restorer{
+ GetContextualMessages().SetLocation(std::get<parser::CharBlock>(x.t))};
+ return IntLiteralConstant<UnsignedTypes, TypeCategory::Unsigned>(x);
}
template <typename TYPE>
@@ -3492,9 +3503,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedUnary &x) {
// Binary (dyadic) operations
-template <template <typename> class OPR>
-MaybeExpr NumericBinaryHelper(ExpressionAnalyzer &context, NumericOperator opr,
- const parser::Expr::IntrinsicBinary &x) {
+template <template <typename> class OPR, NumericOperator opr>
+MaybeExpr NumericBinaryHelper(
+ ExpressionAnalyzer &context, const parser::Expr::IntrinsicBinary &x) {
ArgumentAnalyzer analyzer{context};
analyzer.Analyze(std::get<0>(x.t));
analyzer.Analyze(std::get<1>(x.t));
@@ -3503,9 +3514,10 @@ MaybeExpr NumericBinaryHelper(ExpressionAnalyzer &context, NumericOperator opr,
analyzer.CheckForNullPointer();
analyzer.CheckForAssumedRank();
analyzer.CheckConformance();
- return NumericOperation<OPR>(context.GetContextualMessages(),
- analyzer.MoveExpr(0), analyzer.MoveExpr(1),
- context.GetDefaultKind(TypeCategory::Real));
+ constexpr bool canBeUnsigned{opr != NumericOperator::Power};
+ return NumericOperation<OPR, canBeUnsigned>(
+ context.GetContextualMessages(), analyzer.MoveExpr(0),
+ analyzer.MoveExpr(1), context.GetDefaultKind(TypeCategory::Real));
} else {
return analyzer.TryDefinedOp(AsFortran(opr),
"Operands of %s must be numeric; have %s and %s"_err_en_US);
@@ -3515,23 +3527,23 @@ MaybeExpr NumericBinaryHelper(ExpressionAnalyzer &context, NumericOperator opr,
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Power &x) {
- return NumericBinaryHelper<Power>(*this, NumericOperator::Power, x);
+ return NumericBinaryHelper<Power, NumericOperator::Power>(*this, x);
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Multiply &x) {
- return NumericBinaryHelper<Multiply>(*this, NumericOperator::Multiply, x);
+ return NumericBinaryHelper<Multiply, NumericOperator::Multiply>(*this, x);
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Divide &x) {
- return NumericBinaryHelper<Divide>(*this, NumericOperator::Divide, x);
+ return NumericBinaryHelper<Divide, NumericOperator::Divide>(*this, x);
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Add &x) {
- return NumericBinaryHelper<Add>(*this, NumericOperator::Add, x);
+ return NumericBinaryHelper<Add, NumericOperator::Add>(*this, x);
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Subtract &x) {
- return NumericBinaryHelper<Subtract>(*this, NumericOperator::Subtract, x);
+ return NumericBinaryHelper<Subtract, NumericOperator::Subtract>(*this, x);
}
MaybeExpr ExpressionAnalyzer::Analyze(
@@ -4321,9 +4333,9 @@ bool ArgumentAnalyzer::CheckConformance() {
}
bool ArgumentAnalyzer::CheckAssignmentConformance() {
- if (actuals_.size() == 2) {
- const auto *lhs{actuals_.at(0).value().UnwrapExpr()};
- const auto *rhs{actuals_.at(1).value().UnwrapExpr()};
+ if (actuals_.size() == 2 && actuals_[0] && actuals_[1]) {
+ const auto *lhs{actuals_[0]->UnwrapExpr()};
+ const auto *rhs{actuals_[1]->UnwrapExpr()};
if (lhs && rhs) {
auto &foldingContext{context_.GetFoldingContext()};
auto lhShape{GetShape(foldingContext, *lhs)};
@@ -4515,6 +4527,7 @@ std::optional<ProcedureRef> ArgumentAnalyzer::TryDefinedAssignment() {
}
} else {
if (lhsType->category() == TypeCategory::Integer ||
+ lhsType->category() == TypeCategory::Unsigned ||
lhsType->category() == TypeCategory::Real) {
ConvertBOZ(nullptr, 1, lhsType);
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f1ce0b415ebe9c..131594b8fd4820 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -979,6 +979,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
bool Pre(const parser::TypeDeclarationStmt &);
void Post(const parser::TypeDeclarationStmt &);
void Post(const parser::IntegerTypeSpec &);
+ void Post(const parser::UnsignedTypeSpec &);
void Post(const parser::IntrinsicTypeSpec::Real &);
void Post(const parser::IntrinsicTypeSpec::Complex &);
void Post(const parser::IntrinsicTypeSpec::Logical &);
@@ -5224,6 +5225,11 @@ void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) {
SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v));
}
}
+void DeclarationVisitor::Post(const parser::UnsignedTypeSpec &x) {
+ if (!isVectorType_) {
+ SetDeclTypeSpec(MakeNumericType(TypeCategory::Unsigned, x.v));
+ }
+}
void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) {
if (!isVectorType_) {
SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind));
diff --git a/flang/lib/Semantics/scope.cpp b/flang/lib/Semantics/scope.cpp
index 6ee53cde56866c..9c5682bed06cbb 100644
--- a/flang/lib/Semantics/scope.cpp
+++ b/flang/lib/Semantics/scope.cpp
@@ -215,6 +215,7 @@ const DeclTypeSpec *Scope::GetType(const SomeExpr &expr) {
} else {
switch (dyType->category()) {
case TypeCategory::Integer:
+ case TypeCategory::Unsigned:
case TypeCategory::Real:
case TypeCategory::Complex:
return &MakeNumericType(dyType->category(), KindExpr{dyType->kind()});
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 379d5d0eb3eef0..a8ba05f2a975a6 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -143,7 +143,9 @@ Tristate IsDefinedAssignment(
return Tristate::Yes;
} else if (lhsCat != TypeCategory::Derived) {
return ToTristate(lhsCat != rhsCat &&
- (!IsNumericTypeCategory(lhsCat) || !IsNumericTypeCategory(rhsCat)));
+ (!IsNumericTypeCategory(lhsCat) || !IsNumericTypeCategory(rhsCat) ||
+ lhsCat == TypeCategory::Unsigned ||
+ rhsCat == TypeCategory::Unsigned));
} else if (MightBeSameDerivedType(lhsType, rhsType)) {
return Tristate::Maybe; // TYPE(t) = TYPE(t) can be defined or intrinsic
} else {
diff --git a/flang/module/iso_c_binding.f90 b/flang/module/iso_c_binding.f90
index eb0f8f2ef59ad6..0d50e693758ecb 100644
--- a/flang/module/iso_c_binding.f90
+++ b/flang/module/iso_c_binding.f90
@@ -110,6 +110,35 @@ module iso_c_binding
integer, parameter, public :: &
c_float128 = 16, &
c_float128_complex = c_float128
+ integer, parameter, public :: &
+ c_uint8_t = 1, &
+ c_uint16_t = 2, &
+ c_uint32_t = 4, &
+ c_uint64_t = 8, &
+ c_uint128_t = 16
+ integer, parameter, public :: &
+ c_unsigned_char = c_uint8_t, &
+ c_unsigned_short = c_uint16_t, &
+ c_unsigned = c_uint32_t, &
+ c_unsigned_long = c_uint64_t, &
+ c_unsigned_long_long = c_unsigned_long, &
+#if __powerpc__
+ c_uintmax_t = c_uint64_t
+#else
+ c_uintmax_t = c_uint128_t
+#endif
+ integer, parameter, public :: &
+ c_fast_uint8_t = c_uint8_t, &
+ c_fast_uint16_t = c_uint16_t, &
+ c_fast_uint32_t = c_uint32_t, &
+ c_fast_uint64_t = c_uint64_t, &
+ c_fast_uint128_t = c_uint128_t
+ integer, parameter, public :: &
+ c_least_uint8_t = c_uint8_t, &
+ c_least_uint16_t = c_uint16_t, &
+ c_least_uint32_t = c_uint32_t, &
+ c_least_uint64_t = c_uint64_t, &
+ c_least_uint128_t = c_uint128_t
contains
diff --git a/flang/module/iso_fortran_env.f90 b/flang/module/iso_fortran_env.f90
index 4e575b422c2a04..ea523ca64f3041 100644
--- a/flang/module/iso_fortran_env.f90
+++ b/flang/module/iso_fortran_env.f90
@@ -26,6 +26,9 @@ module iso_fortran_env
selectedInt8, selectedInt16, selectedInt32, selectedInt64, selectedInt128, &
safeInt8, safeInt16, safeInt32, safeInt64, safeInt128, &
int8, int16, int32, int64, int128, &
+ selectedUInt8, selectedUInt16, selectedUInt32, selectedUInt64, selectedUInt128, &
+ safeUInt8, safeUInt16, safeUInt32, safeUInt64, safeUInt128, &
+ uint8, uint16, uint32, uint64, uint128, &
logical8, logical16, logical32, logical64, &
selectedReal16, selectedBfloat16, selectedReal32, &
selectedReal64, selectedReal80, selectedReal64x2, &
diff --git a/flang/module/iso_fortran_env_impl.f90 b/flang/module/iso_fortran_env_impl.f90
index 4de54dda7bab1c..5408e7de370011 100644
--- a/flang/module/iso_fortran_env_impl.f90
+++ b/flang/module/iso_fortran_env_impl.f90
@@ -44,6 +44,36 @@ module iso_fortran_env_impl
int128 = merge(selectedInt128, merge(-2, -1, selectedInt128 >= 0), &
digits(int(0,kind=safeInt128)) == 127)
+ ! UNSIGNED types
+ integer, parameter, public :: &
+ selectedUInt8 = selected_unsigned_kind(2), &
+ selectedUInt16 = selected_unsigned_kind(4), &
+ selectedUInt32 = selected_unsigned_kind(9), &
+ selectedUInt64 = selected_unsigned_kind(18),&
+ selectedUInt128 = selected_unsigned_kind(38), &
+ safeUInt8 = merge(selectedUInt8, selected_unsigned_kind(0), &
+ selectedUInt8 >= 0), &
+ safeUInt16 = merge(selectedUInt16, selected_unsigned_kind(0), &
+ selectedUInt16 >= 0), &
+ safeUInt32 = merge(selectedUInt32, selected_unsigned_kind(0), &
+ selectedUInt32 >= 0), &
+ safeUInt64 = merge(selectedUInt64, selected_unsigned_kind(0), &
+ selectedUInt64 >= 0), &
+ safeUInt128 = merge(selectedUInt128, selected_unsigned_kind(0), &
+ selectedUInt128 >= 0)
+
+ integer, parameter, public :: &
+ uint8 = merge(selectedUInt8, merge(-2, -1, selectedUInt8 >= 0), &
+ digits(uint(0,kind=safeUInt8)) == 8), &
+ uint16 = merge(selectedUInt16, merge(-2, -1, selectedUInt16 >= 0), &
+ digits(uint(0,kind=safeUInt16)) == 16), &
+ uint32 = merge(selectedUInt32, merge(-2, -1, selectedUInt32 >= 0), &
+ digits(uint(0,kind=safeUInt32)) == 32), &
+ uint64 = merge(selectedUInt64, merge(-2, -1, selectedUInt64 >= 0), &
+ digits(uint(0,kind=safeUInt64)) == 64), &
+ uint128 = merge(selectedUInt128, merge(-2, -1, selectedUInt128 >= 0), &
+ digits(uint(0,kind=safeUInt128)) == 128)
+
integer, parameter, dimension(*), public :: __builtin_integer_kinds = [ &
selected_int_kind(0), &
[(pack([selected_int_kind(k)], &
diff --git a/flang/runtime/descriptor-io.h b/flang/runtime/descriptor-io.h
index ff5f683c6da52f..3385da4b1d4b1a 100644
--- a/flang/runtime/descriptor-io.h
+++ b/flang/runtime/descriptor-io.h
@@ -45,18 +45,18 @@ inline RT_API_ATTRS A &ExtractElement(IoStatementState &io,
// NAMELIST array output.
template <int KIND, Direction DIR>
-inline RT_API_ATTRS bool FormattedIntegerIO(
- IoStatementState &io, const Descriptor &descriptor) {
+inline RT_API_ATTRS bool FormattedIntegerIO(IoStatementState &io,
+ const Descriptor &descriptor, [[maybe_unused]] bool isSigned) {
std::size_t numElements{descriptor.Elements()};
SubscriptValue subscripts[maxRank];
descriptor.GetLowerBounds(subscripts);
- using IntType = CppTypeFor<TypeCategory::Integer, KIND>;
+ using IntType = CppTypeFor<common::TypeCategory::Integer, KIND>;
bool anyInput{false};
for (std::size_t j{0}; j < numElements; ++j) {
if (auto edit{io.GetNextDataEdit()}) {
IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};
if constexpr (DIR == Direction::Output) {
- if (!EditIntegerOutput<KIND>(io, *edit, x)) {
+ if (!EditIntegerOutput<KIND>(io, *edit, x, isSigned)) {
return false;
}
} else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
@@ -517,20 +517,37 @@ static RT_API_ATTRS bool DescriptorIO(IoStatementState &io,
case TypeCategory::Integer:
switch (kind) {
case 1:
- return FormattedIntegerIO<1, DIR>(io, descriptor);
+ return FormattedIntegerIO<1, DIR>(io, descriptor, true);
case 2:
- return FormattedIntegerIO<2, DIR>(io, descriptor);
+ return FormattedIntegerIO<2, DIR>(io, descriptor, true);
case 4:
- return FormattedIntegerIO<4, DIR>(io, descriptor);
+ return FormattedIntegerIO<4, DIR>(io, descriptor, true);
case 8:
- return FormattedIntegerIO<8, DIR>(io, descriptor);
+ return FormattedIntegerIO<8, DIR>(io, descriptor, true);
case 16:
- return FormattedIntegerIO<16, DIR>(io, descriptor);
+ return FormattedIntegerIO<16, DIR>(io, descriptor, true);
default:
handler.Crash(
"not yet implemented: INTEGER(KIND=%d) in formatted IO", kind);
return false;
}
+ case TypeCategory::Unsigned:
+ switch (kind) {
+ case 1:
+ return FormattedIntegerIO<1, DIR>(io, descriptor, false);
+ case 2:
+ return FormattedIntegerIO<2, DIR>(io, descriptor, false);
+ case 4:
+ return FormattedIntegerIO<4, DIR>(io, descriptor, false);
+ case 8:
+ return FormattedIntegerIO<8, DIR>(io, descriptor, false);
+ case 16:
+ return FormattedIntegerIO<16, DIR>(io, descriptor, false);
+ default:
+ handler.Crash(
+ "not yet implemented: UNSIGNED(KIND=%d) in formatted IO", kind);
+ return false;
+ }
case TypeCategory::Real:
switch (kind) {
case 2:
diff --git a/flang/runtime/dot-product.cpp b/flang/runtime/dot-product.cpp
index 335e5929f0865e..712497a3a50aca 100644
--- a/flang/runtime/dot-product.cpp
+++ b/flang/runtime/dot-product.cpp
@@ -180,6 +180,29 @@ CppTypeFor<TypeCategory::Integer, 16> RTDEF(DotProductInteger16)(
}
#endif
+CppTypeFor<TypeCategory::Unsigned, 1> RTDEF(DotProductUnsigned1)(
+ const Descriptor &x, const Descriptor &y, const char *source, int line) {
+ return DotProduct<TypeCategory::Unsigned, 1>{}(x, y, source, line);
+}
+CppTypeFor<TypeCategory::Unsigned, 2> RTDEF(DotProductUnsigned2)(
+ const Descriptor &x, const Descriptor &y, const char *source, int line) {
+ return DotProduct<TypeCategory::Unsigned, 2>{}(x, y, source, line);
+}
+CppTypeFor<TypeCategory::Unsigned, 4> RTDEF(DotProductUnsigned4)(
+ const Descriptor &x, const Descriptor &y, const char *source, int line) {
+ return DotProduct<TypeCategory::Unsigned, 4>{}(x, y, source, line);
+}
+CppTypeFor<TypeCategory::Unsigned, 8> RTDEF(DotProductUnsigned8)(
+ const Descriptor &x, const Descriptor &y, const char *source, int line) {
+ return DotProduct<TypeCategory::Unsigned, 8>{}(x, y, source, line);
+}
+#ifdef __SIZEOF_INT128__
+CppTypeFor<TypeCategory::Unsigned, 16> RTDEF(DotProductUnsigned16)(
+ const Descriptor &x, const Descriptor &y, const char *source, int line) {
+ return DotProduct<TypeCategory::Unsigned, 16>{}(x, y, source, line);
+}
+#endif
+
// TODO: REAL/COMPLEX(2 & 3)
// Intermediate results and operations are at least 64 bits
CppTypeFor<TypeCategory::Real, 4> RTDEF(DotProductReal4)(
diff --git a/flang/runtime/edit-output.cpp b/flang/runtime/edit-output.cpp
index 9d60732258bfbc..9db9a3d4a511b0 100644
--- a/flang/runtime/edit-output.cpp
+++ b/flang/runtime/edit-output.cpp
@@ -109,10 +109,10 @@ static RT_API_ATTRS bool EditBOZOutput(IoStatementState &io,
template <int KIND>
bool RT_API_ATTRS EditIntegerOutput(IoStatementState &io, const DataEdit &edit,
- common::HostSignedIntType<8 * KIND> n) {
+ common::HostSignedIntType<8 * KIND> n, bool isSigned) {
addSpaceBeforeCharacter(io);
char buffer[130], *end{&buffer[sizeof buffer]}, *p{end};
- bool isNegative{n < 0};
+ bool isNegative{isSigned && n < 0};
using Unsigned = common::HostUnsignedIntType<8 * KIND>;
Unsigned un{static_cast<Unsigned>(n)};
int signChars{0};
@@ -933,15 +933,15 @@ RT_API_ATTRS bool EditCharacterOutput(IoStatementState &io,
}
template RT_API_ATTRS bool EditIntegerOutput<1>(
- IoStatementState &, const DataEdit &, std::int8_t);
+ IoStatementState &, const DataEdit &, std::int8_t, bool);
template RT_API_ATTRS bool EditIntegerOutput<2>(
- IoStatementState &, const DataEdit &, std::int16_t);
+ IoStatementState &, const DataEdit &, std::int16_t, bool);
template RT_API_ATTRS bool EditIntegerOutput<4>(
- IoStatementState &, const DataEdit &, std::int32_t);
+ IoStatementState &, const DataEdit &, std::int32_t, bool);
template RT_API_ATTRS bool EditIntegerOutput<8>(
- IoStatementState &, const DataEdit &, std::int64_t);
+ IoStatementState &, const DataEdit &, std::int64_t, bool);
template RT_API_ATTRS bool EditIntegerOutput<16>(
- IoStatementState &, const DataEdit &, common::int128_t);
+ IoStatementState &, const DataEdit &, common::int128_t, bool);
template class RealOutputEditing<2>;
template class RealOutputEditing<3>;
diff --git a/flang/runtime/edit-output.h b/flang/runtime/edit-output.h
index 365bc2e2a4d10b..42cc993f98cc1c 100644
--- a/flang/runtime/edit-output.h
+++ b/flang/runtime/edit-output.h
@@ -30,8 +30,8 @@ namespace Fortran::runtime::io {
// one edit descriptor with a repeat factor may safely serve to edit
// multiple elements of an array.
template <int KIND>
-RT_API_ATTRS bool EditIntegerOutput(
- IoStatementState &, const DataEdit &, common::HostSignedIntType<8 * KIND>);
+RT_API_ATTRS bool EditIntegerOutput(IoStatementState &, const DataEdit &,
+ common::HostSignedIntType<8 * KIND>, bool isSigned);
// Encapsulates the state of a REAL output conversion.
class RealOutputEditingBase {
@@ -119,15 +119,15 @@ extern template RT_API_ATTRS bool EditCharacterOutput(
IoStatementState &, const DataEdit &, const char32_t *, std::size_t chars);
extern template RT_API_ATTRS bool EditIntegerOutput<1>(
- IoStatementState &, const DataEdit &, std::int8_t);
+ IoStatementState &, const DataEdit &, std::int8_t, bool);
extern template RT_API_ATTRS bool EditIntegerOutput<2>(
- IoStatementState &, const DataEdit &, std::int16_t);
+ IoStatementState &, const DataEdit &, std::int16_t, bool);
extern template RT_API_ATTRS bool EditIntegerOutput<4>(
- IoStatementState &, const DataEdit &, std::int32_t);
+ IoStatementState &, const DataEdit &, std::int32_t, bool);
extern template RT_API_ATTRS bool EditIntegerOutput<8>(
- IoStatementState &, const DataEdit &, std::int64_t);
+ IoStatementState &, const DataEdit &, std::int64_t, bool);
extern template RT_API_ATTRS bool EditIntegerOutput<16>(
- IoStatementState &, const DataEdit &, common::int128_t);
+ IoStatementState &, const DataEdit &, common::int128_t, bool);
extern template class RealOutputEditing<2>;
extern template class RealOutputEditing<3>;
diff --git a/flang/runtime/extrema.cpp b/flang/runtime/extrema.cpp
index 9442fa50f4c794..4cd17f26a8d57d 100644
--- a/flang/runtime/extrema.cpp
+++ b/flang/runtime/extrema.cpp
@@ -226,6 +226,33 @@ void RTDEF(MaxlocInteger16)(Descriptor &result, const Descriptor &x, int kind,
"MAXLOC", result, x, kind, source, line, mask, back);
}
#endif
+void RTDEF(MaxlocUnsigned1)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 1, true>(
+ "MAXLOC", result, x, kind, source, line, mask, back);
+}
+void RTDEF(MaxlocUnsigned2)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 2, true>(
+ "MAXLOC", result, x, kind, source, line, mask, back);
+}
+void RTDEF(MaxlocUnsigned4)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 4, true>(
+ "MAXLOC", result, x, kind, source, line, mask, back);
+}
+void RTDEF(MaxlocUnsigned8)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 8, true>(
+ "MAXLOC", result, x, kind, source, line, mask, back);
+}
+#ifdef __SIZEOF_INT128__
+void RTDEF(MaxlocUnsigned16)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 16, true>(
+ "MAXLOC", result, x, kind, source, line, mask, back);
+}
+#endif
void RTDEF(MaxlocReal4)(Descriptor &result, const Descriptor &x, int kind,
const char *source, int line, const Descriptor *mask, bool back) {
TotalNumericMaxOrMinLoc<TypeCategory::Real, 4, true>(
@@ -255,7 +282,7 @@ void RTDEF(MinlocCharacter)(Descriptor &result, const Descriptor &x, int kind,
CharacterMaxOrMinLoc<false>(
"MINLOC", result, x, kind, source, line, mask, back);
}
-void RTDEF(MinlocInteger1)(Descriptor &result, const Descriptor &x, int kind,
+void RTDEF(Minloc1)(Descriptor &result, const Descriptor &x, int kind,
const char *source, int line, const Descriptor *mask, bool back) {
TotalNumericMaxOrMinLoc<TypeCategory::Integer, 1, false>(
"MINLOC", result, x, kind, source, line, mask, back);
@@ -282,6 +309,33 @@ void RTDEF(MinlocInteger16)(Descriptor &result, const Descriptor &x, int kind,
"MINLOC", result, x, kind, source, line, mask, back);
}
#endif
+void RTDEF(MinlocUnsigned1)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 1, false>(
+ "MINLOC", result, x, kind, source, line, mask, back);
+}
+void RTDEF(MinlocUnsigned2)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 2, false>(
+ "MINLOC", result, x, kind, source, line, mask, back);
+}
+void RTDEF(MinlocUnsigned4)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 4, false>(
+ "MINLOC", result, x, kind, source, line, mask, back);
+}
+void RTDEF(MinlocUnsigned8)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 8, false>(
+ "MINLOC", result, x, kind, source, line, mask, back);
+}
+#ifdef __SIZEOF_INT128__
+void RTDEF(MinlocUnsigned16)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 16, false>(
+ "MINLOC", result, x, kind, source, line, mask, back);
+}
+#endif
void RTDEF(MinlocReal4)(Descriptor &result, const Descriptor &x, int kind,
const char *source, int line, const Descriptor *mask, bool back) {
TotalNumericMaxOrMinLoc<TypeCategory::Real, 4, false>(
@@ -386,6 +440,12 @@ inline RT_API_ATTRS void TypedPartialMaxOrMinLoc(const char *intrinsic,
void>(catKind->second, terminator, intrinsic, result, x, kind, dim,
maskToUse, back, terminator);
break;
+ case TypeCategory::Unsigned:
+ ApplyIntegerKind<DoPartialMaxOrMinLocHelper<TypeCategory::Unsigned, IS_MAX,
+ NumericCompare>::template Functor,
+ void>(catKind->second, terminator, intrinsic, result, x, kind, dim,
+ maskToUse, back, terminator);
+ break;
case TypeCategory::Real:
ApplyFloatingPointKind<DoPartialMaxOrMinLocHelper<TypeCategory::Real,
IS_MAX, NumericCompare>::template Functor,
@@ -497,6 +557,12 @@ inline RT_API_ATTRS void NumericMaxOrMin(Descriptor &result,
void>(
type->second, terminator, result, x, dim, mask, intrinsic, terminator);
break;
+ case TypeCategory::Unsigned:
+ ApplyIntegerKind<
+ MaxOrMinHelper<TypeCategory::Unsigned, IS_MAXVAL>::template Functor,
+ void>(
+ type->second, terminator, result, x, dim, mask, intrinsic, terminator);
+ break;
case TypeCategory::Real:
ApplyFloatingPointKind<
MaxOrMinHelper<TypeCategory::Real, IS_MAXVAL>::template Functor, void>(
@@ -603,6 +669,39 @@ CppTypeFor<TypeCategory::Integer, 16> RTDEF(MaxvalInteger16)(
}
#endif
+CppTypeFor<TypeCategory::Unsigned, 1> RTDEF(MaxvalUnsigned1)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 1, true>(
+ x, source, line, dim, mask, "MAXVAL");
+}
+CppTypeFor<TypeCategory::Unsigned, 2> RTDEF(MaxvalUnsigned2)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 2, true>(
+ x, source, line, dim, mask, "MAXVAL");
+}
+CppTypeFor<TypeCategory::Unsigned, 4> RTDEF(MaxvalUnsigned4)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 4, true>(
+ x, source, line, dim, mask, "MAXVAL");
+}
+CppTypeFor<TypeCategory::Unsigned, 8> RTDEF(MaxvalUnsigned8)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 8, true>(
+ x, source, line, dim, mask, "MAXVAL");
+}
+#ifdef __SIZEOF_INT128__
+CppTypeFor<TypeCategory::Unsigned, 16> RTDEF(MaxvalUnsigned16)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 16, true>(
+ x, source, line, dim, mask, "MAXVAL");
+}
+#endif
+
// TODO: REAL(2 & 3)
CppTypeFor<TypeCategory::Real, 4> RTDEF(MaxvalReal4)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
@@ -663,6 +762,39 @@ CppTypeFor<TypeCategory::Integer, 16> RTDEF(MinvalInteger16)(
}
#endif
+CppTypeFor<TypeCategory::Unsigned, 1> RTDEF(MinvalUnsigned1)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 1, false>(
+ x, source, line, dim, mask, "MINVAL");
+}
+CppTypeFor<TypeCategory::Unsigned, 2> RTDEF(MinvalUnsigned2)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 2, false>(
+ x, source, line, dim, mask, "MINVAL");
+}
+CppTypeFor<TypeCategory::Unsigned, 4> RTDEF(MinvalUnsigned4)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 4, false>(
+ x, source, line, dim, mask, "MINVAL");
+}
+CppTypeFor<TypeCategory::Unsigned, 8> RTDEF(MinvalUnsigned8)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 8, false>(
+ x, source, line, dim, mask, "MINVAL");
+}
+#ifdef __SIZEOF_INT128__
+CppTypeFor<TypeCategory::Unsigned, 16> RTDEF(MinvalUnsigned16)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 16, false>(
+ x, source, line, dim, mask, "MINVAL");
+}
+#endif
+
// TODO: REAL(2 & 3)
CppTypeFor<TypeCategory::Real, 4> RTDEF(MinvalReal4)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
diff --git a/flang/runtime/io-api-minimal.cpp b/flang/runtime/io-api-minimal.cpp
index ad76fe3de0324c..68768427be0c23 100644
--- a/flang/runtime/io-api-minimal.cpp
+++ b/flang/runtime/io-api-minimal.cpp
@@ -37,7 +37,7 @@ inline RT_API_ATTRS bool FormattedScalarIntegerOutput(
IoStatementState &io, INT x, const char *whence) {
if (io.CheckFormattedStmtType<Direction::Output>(whence)) {
auto edit{io.GetNextDataEdit()};
- return edit && EditIntegerOutput<KIND>(io, *edit, x);
+ return edit && EditIntegerOutput<KIND>(io, *edit, x, /*isSigned=*/true);
} else {
return false;
}
diff --git a/flang/runtime/numeric.cpp b/flang/runtime/numeric.cpp
index 4797ecf58fa711..45fb56348fd44f 100644
--- a/flang/runtime/numeric.cpp
+++ b/flang/runtime/numeric.cpp
@@ -94,7 +94,7 @@ template <typename T> inline RT_API_ATTRS T Scale(T x, std::int64_t p) {
return std::ldexp(x, ip); // x*2**p
}
-// SELECTED_INT_KIND (16.9.169)
+// SELECTED_INT_KIND (16.9.169) and SELECTED_UNSIGNED_KIND extension
template <typename X, typename M>
inline RT_API_ATTRS CppTypeFor<TypeCategory::Integer, 4> SelectedIntKind(
X x, M mask) {
@@ -781,7 +781,7 @@ CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedCharKind)(
return -1;
}
}
-// SELECTED_INT_KIND
+// SELECTED_INT_KIND and SELECTED_UNSIGNED_KIND extension
CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedIntKind)(
const char *source, int line, void *x, int xKind) {
return RTNAME(SelectedIntKindMasked)(source, line, x, xKind,
diff --git a/flang/runtime/reduce.cpp b/flang/runtime/reduce.cpp
index 8fc0bb8c7157e4..6c42c5ef50e4f0 100644
--- a/flang/runtime/reduce.cpp
+++ b/flang/runtime/reduce.cpp
@@ -322,6 +322,220 @@ void RTDEF(ReduceInteger16DimValue)(Descriptor &result, const Descriptor &array,
}
#endif
+std::uint8_t RTDEF(ReduceUnsigned1Ref)(const Descriptor &array,
+ ReferenceReductionOperation<std::uint8_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint8_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 1>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint8_t, false>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+std::uint8_t RTDEF(ReduceUnsigned1Value)(const Descriptor &array,
+ ValueReductionOperation<std::uint8_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint8_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 1>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint8_t, true>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+void RTDEF(ReduceUnsigned1DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint8_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint8_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint8_t, false>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 1>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+void RTDEF(ReduceUnsigned1DimValue)(Descriptor &result, const Descriptor &array,
+ ValueReductionOperation<std::uint8_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint8_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint8_t, true>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 1>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+std::uint16_t RTDEF(ReduceUnsigned2Ref)(const Descriptor &array,
+ ReferenceReductionOperation<std::uint16_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint16_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 2>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint16_t, false>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+std::uint16_t RTDEF(ReduceUnsigned2Value)(const Descriptor &array,
+ ValueReductionOperation<std::uint16_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint16_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 2>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint16_t, true>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+void RTDEF(ReduceUnsigned2DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint16_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint16_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint16_t, false>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 2>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+void RTDEF(ReduceUnsigned2DimValue)(Descriptor &result, const Descriptor &array,
+ ValueReductionOperation<std::uint16_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint16_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint16_t, true>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 2>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+std::uint32_t RTDEF(ReduceUnsigned4Ref)(const Descriptor &array,
+ ReferenceReductionOperation<std::uint32_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint32_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 4>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint32_t, false>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+std::uint32_t RTDEF(ReduceUnsigned4Value)(const Descriptor &array,
+ ValueReductionOperation<std::uint32_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint32_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 4>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint32_t, true>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+void RTDEF(ReduceUnsigned4DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint32_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint32_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint32_t, false>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 4>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+void RTDEF(ReduceUnsigned4DimValue)(Descriptor &result, const Descriptor &array,
+ ValueReductionOperation<std::uint32_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint32_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint32_t, true>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 4>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+std::uint64_t RTDEF(ReduceUnsigned8Ref)(const Descriptor &array,
+ ReferenceReductionOperation<std::uint64_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint64_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 8>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint64_t, false>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+std::uint64_t RTDEF(ReduceUnsigned8Value)(const Descriptor &array,
+ ValueReductionOperation<std::uint64_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint64_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 8>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint64_t, true>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+void RTDEF(ReduceUnsigned8DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint64_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint64_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint64_t, false>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 8>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+void RTDEF(ReduceUnsigned8DimValue)(Descriptor &result, const Descriptor &array,
+ ValueReductionOperation<std::uint64_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint64_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint64_t, true>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 8>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDEF(ReduceUnsigned16Ref)(const Descriptor &array,
+ ReferenceReductionOperation<common::uint128_t> operation,
+ const char *source, int line, int dim, const Descriptor *mask,
+ const common::uint128_t *identity, bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 16>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<common::uint128_t, false>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+common::uint128_t RTDEF(ReduceUnsigned16Value)(const Descriptor &array,
+ ValueReductionOperation<common::uint128_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask,
+ const common::uint128_t *identity, bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 16>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<common::uint128_t, true>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+void RTDEF(ReduceUnsigned16DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<common::uint128_t> operation,
+ const char *source, int line, int dim, const Descriptor *mask,
+ const common::uint128_t *identity, bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<common::uint128_t, false>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 16>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+void RTDEF(ReduceUnsigned16DimValue)(Descriptor &result,
+ const Descriptor &array,
+ ValueReductionOperation<common::uint128_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask,
+ const common::uint128_t *identity, bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<common::uint128_t, true>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 16>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+#endif
+
// TODO: real/complex(2 & 3)
float RTDEF(ReduceReal4Ref)(const Descriptor &array,
ReferenceReductionOperation<float> operation, const char *source, int line,
diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h
index dc12e5c4533e2e..66d1d9f44d7ae0 100644
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -303,7 +303,7 @@ inline RT_API_ATTRS RESULT ApplyIntegerKind(
return FUNC<16>{}(std::forward<A>(x)...);
#endif
default:
- terminator.Crash("not yet implemented: INTEGER(KIND=%d)", kind);
+ terminator.Crash("not yet implemented: INTEGER/UNSIGNED(KIND=%d)", kind);
}
}
diff --git a/flang/runtime/type-code.cpp b/flang/runtime/type-code.cpp
index cb1b944433aae5..d6948983bfe9f3 100644
--- a/flang/runtime/type-code.cpp
+++ b/flang/runtime/type-code.cpp
@@ -33,6 +33,25 @@ RT_API_ATTRS TypeCode::TypeCode(TypeCategory f, int kind) {
break;
}
break;
+ case TypeCategory::Unsigned:
+ switch (kind) {
+ case 1:
+ raw_ = CFI_type_uint8_t;
+ break;
+ case 2:
+ raw_ = CFI_type_uint16_t;
+ break;
+ case 4:
+ raw_ = CFI_type_uint32_t;
+ break;
+ case 8:
+ raw_ = CFI_type_uint64_t;
+ break;
+ case 16:
+ raw_ = CFI_type_uint128_t;
+ break;
+ }
+ break;
case TypeCategory::Real:
switch (kind) {
case 2:
@@ -203,6 +222,16 @@ TypeCode::GetCategoryAndKind() const {
return std::make_pair(TypeCategory::Character, 2);
case CFI_type_char32_t:
return std::make_pair(TypeCategory::Character, 4);
+ case CFI_type_uint8_t:
+ return std::make_pair(TypeCategory::Unsigned, 1);
+ case CFI_type_uint16_t:
+ return std::make_pair(TypeCategory::Unsigned, 2);
+ case CFI_type_uint32_t:
+ return std::make_pair(TypeCategory::Unsigned, 4);
+ case CFI_type_uint64_t:
+ return std::make_pair(TypeCategory::Unsigned, 8);
+ case CFI_type_uint128_t:
+ return std::make_pair(TypeCategory::Unsigned, 16);
default:
return Fortran::common::nullopt;
}
diff --git a/flang/runtime/type-info.cpp b/flang/runtime/type-info.cpp
index cb18c5669b5ffc..d4daa72aee6a13 100644
--- a/flang/runtime/type-info.cpp
+++ b/flang/runtime/type-info.cpp
@@ -36,6 +36,7 @@ RT_API_ATTRS std::size_t Component::GetElementByteSize(
const Descriptor &instance) const {
switch (category()) {
case TypeCategory::Integer:
+ case TypeCategory::Unsigned:
case TypeCategory::Real:
case TypeCategory::Logical:
return kind_;
diff --git a/flang/test/Lower/Unsigned/unsigned-ops.f90 b/flang/test/Lower/Unsigned/unsigned-ops.f90
new file mode 100644
index 00000000000000..f61f10656159ac
--- /dev/null
+++ b/flang/test/Lower/Unsigned/unsigned-ops.f90
@@ -0,0 +1,26 @@
+! RUN: %flang_fc1 -funsigned -emit-mlir %s -o - | FileCheck %s
+
+unsigned function f01(u, v)
+ unsigned, intent(in) :: u, v
+ f01 = u + v - 1u
+end
+
+!CHECK: func.func @_QPf01(%[[ARG0:.*]]: !fir.ref<ui32> {fir.bindc_name = "u"}, %[[ARG1:.*]]: !fir.ref<ui32> {fir.bindc_name = "v"}) -> ui32 {
+!CHECK: %[[C1_I32:.*]] = arith.constant 1 : i32
+!CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
+!CHECK: %[[VAL_1:.*]] = fir.alloca ui32 {bindc_name = "f01", uniq_name = "_QFf01Ef01"}
+!CHECK: %[[VAL_2:.*]] = fir.declare %[[VAL_1]] {uniq_name = "_QFf01Ef01"} : (!fir.ref<ui32>) -> !fir.ref<ui32>
+!CHECK: %[[VAL_3:.*]] = fir.declare %[[ARG0]] dummy_scope %[[VAL_0]] {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QFf01Eu"} : (!fir.ref<ui32>, !fir.dscope) -> !fir.ref<ui32>
+!CHECK: %[[VAL_4:.*]] = fir.declare %[[ARG1]] dummy_scope %[[VAL_0]] {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QFf01Ev"} : (!fir.ref<ui32>, !fir.dscope) -> !fir.ref<ui32>
+!CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_3]] : !fir.ref<ui32>
+!CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_4]] : !fir.ref<ui32>
+!CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_5]] : (ui32) -> i32
+!CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_6]] : (ui32) -> i32
+!CHECK: %[[VAL_9:.*]] = arith.addi %[[VAL_7]], %[[VAL_8]] : i32
+!CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> ui32
+!CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (ui32) -> i32
+!CHECK: %[[VAL_12:.*]] = arith.subi %[[VAL_11]], %[[C1_I32]] : i32
+!CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i32) -> ui32
+!CHECK: fir.store %[[VAL_13]] to %[[VAL_2]] : !fir.ref<ui32>
+!CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_2]] : !fir.ref<ui32>
+!CHECK: return %[[VAL_14]] : ui32
diff --git a/flang/test/Lower/allocatable-polymorphic.f90 b/flang/test/Lower/allocatable-polymorphic.f90
index e23e38ffb4b013..e8abf9fce8e35a 100644
--- a/flang/test/Lower/allocatable-polymorphic.f90
+++ b/flang/test/Lower/allocatable-polymorphic.f90
@@ -393,7 +393,7 @@ subroutine test_unlimited_polymorphic_with_intrinsic_type_spec()
! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[PTR_DECL]]#1 : (!fir.ref<!fir.class<!fir.ptr<none>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %[[CAT:.*]] = arith.constant 1 : i32
+! CHECK: %[[CAT:.*]] = arith.constant 2 : i32
! CHECK: %[[KIND:.*]] = arith.constant 4 : i32
! CHECK: %[[RANK:.*]] = arith.constant 0 : i32
! CHECK: %[[CORANK:.*]] = arith.constant 0 : i32
diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90
index 0d381f10b04831..454d73098408df 100644
--- a/flang/test/Semantics/typeinfo01.f90
+++ b/flang/test/Semantics/typeinfo01.f90
@@ -21,7 +21,7 @@ module m02
type, extends(parent) :: child
integer :: cn
end type
-!CHECK: .c.child, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:1_8 init:[component::component(name=.n.parent,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.parent,lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.cn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=4_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .c.child, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:1_8 init:[component::component(name=.n.parent,genre=1_1,category=6_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.parent,lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.cn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=4_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
!CHECK: .c.parent, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.pn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
!CHECK: .dt.child, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.child,sizeinbytes=8_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.child,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
!CHECK: .dt.parent, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.parent,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.parent,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
@@ -33,7 +33,7 @@ module m03
real(kind=k) :: a
end type
type(kpdt(4)) :: x
-!CHECK: .c.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.a,genre=1_1,category=1_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .c.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.a,genre=1_1,category=2_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
!CHECK: .dt.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.kpdt,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=.kp.kpdt.4,lenparameterkind=NULL(),component=.c.kpdt.4,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
!CHECK: .kp.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: INTEGER(8) shape: 0_8:0_8 init:[INTEGER(8)::4_8]
end module
@@ -83,7 +83,7 @@ subroutine s2(x, y)
class(t2), intent(out) :: x
class(t), intent(in) :: y
end subroutine
-!CHECK: .c.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.t,lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .c.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t,genre=1_1,category=6_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.t,lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=2_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1)]
@@ -230,7 +230,7 @@ module m11
real :: automatic(len)
end type
!CHECK: .b.t.automatic, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(value) shape: 0_8:1_8,0_8:0_8 init:reshape([value::value(genre=2_1,value=1_8),value(genre=3_1,value=0_8)],shape=[2,1])
-!CHECK: .c.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=.di.t.pointer),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.automatic,initialization=NULL())]
+!CHECK: .c.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=2_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=2_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=.di.t.pointer),component(name=.n.chauto,genre=4_1,category=4_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.automatic,genre=4_1,category=2_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.automatic,initialization=NULL())]
!CHECK: .di.t.pointer, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(.dp.t.pointer) init:.dp.t.pointer(pointer=target)
!CHECK: .dp.t.pointer (CompilerCreated): DerivedType components: pointer
!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=144_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.t,component=.c.t,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1)
diff --git a/flang/test/Semantics/typeinfo08.f90 b/flang/test/Semantics/typeinfo08.f90
index 7509070fa3eec5..689cf469dee3bd 100644
--- a/flang/test/Semantics/typeinfo08.f90
+++ b/flang/test/Semantics/typeinfo08.f90
@@ -12,7 +12,7 @@ module m
end module
!CHECK: Module scope: m size=0 alignment=1 sourceRange=113 bytes
-!CHECK: .c.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t1,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .c.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t1,genre=1_1,category=6_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
!CHECK: .dt.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.s,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.s,component=.c.s,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
!CHECK: .lpk.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::4_1]
!CHECK: .n.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: CHARACTER(1_8,1) init:"s"
diff --git a/flang/test/Semantics/unsigned-errors.f90 b/flang/test/Semantics/unsigned-errors.f90
new file mode 100644
index 00000000000000..fbe053727de123
--- /dev/null
+++ b/flang/test/Semantics/unsigned-errors.f90
@@ -0,0 +1,77 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -funsigned
+
+implicit unsigned(u)
+real a(10)
+
+!ERROR: Must have INTEGER type, but is UNSIGNED(4)
+real(kind=4u) x
+
+!ERROR: Both operands must be UNSIGNED
+print *, 0 + 1u
+!ERROR: Both operands must be UNSIGNED
+print *, 0u + 1
+!ERROR: Operands of + must be numeric; have UNSIGNED(4) and untyped
+print *, 0u + z'1'
+!ERROR: Operands of + must be numeric; have untyped and UNSIGNED(4)
+print *, z'0' + 1u
+
+print *, -0u ! ok
+print *, 0u + 1u ! ok
+print *, 0u - 1u ! ok
+print *, 0u * 1u ! ok
+print *, 0u / 1u ! ok
+!ERROR: Operands must not be UNSIGNED
+print *, 0u ** 1u
+
+print *, uint((0.,0.)) ! ok
+print *, uint(z'123') ! ok
+!ERROR: Actual argument for 'a=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'
+print *, uint("a")
+!ERROR: Actual argument for 'a=' has bad type 'LOGICAL(4)'
+print *, uint(.true.)
+!ERROR: Actual argument for 'l=' has bad type 'UNSIGNED(4)'
+print *, logical(0u)
+!ERROR: Actual argument for 'i=' has bad type 'UNSIGNED(4)'
+print *, char(0u)
+
+!ERROR: DO controls should be INTEGER
+!ERROR: DO controls should be INTEGER
+!ERROR: DO controls should be INTEGER
+do u = 0u, 1u
+end do
+!ERROR: DO controls should be INTEGER
+do u = 0, 1
+end do
+!ERROR: DO controls should be INTEGER
+!ERROR: DO controls should be INTEGER
+do j = 0u, 1u
+end do
+
+select case (u) ! ok
+case(0u) ! ok
+!ERROR: CASE value has type 'INTEGER(4)' which is not compatible with the SELECT CASE expression's type 'UNSIGNED(4)'
+case(1)
+end select
+
+select case (j)
+!ERROR: CASE value has type 'UNSIGNED(4)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
+case(0u)
+end select
+
+u = z'1' ! ok
+!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types UNSIGNED(4) and INTEGER(4)
+u = 1
+!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types INTEGER(4) and UNSIGNED(4)
+j = 1u
+
+!ERROR: Must have INTEGER type, but is UNSIGNED(4)
+write(6u,*) 'hi'
+
+!ERROR: ARITHMETIC IF expression must not be an UNSIGNED expression
+if (1u) 1,1,1
+1 continue
+
+!ERROR: Must have INTEGER type, but is UNSIGNED(4)
+print *, a(u)
+
+end
>From 59db30453dd6f3824b21283443645bbb72366432 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 23 Oct 2024 16:21:07 -0700
Subject: [PATCH 2/2] update docs
---
flang/docs/Unsigned.md | 9 ++++++++-
flang/docs/index.md | 1 +
2 files changed, 9 insertions(+), 1 deletion(-)
diff --git a/flang/docs/Unsigned.md b/flang/docs/Unsigned.md
index d9f8b78507dd3f..39f53691be8d38 100644
--- a/flang/docs/Unsigned.md
+++ b/flang/docs/Unsigned.md
@@ -22,7 +22,7 @@ language interoperability.
## `UNSIGNED` type
-`UNSIGNED` is a numeric with the same kinds as `INTEGER`.
+`UNSIGNED` is a numeric type with the same kinds as `INTEGER`.
It may appear as a type-spec in any context, including
a type declaration statement, a type-decl in an array
constructor or `ALLOCATE` statement, `IMPLICIT`, or a
@@ -82,6 +82,13 @@ All of the restructuring array transformational intrinsics: `CSHIFT`, `EOSHIFT`,
The location transformationals `FINDLOC`, `MAXLOC`, and `MINLOC`.
+There is a new `SELECTED_UNSIGNED_KIND` intrinsic function; it happens
+to work identically to the existing `SELECTED_INT_KIND`.
+
+Conversions to `UNSIGNED`, or between `UNSIGNED` kinds, can be done
+via the new `UINT` intrinsic. The `UNSIGNED` intrinsic name is also
+supported as an alias.
+
Support for `UNSIGNED` in the `OUT_OF_RANGE` predicate and `RANDOM_NUMBER`
remains to be implemented.
diff --git a/flang/docs/index.md b/flang/docs/index.md
index 70478fa0936d0b..c35f634746e68b 100644
--- a/flang/docs/index.md
+++ b/flang/docs/index.md
@@ -87,6 +87,7 @@ on how to get in touch with us and to learn more about the current status.
f2018-grammar.md
fstack-arrays
Real16MathSupport
+ Unsigned
```
# Indices and tables
More information about the cfe-commits
mailing list