[flang] Lower inquire statement

[clementval]

Summary

This patch adds the lowering of the inquire statement.

This patch is part of the upstreaming effort from fir-dev branch.

Depends on D120822

flang/include/flang/Lower/IO.h

 } // namespace mlir
 
 namespace Fortran {
 namespace parser {
 struct BackspaceStmt;
 struct CloseStmt;
 struct EndfileStmt;
 struct FlushStmt;
+struct InquireStmt;
 struct OpenStmt;
 struct ReadStmt;
 struct RewindStmt;
 struct PrintStmt;
 struct WaitStmt;
 struct WriteStmt;
 } // namespace parser
 

 
 /// Generate IO call(s) for ENDFILE; return the IOSTAT code
 mlir::Value genEndfileStatement(AbstractConverter &,
                                 const parser::EndfileStmt &);
 
 /// Generate IO call(s) for FLUSH; return the IOSTAT code
 mlir::Value genFlushStatement(AbstractConverter &, const parser::FlushStmt &);
 
+/// Generate IO call(s) for INQUIRE; return the IOSTAT code
+mlir::Value genInquireStatement(AbstractConverter &,
+                                const parser::InquireStmt &);
+
 /// Generate IO call(s) for READ; return the IOSTAT code
 mlir::Value genReadStatement(AbstractConverter &converter,
                              const parser::ReadStmt &stmt);
 
 /// Generate IO call(s) for OPEN; return the IOSTAT code
 mlir::Value genOpenStatement(AbstractConverter &, const parser::OpenStmt &);
 
 /// Generate IO call(s) for PRINT

flang/include/flang/Optimizer/Builder/Character.h

public:
   static bool hasConstantLengthInType(const fir::ExtendedValue &);
 
   /// Extract the kind of a character type
   static fir::KindTy getCharacterKind(mlir::Type type);
 
   /// Extract the kind of a character or array of character type.
   static fir::KindTy getCharacterOrSequenceKind(mlir::Type type);
 
+  /// Determine the inner character type. Unwraps references, boxes, and
+  /// sequences to find the !fir.char element type.
+  static fir::CharacterType getCharType(mlir::Type type);
+
   /// Determine the base character type
   static fir::CharacterType getCharacterType(mlir::Type type);
   static fir::CharacterType getCharacterType(const fir::CharBoxValue &box);
   static fir::CharacterType getCharacterType(mlir::Value str);
 
   /// Create an extended value from a value of type:
   /// - fir.boxchar<kind>
   /// - fir.ref<fir.char<kind,len>>

flang/lib/Lower/Bridge.cpp

private:
   }
 
   void genFIR(const Fortran::parser::FlushStmt &stmt) {
     mlir::Value iostat = genFlushStatement(*this, stmt);
     genIoConditionBranches(getEval(), stmt.v, iostat);
   }
 
   void genFIR(const Fortran::parser::InquireStmt &stmt) {
-    TODO(toLocation(), "InquireStmt lowering");
+    mlir::Value iostat = genInquireStatement(*this, stmt);
+    if (const auto *specs =
+            std::get_if<std::list<Fortran::parser::InquireSpec>>(&stmt.u))
+      genIoConditionBranches(getEval(), *specs, iostat);
   }
 
   void genFIR(const Fortran::parser::OpenStmt &stmt) {
     mlir::Value iostat = genOpenStatement(*this, stmt);
     genIoConditionBranches(getEval(), stmt.v, iostat);
   }
 
   void genFIR(const Fortran::parser::PrintStmt &stmt) {

flang/lib/Lower/ConvertExpr.cpp

CC genarr(const ExtValue &extMemref, ComponentPath &components) {
     mlir::Value slice;
     if (components.isSlice()) {
       TODO(loc, "genarr with Slices");
     }
     arrayOperands.push_back(ArrayOperand{memref, shape, slice});
     if (destShape.empty())
       destShape = getShape(arrayOperands.back());
     if (isBoxValue()) {
-      TODO(loc, "genarr BoxValue");
+      // Semantics are a reference to a boxed array.
+      // This case just requires that an embox operation be created to box the
+      // value. The value of the box is forwarded in the continuation.
+      mlir::Type reduceTy = reduceRank(arrTy, slice);
+      auto boxTy = fir::BoxType::get(reduceTy);
+      if (components.substring) {
+        // Adjust char length to substring size.
+        fir::CharacterType charTy =
+            fir::factory::CharacterExprHelper::getCharType(reduceTy);
+        auto seqTy = reduceTy.cast<fir::SequenceType>();
+        // TODO: Use a constant for fir.char LEN if we can compute it.
+        boxTy = fir::BoxType::get(
+            fir::SequenceType::get(fir::CharacterType::getUnknownLen(
+                                       builder.getContext(), charTy.getFKind()),
+                                   seqTy.getDimension()));
+      }
+      mlir::Value embox =
+          memref.getType().isa<fir::BoxType>()
+              ? builder.create<fir::ReboxOp>(loc, boxTy, memref, shape, slice)
+                    .getResult()
+              : builder
+                    .create<fir::EmboxOp>(loc, boxTy, memref, shape, slice,
+                                          fir::getTypeParams(extMemref))
+                    .getResult();
+      return [=](IterSpace) -> ExtValue { return fir::BoxValue(embox); };
     }
     if (isReferentiallyOpaque()) {
       TODO(loc, "genarr isReferentiallyOpaque");
     }
     auto arrLoad = builder.create<fir::ArrayLoadOp>(
         loc, arrTy, memref, shape, slice, fir::getTypeParams(extMemref));
     mlir::Value arrLd = arrLoad.getResult();
     if (isProjectedCopyInCopyOut()) {

flang/lib/Lower/IO.cpp

Fortran::lower::genWriteStatement(Fortran::lower::AbstractConverter &converter,
   return genDataTransferStmt</*isInput=*/false>(converter, stmt);
 }
 
 mlir::Value
 Fortran::lower::genReadStatement(Fortran::lower::AbstractConverter &converter,
                                  const Fortran::parser::ReadStmt &stmt) {
   return genDataTransferStmt</*isInput=*/true>(converter, stmt);
 }
+
+/// Get the file expression from the inquire spec list. Also return if the
+/// expression is a file name.
+static std::pair<const Fortran::lower::SomeExpr *, bool>
+getInquireFileExpr(const std::list<Fortran::parser::InquireSpec> *stmt) {
+  if (!stmt)
+    return {nullptr, /*filename?=*/false};
+  for (const Fortran::parser::InquireSpec &spec : *stmt) {
+    if (auto *f = std::get_if<Fortran::parser::FileUnitNumber>(&spec.u))
+      return {Fortran::semantics::GetExpr(*f), /*filename?=*/false};
+    if (auto *f = std::get_if<Fortran::parser::FileNameExpr>(&spec.u))
+      return {Fortran::semantics::GetExpr(*f), /*filename?=*/true};
+  }
+  // semantics should have already caught this condition
+  llvm::report_fatal_error("inquire spec must have a file");
+}
+
+/// Generate calls to the four distinct INQUIRE subhandlers. An INQUIRE may
+/// return values of type CHARACTER, INTEGER, or LOGICAL. There is one
+/// additional special case for INQUIRE with both PENDING and ID specifiers.
+template <typename A>
+static mlir::Value genInquireSpec(Fortran::lower::AbstractConverter &converter,
+                                  mlir::Location loc, mlir::Value cookie,
+                                  mlir::Value idExpr, const A &var,
+                                  Fortran::lower::StatementContext &stmtCtx) {
+  // default case: do nothing
+  return {};
+}
+/// Specialization for CHARACTER.
+template <>
+mlir::Value genInquireSpec<Fortran::parser::InquireSpec::CharVar>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Value cookie, mlir::Value idExpr,
+    const Fortran::parser::InquireSpec::CharVar &var,
+    Fortran::lower::StatementContext &stmtCtx) {
+  // IOMSG is handled with exception conditions
+  if (std::get<Fortran::parser::InquireSpec::CharVar::Kind>(var.t) ==
+      Fortran::parser::InquireSpec::CharVar::Kind::Iomsg)
+    return {};
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::FuncOp specFunc =
+      getIORuntimeFunc<mkIOKey(InquireCharacter)>(loc, builder);
+  mlir::FunctionType specFuncTy = specFunc.getType();
+  const auto *varExpr = Fortran::semantics::GetExpr(
+      std::get<Fortran::parser::ScalarDefaultCharVariable>(var.t));
+  fir::ExtendedValue str = converter.genExprAddr(varExpr, stmtCtx, loc);
+  llvm::SmallVector<mlir::Value> args = {
+      builder.createConvert(loc, specFuncTy.getInput(0), cookie),
+      builder.createIntegerConstant(
+          loc, specFuncTy.getInput(1),
+          Fortran::runtime::io::HashInquiryKeyword(
+              Fortran::parser::InquireSpec::CharVar::EnumToString(
+                  std::get<Fortran::parser::InquireSpec::CharVar::Kind>(var.t))
+                  .c_str())),
+      builder.createConvert(loc, specFuncTy.getInput(2), fir::getBase(str)),
+      builder.createConvert(loc, specFuncTy.getInput(3), fir::getLen(str))};
+  return builder.create<fir::CallOp>(loc, specFunc, args).getResult(0);
+}
+/// Specialization for INTEGER.
+template <>
+mlir::Value genInquireSpec<Fortran::parser::InquireSpec::IntVar>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Value cookie, mlir::Value idExpr,
+    const Fortran::parser::InquireSpec::IntVar &var,
+    Fortran::lower::StatementContext &stmtCtx) {
+  // IOSTAT is handled with exception conditions
+  if (std::get<Fortran::parser::InquireSpec::IntVar::Kind>(var.t) ==
+      Fortran::parser::InquireSpec::IntVar::Kind::Iostat)
+    return {};
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::FuncOp specFunc =
+      getIORuntimeFunc<mkIOKey(InquireInteger64)>(loc, builder);
+  mlir::FunctionType specFuncTy = specFunc.getType();
+  const auto *varExpr = Fortran::semantics::GetExpr(
+      std::get<Fortran::parser::ScalarIntVariable>(var.t));
+  mlir::Value addr = fir::getBase(converter.genExprAddr(varExpr, stmtCtx, loc));
+  mlir::Type eleTy = fir::dyn_cast_ptrEleTy(addr.getType());
+  if (!eleTy)
+    fir::emitFatalError(loc,
+                        "internal error: expected a memory reference type");
+  auto bitWidth = eleTy.cast<mlir::IntegerType>().getWidth();
+  mlir::IndexType idxTy = builder.getIndexType();
+  mlir::Value kind = builder.createIntegerConstant(loc, idxTy, bitWidth / 8);
+  llvm::SmallVector<mlir::Value> args = {
+      builder.createConvert(loc, specFuncTy.getInput(0), cookie),
+      builder.createIntegerConstant(
+          loc, specFuncTy.getInput(1),
+          Fortran::runtime::io::HashInquiryKeyword(
+              Fortran::parser::InquireSpec::IntVar::EnumToString(
+                  std::get<Fortran::parser::InquireSpec::IntVar::Kind>(var.t))
+                  .c_str())),
+      builder.createConvert(loc, specFuncTy.getInput(2), addr),
+      builder.createConvert(loc, specFuncTy.getInput(3), kind)};
+  return builder.create<fir::CallOp>(loc, specFunc, args).getResult(0);
+}
+/// Specialization for LOGICAL and (PENDING + ID).
+template <>
+mlir::Value genInquireSpec<Fortran::parser::InquireSpec::LogVar>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Value cookie, mlir::Value idExpr,
+    const Fortran::parser::InquireSpec::LogVar &var,
+    Fortran::lower::StatementContext &stmtCtx) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  auto logVarKind = std::get<Fortran::parser::InquireSpec::LogVar::Kind>(var.t);
+  bool pendId =
+      idExpr &&
+      logVarKind == Fortran::parser::InquireSpec::LogVar::Kind::Pending;
+  mlir::FuncOp specFunc =
+      pendId ? getIORuntimeFunc<mkIOKey(InquirePendingId)>(loc, builder)
+             : getIORuntimeFunc<mkIOKey(InquireLogical)>(loc, builder);
+  mlir::FunctionType specFuncTy = specFunc.getType();
+  mlir::Value addr = fir::getBase(converter.genExprAddr(
+      Fortran::semantics::GetExpr(
+          std::get<Fortran::parser::Scalar<
+              Fortran::parser::Logical<Fortran::parser::Variable>>>(var.t)),
+      stmtCtx, loc));
+  llvm::SmallVector<mlir::Value> args = {
+      builder.createConvert(loc, specFuncTy.getInput(0), cookie)};
+  if (pendId)
+    args.push_back(builder.createConvert(loc, specFuncTy.getInput(1), idExpr));
+  else
+    args.push_back(builder.createIntegerConstant(
+        loc, specFuncTy.getInput(1),
+        Fortran::runtime::io::HashInquiryKeyword(
+            Fortran::parser::InquireSpec::LogVar::EnumToString(logVarKind)
+                .c_str())));
+  args.push_back(builder.createConvert(loc, specFuncTy.getInput(2), addr));
+  return builder.create<fir::CallOp>(loc, specFunc, args).getResult(0);
+}
+
+/// If there is an IdExpr in the list of inquire-specs, then lower it and return
+/// the resulting Value. Otherwise, return null.
+static mlir::Value
+lowerIdExpr(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+            const std::list<Fortran::parser::InquireSpec> &ispecs,
+            Fortran::lower::StatementContext &stmtCtx) {
+  for (const Fortran::parser::InquireSpec &spec : ispecs)
+    if (mlir::Value v = std::visit(
+            Fortran::common::visitors{
+                [&](const Fortran::parser::IdExpr &idExpr) {
+                  return fir::getBase(converter.genExprValue(
+                      Fortran::semantics::GetExpr(idExpr), stmtCtx, loc));
+                },
+                [](const auto &) { return mlir::Value{}; }},
+            spec.u))
+      return v;
+  return {};
+}
+
+/// For each inquire-spec, build the appropriate call, threading the cookie.
+static void threadInquire(Fortran::lower::AbstractConverter &converter,
+                          mlir::Location loc, mlir::Value cookie,
+                          const std::list<Fortran::parser::InquireSpec> &ispecs,
+                          bool checkResult, mlir::Value &ok,
+                          Fortran::lower::StatementContext &stmtCtx) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::Value idExpr = lowerIdExpr(converter, loc, ispecs, stmtCtx);
+  for (const Fortran::parser::InquireSpec &spec : ispecs) {
+    makeNextConditionalOn(builder, loc, checkResult, ok);
+    ok = std::visit(Fortran::common::visitors{[&](const auto &x) {
+                      return genInquireSpec(converter, loc, cookie, idExpr, x,
+                                            stmtCtx);
+                    }},
+                    spec.u);
+  }
+}
+
+mlir::Value Fortran::lower::genInquireStatement(
+    Fortran::lower::AbstractConverter &converter,
+    const Fortran::parser::InquireStmt &stmt) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  Fortran::lower::StatementContext stmtCtx;
+  mlir::Location loc = converter.getCurrentLocation();
+  mlir::FuncOp beginFunc;
+  ConditionSpecInfo csi;
+  llvm::SmallVector<mlir::Value> beginArgs;
+  const auto *list =
+      std::get_if<std::list<Fortran::parser::InquireSpec>>(&stmt.u);
+  auto exprPair = getInquireFileExpr(list);
+  auto inquireFileUnit = [&]() -> bool {
+    return exprPair.first && !exprPair.second;
+  };
+  auto inquireFileName = [&]() -> bool {
+    return exprPair.first && exprPair.second;
+  };
+
+  // Make one of three BeginInquire calls.
+  if (inquireFileUnit()) {
+    // Inquire by unit -- [UNIT=]file-unit-number.
+    beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireUnit)>(loc, builder);
+    mlir::FunctionType beginFuncTy = beginFunc.getType();
+    beginArgs = {builder.createConvert(loc, beginFuncTy.getInput(0),
+                                       fir::getBase(converter.genExprValue(
+                                           exprPair.first, stmtCtx, loc))),
+                 locToFilename(converter, loc, beginFuncTy.getInput(1)),
+                 locToLineNo(converter, loc, beginFuncTy.getInput(2))};
+  } else if (inquireFileName()) {
+    // Inquire by file -- FILE=file-name-expr.
+    beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireFile)>(loc, builder);
+    mlir::FunctionType beginFuncTy = beginFunc.getType();
+    fir::ExtendedValue file =
+        converter.genExprAddr(exprPair.first, stmtCtx, loc);
+    beginArgs = {
+        builder.createConvert(loc, beginFuncTy.getInput(0), fir::getBase(file)),
+        builder.createConvert(loc, beginFuncTy.getInput(1), fir::getLen(file)),
+        locToFilename(converter, loc, beginFuncTy.getInput(2)),
+        locToLineNo(converter, loc, beginFuncTy.getInput(3))};
+  } else {
+    // Inquire by output list -- IOLENGTH=scalar-int-variable.
+    const auto *ioLength =
+        std::get_if<Fortran::parser::InquireStmt::Iolength>(&stmt.u);
+    assert(ioLength && "must have an IOLENGTH specifier");
+    beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireIoLength)>(loc, builder);
+    mlir::FunctionType beginFuncTy = beginFunc.getType();
+    beginArgs = {locToFilename(converter, loc, beginFuncTy.getInput(0)),
+                 locToLineNo(converter, loc, beginFuncTy.getInput(1))};
+    auto cookie =
+        builder.create<fir::CallOp>(loc, beginFunc, beginArgs).getResult(0);
+    mlir::Value ok;
+    genOutputItemList(
+        converter, cookie,
+        std::get<std::list<Fortran::parser::OutputItem>>(ioLength->t),
+        /*isFormatted=*/false, /*checkResult=*/false, ok, /*inLoop=*/false,
+        stmtCtx);
+    auto *ioLengthVar = Fortran::semantics::GetExpr(
+        std::get<Fortran::parser::ScalarIntVariable>(ioLength->t));
+    mlir::Value ioLengthVarAddr =
+        fir::getBase(converter.genExprAddr(ioLengthVar, stmtCtx, loc));
+    llvm::SmallVector<mlir::Value> args = {cookie};
+    mlir::Value length =
+        builder
+            .create<fir::CallOp>(
+                loc, getIORuntimeFunc<mkIOKey(GetIoLength)>(loc, builder), args)
+            .getResult(0);
+    mlir::Value length1 =
+        builder.createConvert(loc, converter.genType(*ioLengthVar), length);
+    builder.create<fir::StoreOp>(loc, length1, ioLengthVarAddr);
+    return genEndIO(converter, loc, cookie, csi, stmtCtx);
+  }
+
+  // Common handling for inquire by unit or file.
+  assert(list && "inquire-spec list must be present");
+  auto cookie =
+      builder.create<fir::CallOp>(loc, beginFunc, beginArgs).getResult(0);
+  genConditionHandlerCall(converter, loc, cookie, *list, csi);
+  // Handle remaining arguments in specifier list.
+  mlir::Value ok;
+  auto insertPt = builder.saveInsertionPoint();
+  threadInquire(converter, loc, cookie, *list, csi.hasErrorConditionSpec(), ok,
+                stmtCtx);
+  builder.restoreInsertionPoint(insertPt);
+  // Generate end statement call.
+  return genEndIO(converter, loc, cookie, csi, stmtCtx);
+}

