[flang] Add UNSIGNED (#113504)

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.

Author: klausler

clang/include/clang/Driver/Options.td

@@ -6913,6 +6913,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">;

clang/lib/Driver/ToolChains/Flang.cpp

@@ -122,7 +122,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)) {

flang/docs/Extensions.md

@@ -420,6 +420,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
 

flang/docs/Unsigned.md

@@ -0,0 +1,121 @@
+<!--===- 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 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
+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 `/`,
+components in complex constructors,
+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`.
+
+`RANDOM_NUMBER`.
+
+The intrinsic array functions:
+* `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`.
+
+There is a new `SELECTED_UNSIGNED_KIND` intrinsic function; it happens
+to work identically to the existing `SELECTED_INT_KIND`.
+
+Two new intrinsic functions `UMASKL` and `UMASKR` work just like
+`MASKL` and `MASKR`, returning unsigned results instead of integers.
+
+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 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.

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

flang/include/flang/Common/Fortran-consts.h

@@ -14,8 +14,10 @@
 
 namespace Fortran::common {
 
-// 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)
 
 ENUM_CLASS(IoStmtKind, None, Backspace, Close, Endfile, Flush, Inquire, Open,

flang/include/flang/Common/Fortran-features.h

@@ -54,7 +54,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     PolymorphicActualAllocatableOrPointerToMonomorphicDummy, RelaxedPureDummy,
     UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram, PrintCptr,
     SavedLocalInSpecExpr, PrintNamelist, AssumedRankPassedToNonAssumedRank,
-    IgnoreIrrelevantAttributes)
+    IgnoreIrrelevantAttributes, Unsigned)
 
 // Portability and suspicious usage warnings
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
@@ -73,7 +73,7 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
     PreviousScalarUse, RedeclaredInaccessibleComponent, ImplicitShared,
     IndexVarRedefinition, IncompatibleImplicitInterfaces, BadTypeForTarget,
     VectorSubscriptFinalization, UndefinedFunctionResult, UselessIomsg,
-    MismatchingDummyProcedure, SubscriptedEmptyArray)
+    MismatchingDummyProcedure, SubscriptedEmptyArray, UnsignedLiteralTruncation)
 
 using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
 using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;

flang/include/flang/Common/Fortran.h

@@ -23,7 +23,8 @@ namespace Fortran::common {
 class LanguageFeatureControl;
 
 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;
 }
 

flang/include/flang/Evaluate/complex.h

@@ -61,10 +61,11 @@ template <typename REAL_TYPE> class Complex {
 
   template <typename INT>
   static ValueWithRealFlags<Complex> FromInteger(const INT &n,
+      bool isUnsigned = false,
       Rounding rounding = TargetCharacteristics::defaultRounding) {
     ValueWithRealFlags<Complex> result;
-    result.value.re_ =
-        Part::FromInteger(n, rounding).AccumulateFlags(result.flags);
+    result.value.re_ = Part::FromInteger(n, isUnsigned, rounding)
+                           .AccumulateFlags(result.flags);
     return result;
   }
 

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>; \

flang/include/flang/Evaluate/fold.h

@@ -89,8 +89,19 @@ constexpr std::optional<std::int64_t> ToInt64(
     return std::nullopt;
   }
 }
+template <int KIND>
+constexpr std::optional<std::int64_t> ToInt64(
+    const Expr<Type<TypeCategory::Unsigned, KIND>> &expr) {
+  if (auto scalar{
+          GetScalarConstantValue<Type<TypeCategory::Unsigned, KIND>>(expr)}) {
+    return scalar->ToInt64();
+  } else {
+    return std::nullopt;
+  }
+}
 
 std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &);
+std::optional<std::int64_t> ToInt64(const Expr<SomeUnsigned> &);
 std::optional<std::int64_t> ToInt64(const Expr<SomeType> &);
 std::optional<std::int64_t> ToInt64(const ActualArgument &);
 

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) {

flang/include/flang/Evaluate/real.h

@@ -288,8 +288,9 @@ template <typename WORD, int PREC> class Real {
 
   template <typename INT>
   static ValueWithRealFlags<Real> FromInteger(const INT &n,
+      bool isUnsigned = false,
       Rounding rounding = TargetCharacteristics::defaultRounding) {
-    bool isNegative{n.IsNegative()};
+    bool isNegative{!isUnsigned && n.IsNegative()};
     INT absN{n};
     if (isNegative) {
       absN = n.Negate().value; // overflow is safe to ignore