[flang] Legacy extension intrinsic functions IMAG, IZEXT, JZEXT

[klausler]

Summary

Support these legacy extension intrinsic functions with unambiguous
semantics in those existing compilers that support them by means
of recognizing them as aliases for standard intrinsics (IMAG) or
with simple rewrites (IZEXT, JZEXT). Note that ZEXT has different
semantics in different existing compilers, so we will not support it
due to lack of a broad unambiguous precedent.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/docs/Extensions.md

* At runtime, `NAMELIST` input will skip over `NAMELIST` groups
   as if they were comment lines, even if not begun with `!`.
 * Commas are required in FORMAT statements and character variables
   only when they prevent ambiguity.
 * Legacy names `AND`, `OR`, and `XOR` are accepted as aliases for
   the standard intrinsic functions `IAND`, `IOR`, and `IEOR`
   respectively.
 * A digit count of d=0 is accepted in Ew.0, Dw.0, and Gw.0 output
   editing if no nonzero scale factor (kP) is in effect.
+* The name `IMAG` is accepted as an alias for the generic intrinsic
+  function `AIMAG`.
+* The legacy extension intrinsic functions `IZEXT` and `JZEXT`
+  are supported; `ZEXT` has different behavior with various older
+  compilers, so it is not supported.
 
 ### Extensions supported when enabled by options
 
 * C-style backslash escape sequences in quoted CHARACTER literals
   (but not Hollerith) [-fbackslash]
 * Logical abbreviations `.T.`, `.F.`, `.N.`, `.A.`, `.O.`, and `.X.`
   [-flogical-abbreviations]
 * `.XOR.` as a synonym for `.NEQV.` [-fxor-operator]

flang/lib/Evaluate/fold-integer.cpp

if (name == "abs") { // incl. babs, iiabs, jiaabs, & kiabs
     } else { // no SIZE=
       return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
           ScalarFunc<T, T, Int4>(
               [&](const Scalar<T> &i, const Scalar<Int4> &count) -> Scalar<T> {
                 auto countVal{static_cast<int>(count.ToInt64())};
                 return i.ISHFTC(countVal);
               }));
     }
+  } 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])}) {
       return common::visit(
           [&funcRef, &context, &name](const auto &n) -> Expr<T> {
             using TI = typename std::decay_t<decltype(n)>::Result;

flang/lib/Evaluate/intrinsics.cpp

static const IntrinsicInterface genericIntrinsicFunction[]{
         {{"i", SameInt}, {"shift", AnyInt},
             {"size", AnyInt, Rank::elemental, Optionality::optional}},
         SameInt},
     {"isnan", {{"a", AnyFloating}}, DefaultLogical},
     {"is_contiguous", {{"array", Addressable, Rank::anyOrAssumedRank}},
         DefaultLogical, Rank::elemental, IntrinsicClass::inquiryFunction},
     {"is_iostat_end", {{"i", AnyInt}}, DefaultLogical},
     {"is_iostat_eor", {{"i", AnyInt}}, DefaultLogical},
+    {"izext", {{"i", AnyInt}}, TypePattern{IntType, KindCode::exactKind, 2}},
+    {"jzext", {{"i", AnyInt}}, DefaultInt},
     {"kind", {{"x", AnyIntrinsic}}, DefaultInt, Rank::elemental,
         IntrinsicClass::inquiryFunction},
     {"lbound",
         {{"array", AnyData, Rank::anyOrAssumedRank}, RequiredDIM,
             SizeDefaultKIND},
         KINDInt, Rank::scalar, IntrinsicClass::inquiryFunction},
     {"lbound", {{"array", AnyData, Rank::anyOrAssumedRank}, SizeDefaultKIND},
         KINDInt, Rank::vector, IntrinsicClass::inquiryFunction},
static const IntrinsicInterface genericIntrinsicFunction[]{
     {"__builtin_ieee_support_underflow_control",
         {{"x", AnyReal, Rank::elemental, Optionality::optional}},
         DefaultLogical},
 };
 
 // TODO: Coarray intrinsic functions
 //   LCOBOUND, UCOBOUND, IMAGE_INDEX, COSHAPE
 // TODO: Non-standard intrinsic functions
-//  LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT,
+//  LSHIFT, RSHIFT, SHIFT,
 //  COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT,
 //  QCMPLX, QEXT, QFLOAT, QREAL, DNUM,
 //  INUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN,
 //  MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR
 //  IARG, IARGC, NARGS, NUMARG, BADDRESS, IADDR, CACHESIZE,
 //  EOF, FP_CLASS, INT_PTR_KIND, MALLOC
 //  probably more (these are PGI + Intel, possibly incomplete)
 // TODO: Optionally warn on use of non-standard intrinsics:
 //  LOC, probably others
 // TODO: Optionally warn on operand promotion extension
 
 // Aliases for a few generic intrinsic functions for legacy
 // compatibility and builtins.
 static const std::pair<const char *, const char *> genericAlias[]{
     {"and", "iand"},
+    {"imag", "aimag"},
     {"or", "ior"},
     {"xor", "ieor"},
     {"__builtin_ieee_selected_real_kind", "selected_real_kind"},
 };
 
 // The following table contains the intrinsic functions listed in
 // Tables 16.2 and 16.3 in Fortran 2018.  The "unrestricted" functions
 // in Table 16.2 can be used as actual arguments, PROCEDURE() interfaces,

flang/test/Evaluate/fold-jzext.f90

+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Tests folding of IZEXT() & JZEXT()
+module m
+  logical, parameter :: test_1 = kind(izext(-1_1)) == 2
+  logical, parameter :: test_2 = izext(-1_1) == 255_2
+  logical, parameter :: test_3 = kind(jzext(-1_1)) == 4
+  logical, parameter :: test_4 = jzext(-1_1) == 255_4
+  logical, parameter :: test_5 = kind(jzext(-1_2)) == 4
+  logical, parameter :: test_6 = jzext(-1_2) == 255_4
+end module