flang/lib/Optimizer/Builder/Character.cpp

 
 /// Get fir.char<kind> type with the same kind as inside str.
 fir::CharacterType
 fir::factory::CharacterExprHelper::getCharacterType(mlir::Type type) {
   assert(isCharacterScalar(type) && "expected scalar character");
   return recoverCharacterType(type);
 }
 
+fir::CharacterType
+fir::factory::CharacterExprHelper::getCharType(mlir::Type type) {
+  return recoverCharacterType(type);
+}
+
 fir::CharacterType fir::factory::CharacterExprHelper::getCharacterType(
     const fir::CharBoxValue &box) {
   return getCharacterType(box.getBuffer().getType());
 }
 
 fir::CharacterType
 fir::factory::CharacterExprHelper::getCharacterType(mlir::Value str) {
   return getCharacterType(str.getType());

flang/test/Lower/io-statement-1.f90

real :: a(100)
   ! CHECK: call {{.*}}BeginClose
   ! CHECK: call {{.*}}EndIoStatement
   close(8)
 
   ! CHECK: call {{.*}}BeginExternalListOutput
   ! CHECK: call {{.*}}OutputAscii
   ! CHECK: call {{.*}}EndIoStatement
   print *, "A literal string"
+
+  ! CHECK: call {{.*}}BeginInquireUnit
+  ! CHECK: call {{.*}}EndIoStatement
+  inquire(4, EXIST=existsvar)
+
+  ! CHECK: call {{.*}}BeginInquireFile
+  ! CHECK: call {{.*}}EndIoStatement
+  inquire(FILE="fail.f90", EXIST=existsvar)
+
+  ! CHECK: call {{.*}}BeginInquireIoLength
+  ! CHECK-COUNT-3: call {{.*}}OutputDescriptor
+  ! CHECK: call {{.*}}EndIoStatement
+  inquire (iolength=length) existsvar, length, a
 end
 
+! Tests the 3 basic inquire formats
+! CHECK-LABEL: func @_QPinquire_test
+subroutine inquire_test(ch, i, b)
+  character(80) :: ch
+  integer :: i
+  logical :: b
+
+  ! CHARACTER
+  ! CHECK: %[[sugar:.*]] = fir.call {{.*}}BeginInquireUnit
+  ! CHECK: call {{.*}}InquireCharacter(%[[sugar]], %c{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64) -> i1
+  ! CHECK: call {{.*}}EndIoStatement
+  inquire(88, name=ch)
+
+  ! INTEGER
+  ! CHECK: %[[oatmeal:.*]] = fir.call {{.*}}BeginInquireUnit
+  ! CHECK: call @_FortranAioInquireInteger64(%[[oatmeal]], %c{{.*}}, %{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64, !fir.ref<i64>, i32) -> i1
+  ! CHECK: call {{.*}}EndIoStatement
+  inquire(89, pos=i)
+
+  ! LOGICAL
+  ! CHECK: %[[snicker:.*]] = fir.call {{.*}}BeginInquireUnit
+  ! CHECK: call @_FortranAioInquireLogical(%[[snicker]], %c{{.*}}, %[[b:.*]]) : (!fir.ref<i8>, i64, !fir.ref<i1>) -> i1
+  ! CHECK: call {{.*}}EndIoStatement
+  inquire(90, opened=b)
+end subroutine inquire_test
+
 ! CHECK-LABEL: @_QPboz
 subroutine boz
   ! CHECK: fir.call @_FortranAioOutputInteger8(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i8) -> i1
   ! CHECK: fir.call @_FortranAioOutputInteger16(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i16) -> i1
   ! CHECK: fir.call @_FortranAioOutputInteger32(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i32) -> i1
   ! CHECK: fir.call @_FortranAioOutputInteger64(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64) -> i1
   ! CHECK: fir.call @_FortranAioOutputInteger128(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i128) -> i1
   print '(*(Z3))', 96_1, 96_2, 96_4, 96_8, 96_16