[flang] Support lowering of IS_CONTIGUOUS

[peixin]

Summary

This supports the lowering of intrinsic IS_CONTIGUOUS for array argument.
The argument of assumed rank is not supported since it is not implemented
yet as the procedure argument. Add TODO for it.

[jeanPerier]

LGTM, thanks

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Optimizer/Builder/Runtime/Inquiry.h

 mlir::Value genSize(fir::FirOpBuilder &builder, mlir::Location loc,
                     mlir::Value array);
 
 /// Generate call to general `SizeDim` runtime routine.  This version is for
 /// when the user specifies a DIM argument.
 mlir::Value genSizeDim(fir::FirOpBuilder &builder, mlir::Location loc,
                        mlir::Value array, mlir::Value dim);
 
+/// Generate call to `Is_contiguous` runtime routine.
+mlir::Value genIsContiguous(fir::FirOpBuilder &builder, mlir::Location loc,
+                            mlir::Value array);
+
 } // namespace fir::runtime
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_INQUIRY_H

flang/lib/Lower/ConvertExpr.cpp

 #include "flang/Lower/Runtime.h"
 #include "flang/Lower/Support/Utils.h"
 #include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/Complex.h"
 #include "flang/Optimizer/Builder/Factory.h"
 #include "flang/Optimizer/Builder/Runtime/Assign.h"
 #include "flang/Optimizer/Builder/Runtime/Character.h"
 #include "flang/Optimizer/Builder/Runtime/Derived.h"
+#include "flang/Optimizer/Builder/Runtime/Inquiry.h"
 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/Ragged.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Dialect/FIRAttr.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Optimizer/Support/FatalError.h"
 #include "flang/Runtime/support.h"
ExtValue genCopyIn(const ExtValue &actualArg,
     mlir::Location loc = getLoc();
     bool isActualArgBox = fir::isa_box_type(fir::getBase(actualArg).getType());
     mlir::Value isContiguousResult;
     mlir::Type addrType = fir::HeapType::get(
         fir::unwrapPassByRefType(fir::getBase(actualArg).getType()));
 
     if (isActualArgBox) {
       // Check at runtime if the argument is contiguous so no copy is needed.
-      mlir::func::FuncOp isContiguousFct =
-          fir::runtime::getRuntimeFunc<mkRTKey(IsContiguous)>(loc, builder);
-      fir::CallOp isContiguous = builder.create<fir::CallOp>(
-          loc, isContiguousFct,
-          mlir::ValueRange{builder.createConvert(
-              loc, isContiguousFct.getFunctionType().getInput(0),
-              fir::getBase(actualArg))});
-      isContiguousResult = isContiguous.getResult(0);
+      isContiguousResult =
+          fir::runtime::genIsContiguous(builder, loc, fir::getBase(actualArg));
     }
 
     auto doCopyIn = [&]() -> ExtValue {
       ExtValue temp = genArrayTempFromMold(actualArg, tempName);
       if (!arg.mayBeReadByCall()) {
         return temp;
       }
       if (!isActualArgBox || inlineCopyInOutForBoxes) {

flang/lib/Lower/IntrinsicCall.cpp

struct IntrinsicLibrary {
   mlir::Value genIeeeIsFinite(mlir::Type, llvm::ArrayRef<mlir::Value>);
   template <mlir::arith::CmpIPredicate pred>
   fir::ExtendedValue genIeeeTypeCompare(mlir::Type,
                                         llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIeor(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genIndex(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIor(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genIparity(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genIsContiguous(mlir::Type,
+                                     llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIshft(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIshftc(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genLeadz(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   template <typename Shift>
&I::genIndex,
        {"kind", asValue}}}},
     {"ior", &I::genIor},
     {"iparity",
      &I::genIparity,
      {{{"array", asBox},
        {"dim", asValue},
        {"mask", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
+    {"is_contiguous",
+     &I::genIsContiguous,
+     {{{"array", asBox}}},
+     /*isElemental=*/false},
     {"ishft", &I::genIshft},
     {"ishftc", &I::genIshftc},
     {"lbound",
      &I::genLbound,
      {{{"array", asInquired}, {"dim", asValue}, {"kind", asValue}}},
      /*isElemental=*/false},
     {"leadz", &I::genLeadz},
     {"len",

 fir::ExtendedValue
 IntrinsicLibrary::genIparity(mlir::Type resultType,
                              llvm::ArrayRef<fir::ExtendedValue> args) {
   return genReduction(fir::runtime::genIParity, fir::runtime::genIParityDim,
                       resultType, builder, loc, stmtCtx,
                       "unexpected result for IPARITY", args);
 }
 
+// IS_CONTIGUOUS
+fir::ExtendedValue
+IntrinsicLibrary::genIsContiguous(mlir::Type resultType,
+                                  llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 1);
+  if (const auto *boxValue = args[0].getBoxOf<fir::BoxValue>())
+    if (boxValue->hasAssumedRank())
+      TODO(loc, "intrinsic: is_contiguous with assumed rank argument");
+
+  return builder.createConvert(
+      loc, resultType,
+      fir::runtime::genIsContiguous(builder, loc, fir::getBase(args[0])));
+}
+
 // ISHFT
 mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType,
                                        llvm::ArrayRef<mlir::Value> args) {
   // A conformant ISHFT(I,SHIFT) call satisfies:
   //     abs(SHIFT) <= BIT_SIZE(I)
   // Return:  abs(SHIFT) >= BIT_SIZE(I)
   //              ? 0
   //              : SHIFT < 0

flang/lib/Optimizer/Builder/Runtime/Inquiry.cpp

 //===-- Inquiry.h - generate inquiry runtime API calls ----------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/Builder/Runtime/Inquiry.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
 #include "flang/Runtime/inquiry.h"
+#include "flang/Runtime/support.h"
 
 using namespace Fortran::runtime;
 
 /// Generate call to `Lbound` runtime routine when the DIM argument is present.
 mlir::Value fir::runtime::genLboundDim(fir::FirOpBuilder &builder,
                                        mlir::Location loc, mlir::Value array,
                                        mlir::Value dim) {
   mlir::func::FuncOp lboundFunc =
mlir::Value fir::runtime::genSize(fir::FirOpBuilder &builder,
   auto fTy = sizeFunc.getFunctionType();
   auto sourceFile = fir::factory::locationToFilename(builder, loc);
   auto sourceLine =
       fir::factory::locationToLineNo(builder, loc, fTy.getInput(2));
   auto args = fir::runtime::createArguments(builder, loc, fTy, array,
                                             sourceFile, sourceLine);
   return builder.create<fir::CallOp>(loc, sizeFunc, args).getResult(0);
 }
+
+/// Generate call to `Is_contiguous` runtime routine.
+mlir::Value fir::runtime::genIsContiguous(fir::FirOpBuilder &builder,
+                                          mlir::Location loc,
+                                          mlir::Value array) {
+  mlir::func::FuncOp isContiguousFunc =
+      fir::runtime::getRuntimeFunc<mkRTKey(IsContiguous)>(loc, builder);
+  auto fTy = isContiguousFunc.getFunctionType();
+  auto args = fir::runtime::createArguments(builder, loc, fTy, array);
+  return builder.create<fir::CallOp>(loc, isContiguousFunc, args).getResult(0);
+}

flang/test/Lower/Intrinsics/is_contiguous.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPtest_is_contiguous(
+! CHECK-SAME:                                   %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "a"}) {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.logical<4> {adapt.valuebyref}
+! CHECK:         %[[VAL_2:.*]] = fir.alloca !fir.logical<4> {adapt.valuebyref}
+! CHECK:         %[[VAL_5:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "p", uniq_name = "_QFtest_is_contiguousEp"}
+! CHECK:         %[[VAL_42:.*]] = fir.convert %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
+! CHECK:         %[[VAL_43:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_42]]) {{.*}} : (!fir.box<none>) -> i1
+! CHECK:         %[[VAL_44:.*]] = fir.convert %[[VAL_43]] : (i1) -> !fir.logical<4>
+! CHECK:         fir.store %[[VAL_44]] to %[[VAL_2]] : !fir.ref<!fir.logical<4>>
+! CHECK:         fir.call @_QPfoo1(%[[VAL_2]]) {{.*}} : (!fir.ref<!fir.logical<4>>) -> ()
+! CHECK:         %[[VAL_45:.*]] = fir.load %[[VAL_5]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:         %[[VAL_46:.*]] = fir.convert %[[VAL_45]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
+! CHECK:         %[[VAL_47:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_46]]) {{.*}} : (!fir.box<none>) -> i1
+! CHECK:         %[[VAL_48:.*]] = fir.convert %[[VAL_47]] : (i1) -> !fir.logical<4>
+! CHECK:         fir.store %[[VAL_48]] to %[[VAL_1]] : !fir.ref<!fir.logical<4>>
+! CHECK:         fir.call @_QPfoo2(%[[VAL_1]]) {{.*}} : (!fir.ref<!fir.logical<4>>) -> ()
+! CHECK:         return
+! CHECK:       }
+
+subroutine test_is_contiguous(a)
+  real :: a(:)
+  real, pointer :: p(:)
+
+  call bar(p)
+
+  call foo1(is_contiguous(a))
+  call foo2(is_contiguous(p))
+end