lib/Lower/IO.cpp

//===-- IO.cpp -- IO statement lowering -----------------------------------===//
//
// 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
//
//===----------------------------------------------------------------------===//
//
// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
//
//===----------------------------------------------------------------------===//

#include "flang/Lower/IO.h"
#include "flang/Common/uint128.h"
#include "flang/Lower/Allocatable.h"
#include "flang/Lower/Bridge.h"
#include "flang/Lower/ConvertExpr.h"
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/PFTBuilder.h"
#include "flang/Lower/Runtime.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/Support/Utils.h"
#include "flang/Lower/Todo.h"
#include "flang/Lower/VectorSubscripts.h"
#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/Complex.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
#include "flang/Optimizer/Support/FIRContext.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Runtime/io-api.h"
#include "flang/Semantics/tools.h"
#include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h"

#define DEBUG_TYPE "flang-lower-io"

// Define additional runtime type models specific to IO.
namespace fir::runtime {
template <>
constexpr TypeBuilderFunc getModel<Fortran::runtime::io::IoStatementState *>() {
  return getModel<char *>();
}
template <>
constexpr TypeBuilderFunc
getModel<const Fortran::runtime::io::NamelistGroup &>() {
  return [](mlir::MLIRContext *context) -> mlir::Type {
    return fir::ReferenceType::get(mlir::TupleType::get(context));
  };
}
template <>
constexpr TypeBuilderFunc getModel<Fortran::runtime::io::Iostat>() {
  return [](mlir::MLIRContext *context) -> mlir::Type {
    return mlir::IntegerType::get(context,
                                  8 * sizeof(Fortran::runtime::io::Iostat));
  };
}
} // namespace fir::runtime

using namespace Fortran::runtime::io;

#define mkIOKey(X) FirmkKey(IONAME(X))

namespace Fortran::lower {
/// Static table of IO runtime calls
///
/// This logical map contains the name and type builder function for each IO
/// runtime function listed in the tuple. This table is fully constructed at
/// compile-time. Use the `mkIOKey` macro to access the table.
static constexpr std::tuple<
    mkIOKey(BeginInternalArrayListOutput), mkIOKey(BeginInternalArrayListInput),
    mkIOKey(BeginInternalArrayFormattedOutput),
    mkIOKey(BeginInternalArrayFormattedInput), mkIOKey(BeginInternalListOutput),
    mkIOKey(BeginInternalListInput), mkIOKey(BeginInternalFormattedOutput),
    mkIOKey(BeginInternalFormattedInput), mkIOKey(BeginExternalListOutput),
    mkIOKey(BeginExternalListInput), mkIOKey(BeginExternalFormattedOutput),
    mkIOKey(BeginExternalFormattedInput), mkIOKey(BeginUnformattedOutput),
    mkIOKey(BeginUnformattedInput), mkIOKey(BeginAsynchronousOutput),
    mkIOKey(BeginAsynchronousInput), mkIOKey(BeginWait), mkIOKey(BeginWaitAll),
    mkIOKey(BeginClose), mkIOKey(BeginFlush), mkIOKey(BeginBackspace),
    mkIOKey(BeginEndfile), mkIOKey(BeginRewind), mkIOKey(BeginOpenUnit),
    mkIOKey(BeginOpenNewUnit), mkIOKey(BeginInquireUnit),
    mkIOKey(BeginInquireFile), mkIOKey(BeginInquireIoLength),
    mkIOKey(EnableHandlers), mkIOKey(SetAdvance), mkIOKey(SetBlank),
    mkIOKey(SetDecimal), mkIOKey(SetDelim), mkIOKey(SetPad), mkIOKey(SetPos),
    mkIOKey(SetRec), mkIOKey(SetRound), mkIOKey(SetSign),
    mkIOKey(OutputNamelist), mkIOKey(InputNamelist), mkIOKey(OutputDescriptor),
    mkIOKey(InputDescriptor), mkIOKey(OutputUnformattedBlock),
    mkIOKey(InputUnformattedBlock), mkIOKey(OutputInteger8),
    mkIOKey(OutputInteger16), mkIOKey(OutputInteger32),
    mkIOKey(OutputInteger64),
#ifdef __SIZEOF_INT128__
    mkIOKey(OutputInteger128),
#endif
    mkIOKey(InputInteger),
    mkIOKey(OutputReal32), mkIOKey(InputReal32), mkIOKey(OutputReal64),
    mkIOKey(InputReal64), mkIOKey(OutputComplex32), mkIOKey(InputComplex32),
    mkIOKey(OutputComplex64), mkIOKey(InputComplex64), mkIOKey(OutputAscii),
    mkIOKey(InputAscii), mkIOKey(OutputLogical), mkIOKey(InputLogical),
    mkIOKey(SetAccess), mkIOKey(SetAction), mkIOKey(SetAsynchronous),
    mkIOKey(SetCarriagecontrol), mkIOKey(SetEncoding), mkIOKey(SetForm),
    mkIOKey(SetPosition), mkIOKey(SetRecl), mkIOKey(SetStatus),
    mkIOKey(SetFile), mkIOKey(GetNewUnit), mkIOKey(GetSize),
    mkIOKey(GetIoLength), mkIOKey(GetIoMsg), mkIOKey(InquireCharacter),
    mkIOKey(InquireLogical), mkIOKey(InquirePendingId),
    mkIOKey(InquireInteger64), mkIOKey(EndIoStatement)>
    newIOTable;
} // namespace Fortran::lower

namespace {
/// IO statements may require exceptional condition handling.  A statement that
/// encounters an exceptional condition may branch to a label given on an ERR
/// (error), END (end-of-file), or EOR (end-of-record) specifier.  An IOSTAT
/// specifier variable may be set to a value that indicates some condition,
/// and an IOMSG specifier variable may be set to a description of a condition.
struct ConditionSpecInfo {
  const Fortran::lower::SomeExpr *ioStatExpr{};
  const Fortran::lower::SomeExpr *ioMsgExpr{};
  bool hasErr{};
  bool hasEnd{};
  bool hasEor{};

  /// Check for any condition specifier that applies to specifier processing.
  bool hasErrorConditionSpec() const { return ioStatExpr != nullptr || hasErr; }

  /// Check for any condition specifier that applies to data transfer items
  /// in a PRINT, READ, WRITE, or WAIT statement.  (WAIT may be irrelevant.)
  bool hasTransferConditionSpec() const {
    return hasErrorConditionSpec() || hasEnd || hasEor;
  }

  /// Check for any condition specifier, including IOMSG.
  bool hasAnyConditionSpec() const {
    return hasTransferConditionSpec() || ioMsgExpr != nullptr;
  }
};
} // namespace

template <typename D>
static void genIoLoop(Fortran::lower::AbstractConverter &converter,
                      mlir::Value cookie, const D &ioImpliedDo,
                      bool isFormatted, bool checkResult, mlir::Value &ok,
                      bool inLoop, Fortran::lower::StatementContext &stmtCtx);

/// Helper function to retrieve the name of the IO function given the key `A`
template <typename A>
static constexpr const char *getName() {
  return std::get<A>(Fortran::lower::newIOTable).name;
}

/// Helper function to retrieve the type model signature builder of the IO
/// function as defined by the key `A`
template <typename A>
static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
  return std::get<A>(Fortran::lower::newIOTable).getTypeModel();
}

inline int64_t getLength(mlir::Type argTy) {
  return argTy.cast<fir::SequenceType>().getShape()[0];
}

/// Get (or generate) the MLIR FuncOp for a given IO runtime function.
template <typename E>
static mlir::FuncOp getIORuntimeFunc(mlir::Location loc,
                                     fir::FirOpBuilder &builder) {
  llvm::StringRef name = getName<E>();
  mlir::FuncOp func = builder.getNamedFunction(name);
  if (func)
    return func;
  auto funTy = getTypeModel<E>()(builder.getContext());
  func = builder.createFunction(loc, name, funTy);
  func->setAttr("fir.runtime", builder.getUnitAttr());
  func->setAttr("fir.io", builder.getUnitAttr());
  return func;
}

/// Generate calls to end an IO statement.  Return the IOSTAT value, if any.
/// It is the caller's responsibility to generate branches on that value.
static mlir::Value genEndIO(Fortran::lower::AbstractConverter &converter,
                            mlir::Location loc, mlir::Value cookie,
                            const ConditionSpecInfo &csi,
                            Fortran::lower::StatementContext &stmtCtx) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  if (csi.ioMsgExpr) {
    mlir::FuncOp getIoMsg = getIORuntimeFunc<mkIOKey(GetIoMsg)>(loc, builder);
    fir::ExtendedValue ioMsgVar =
        converter.genExprAddr(csi.ioMsgExpr, stmtCtx, loc);
    builder.create<fir::CallOp>(
        loc, getIoMsg,
        mlir::ValueRange{
            cookie,
            builder.createConvert(loc, getIoMsg.getType().getInput(1),
                                  fir::getBase(ioMsgVar)),
            builder.createConvert(loc, getIoMsg.getType().getInput(2),
                                  fir::getLen(ioMsgVar))});
  }
  mlir::FuncOp endIoStatement =
      getIORuntimeFunc<mkIOKey(EndIoStatement)>(loc, builder);
  auto call = builder.create<fir::CallOp>(loc, endIoStatement,
                                          mlir::ValueRange{cookie});
  if (csi.ioStatExpr) {
    mlir::Value ioStatVar =
        fir::getBase(converter.genExprAddr(csi.ioStatExpr, stmtCtx, loc));
    mlir::Value ioStatResult = builder.createConvert(
        loc, converter.genType(*csi.ioStatExpr), call.getResult(0));
    builder.create<fir::StoreOp>(loc, ioStatResult, ioStatVar);
  }
  return csi.hasTransferConditionSpec() ? call.getResult(0) : mlir::Value{};
}

/// Make the next call in the IO statement conditional on runtime result `ok`.
/// If a call returns `ok==false`, further suboperation calls for an IO
/// statement will be skipped.  This may generate branch heavy, deeply nested
/// conditionals for IO statements with a large number of suboperations.
static void makeNextConditionalOn(fir::FirOpBuilder &builder,
                                  mlir::Location loc, bool checkResult,
                                  mlir::Value ok, bool inLoop = false) {
  if (!checkResult || !ok)
    // Either no IO calls need to be checked, or this will be the first call.
    return;

  // A previous IO call for a statement returned the bool `ok`.  If this call
  // is in a fir.iterate_while loop, the result must be propagated up to the
  // loop scope as an extra ifOp result. (The propagation is done in genIoLoop.)
  mlir::TypeRange resTy;
  if (inLoop)
    resTy = builder.getI1Type();
  auto ifOp = builder.create<fir::IfOp>(loc, resTy, ok,
                                        /*withElseRegion=*/inLoop);
  builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
}

/// Retrieve or generate a runtime description of NAMELIST group `symbol`.
/// The form of the description is defined in runtime header file namelist.h.
/// Static descriptors are generated for global objects; local descriptors for
/// local objects.  If all descriptors are static, the NamelistGroup is static.
static mlir::Value
getNamelistGroup(Fortran::lower::AbstractConverter &converter,
                 const Fortran::semantics::Symbol &symbol,
                 Fortran::lower::StatementContext &stmtCtx) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::Location loc = converter.getCurrentLocation();
  std::string groupMangleName = converter.mangleName(symbol);
  if (auto group = builder.getNamedGlobal(groupMangleName))
    return builder.create<fir::AddrOfOp>(loc, group.resultType(),
                                         group.getSymbol());

  const auto &details =
      symbol.GetUltimate().get<Fortran::semantics::NamelistDetails>();
  mlir::MLIRContext *context = builder.getContext();
  mlir::StringAttr linkOnce = builder.createLinkOnceLinkage();
  mlir::IndexType idxTy = builder.getIndexType();
  mlir::IntegerType sizeTy = builder.getIntegerType(8 * sizeof(std::size_t));
  fir::ReferenceType charRefTy =
      fir::ReferenceType::get(builder.getIntegerType(8));
  fir::ReferenceType descRefTy =
      fir::ReferenceType::get(fir::BoxType::get(mlir::NoneType::get(context)));
  fir::SequenceType listTy = fir::SequenceType::get(
      details.objects().size(),
      mlir::TupleType::get(context, {charRefTy, descRefTy}));
  mlir::TupleType groupTy = mlir::TupleType::get(
      context, {charRefTy, sizeTy, fir::ReferenceType::get(listTy)});
  auto stringAddress = [&](const Fortran::semantics::Symbol &symbol) {
    return fir::factory::createStringLiteral(builder, loc,
                                             symbol.name().ToString() + '\0');
  };

  // Define object names, and static descriptors for global objects.
  bool groupIsLocal = false;
  stringAddress(symbol);
  for (const Fortran::semantics::Symbol &s : details.objects()) {
    stringAddress(s);
    if (!Fortran::lower::symbolIsGlobal(s)) {
      groupIsLocal = true;
      continue;
    }
    // We know we have a global item.  It it's not a pointer or allocatable,
    // create a static pointer to it.
    if (!IsAllocatableOrPointer(s)) {
      std::string mangleName = converter.mangleName(s) + ".desc";
      if (builder.getNamedGlobal(mangleName))
        continue;
      const auto expr = Fortran::evaluate::AsGenericExpr(s);
      fir::BoxType boxTy =
          fir::BoxType::get(fir::PointerType::get(converter.genType(s)));
      auto descFunc = [&](fir::FirOpBuilder &b) {
        auto box =
            Fortran::lower::genInitialDataTarget(converter, loc, boxTy, *expr);
        b.create<fir::HasValueOp>(loc, box);
      };
      builder.createGlobalConstant(loc, boxTy, mangleName, descFunc, linkOnce);
    }
  }

  // Define the list of Items.
  mlir::Value listAddr =
      groupIsLocal ? builder.create<fir::AllocaOp>(loc, listTy) : mlir::Value{};
  std::string listMangleName = groupMangleName + ".list";
  auto listFunc = [&](fir::FirOpBuilder &builder) {
    mlir::Value list = builder.create<fir::UndefOp>(loc, listTy);
    mlir::IntegerAttr zero = builder.getIntegerAttr(idxTy, 0);
    mlir::IntegerAttr one = builder.getIntegerAttr(idxTy, 1);
    llvm::SmallVector<mlir::Attribute, 2> idx = {mlir::Attribute{},
                                                 mlir::Attribute{}};
    size_t n = 0;
    for (const Fortran::semantics::Symbol &s : details.objects()) {
      idx[0] = builder.getIntegerAttr(idxTy, n);
      idx[1] = zero;
      mlir::Value nameAddr =
          builder.createConvert(loc, charRefTy, fir::getBase(stringAddress(s)));
      list = builder.create<fir::InsertValueOp>(loc, listTy, list, nameAddr,
                                                builder.getArrayAttr(idx));
      idx[1] = one;
      mlir::Value descAddr;
      // Items that we created end in ".desc".
      std::string suffix = IsAllocatableOrPointer(s) ? "" : ".desc";
      if (auto desc =
              builder.getNamedGlobal(converter.mangleName(s) + suffix)) {
        descAddr = builder.create<fir::AddrOfOp>(loc, desc.resultType(),
                                                 desc.getSymbol());
      } else {
        const auto expr = Fortran::evaluate::AsGenericExpr(s);
        fir::ExtendedValue exv = converter.genExprAddr(*expr, stmtCtx);
        mlir::Type type = fir::getBase(exv).getType();
        if (mlir::Type baseTy = fir::dyn_cast_ptrOrBoxEleTy(type))
          type = baseTy;
        fir::BoxType boxType = fir::BoxType::get(fir::PointerType::get(type));
        descAddr = builder.createTemporary(loc, boxType);
        fir::MutableBoxValue box = fir::MutableBoxValue(descAddr, {}, {});
        fir::factory::associateMutableBox(builder, loc, box, exv,
                                          /*lbounds=*/llvm::None);
      }
      descAddr = builder.createConvert(loc, descRefTy, descAddr);
      list = builder.create<fir::InsertValueOp>(loc, listTy, list, descAddr,
                                                builder.getArrayAttr(idx));
      ++n;
    }
    if (groupIsLocal)
      builder.create<fir::StoreOp>(loc, list, listAddr);
    else
      builder.create<fir::HasValueOp>(loc, list);
  };
  if (groupIsLocal)
    listFunc(builder);
  else
    builder.createGlobalConstant(loc, listTy, listMangleName, listFunc,
                                 linkOnce);

  // Define the group.
  mlir::Value groupAddr = groupIsLocal
                              ? builder.create<fir::AllocaOp>(loc, groupTy)
                              : mlir::Value{};
  auto groupFunc = [&](fir::FirOpBuilder &builder) {
    mlir::IntegerAttr zero = builder.getIntegerAttr(idxTy, 0);
    mlir::IntegerAttr one = builder.getIntegerAttr(idxTy, 1);
    mlir::IntegerAttr two = builder.getIntegerAttr(idxTy, 2);
    mlir::Value group = builder.create<fir::UndefOp>(loc, groupTy);
    mlir::Value nameAddr = builder.createConvert(
        loc, charRefTy, fir::getBase(stringAddress(symbol)));
    group = builder.create<fir::InsertValueOp>(loc, groupTy, group, nameAddr,
                                               builder.getArrayAttr(zero));
    mlir::Value itemCount =
        builder.createIntegerConstant(loc, sizeTy, details.objects().size());
    group = builder.create<fir::InsertValueOp>(loc, groupTy, group, itemCount,
                                               builder.getArrayAttr(one));
    if (fir::GlobalOp list = builder.getNamedGlobal(listMangleName))
      listAddr = builder.create<fir::AddrOfOp>(loc, list.resultType(),
                                               list.getSymbol());
    assert(listAddr && "missing namelist object list");
    group = builder.create<fir::InsertValueOp>(loc, groupTy, group, listAddr,
                                               builder.getArrayAttr(two));
    if (groupIsLocal)
      builder.create<fir::StoreOp>(loc, group, groupAddr);
    else
      builder.create<fir::HasValueOp>(loc, group);
  };
  if (groupIsLocal) {
    groupFunc(builder);
  } else {
    fir::GlobalOp group =
        builder.createGlobal(loc, groupTy, groupMangleName,
                             /*isConst=*/true, groupFunc, linkOnce);
    groupAddr = builder.create<fir::AddrOfOp>(loc, group.resultType(),
                                              group.getSymbol());
  }
  assert(groupAddr && "missing namelist group result");
  return groupAddr;
}

/// Generate a namelist IO call.
static void genNamelistIO(Fortran::lower::AbstractConverter &converter,
                          mlir::Value cookie, mlir::FuncOp funcOp,
                          Fortran::semantics::Symbol &symbol, bool checkResult,
                          mlir::Value &ok,
                          Fortran::lower::StatementContext &stmtCtx) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::Location loc = converter.getCurrentLocation();
  makeNextConditionalOn(builder, loc, checkResult, ok);
  mlir::Type argType = funcOp.getType().getInput(1);
  mlir::Value groupAddr = getNamelistGroup(converter, symbol, stmtCtx);
  groupAddr = builder.createConvert(loc, argType, groupAddr);
  llvm::SmallVector<mlir::Value> args = {cookie, groupAddr};
  ok = builder.create<fir::CallOp>(loc, funcOp, args).getResult(0);
}

/// Get the output function to call for a value of the given type.
static mlir::FuncOp getOutputFunc(mlir::Location loc,
                                  fir::FirOpBuilder &builder, mlir::Type type,
                                  bool isFormatted) {
  if (!isFormatted)
    return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder);
  if (auto ty = type.dyn_cast<mlir::IntegerType>()) {
    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");
  }
  if (auto ty = type.dyn_cast<mlir::FloatType>()) {
    if (auto width = ty.getWidth(); width == 32)
      return getIORuntimeFunc<mkIOKey(OutputReal32)>(loc, builder);
    else if (width == 64)
      return getIORuntimeFunc<mkIOKey(OutputReal64)>(loc, builder);
  }
  auto kindMap = fir::getKindMapping(builder.getModule());
  if (auto ty = type.dyn_cast<fir::ComplexType>()) {
    // COMPLEX(KIND=k) corresponds to a pair of REAL(KIND=k).
    auto width = kindMap.getRealBitsize(ty.getFKind());
    if (width == 32)
      return getIORuntimeFunc<mkIOKey(OutputComplex32)>(loc, builder);
    else if (width == 64)
      return getIORuntimeFunc<mkIOKey(OutputComplex64)>(loc, builder);
  }
  if (type.isa<fir::LogicalType>())
    return getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder);
  if (fir::factory::CharacterExprHelper::isCharacterScalar(type)) {
    // TODO: What would it mean if the default CHARACTER KIND is set to a wide
    // character encoding scheme? How do we handle UTF-8? Is it a distinct KIND
    // value? For now, assume that if the default CHARACTER KIND is 8 bit,
    // then it is an ASCII string and UTF-8 is unsupported.
    auto asciiKind = kindMap.defaultCharacterKind();
    if (kindMap.getCharacterBitsize(asciiKind) == 8 &&
        fir::factory::CharacterExprHelper::getCharacterKind(type) == asciiKind)
      return getIORuntimeFunc<mkIOKey(OutputAscii)>(loc, builder);
  }
  return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder);
}

/// Generate a sequence of output data transfer calls.
static void
genOutputItemList(Fortran::lower::AbstractConverter &converter,
                  mlir::Value cookie,
                  const std::list<Fortran::parser::OutputItem> &items,
                  bool isFormatted, bool checkResult, mlir::Value &ok,
                  bool inLoop, Fortran::lower::StatementContext &stmtCtx) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  for (const Fortran::parser::OutputItem &item : items) {
    if (const auto &impliedDo = std::get_if<1>(&item.u)) {
      genIoLoop(converter, cookie, impliedDo->value(), isFormatted, checkResult,
                ok, inLoop, stmtCtx);
      continue;
    }
    auto &pExpr = std::get<Fortran::parser::Expr>(item.u);
    mlir::Location loc = converter.genLocation(pExpr.source);
    makeNextConditionalOn(builder, loc, checkResult, ok, inLoop);

    const auto *expr = Fortran::semantics::GetExpr(pExpr);
    if (!expr)
      fir::emitFatalError(loc, "internal error: could not get evaluate::Expr");
    mlir::Type itemTy = converter.genType(*expr);
    mlir::FuncOp outputFunc = getOutputFunc(loc, builder, itemTy, isFormatted);
    mlir::Type argType = outputFunc.getType().getInput(1);
    assert((isFormatted || argType.isa<fir::BoxType>()) &&
           "expect descriptor for unformatted IO runtime");
    llvm::SmallVector<mlir::Value> outputFuncArgs = {cookie};
    fir::factory::CharacterExprHelper helper{builder, loc};
    if (argType.isa<fir::BoxType>()) {
      mlir::Value box = fir::getBase(converter.genExprBox(*expr, stmtCtx, loc));
      outputFuncArgs.push_back(builder.createConvert(loc, argType, box));
    } else if (helper.isCharacterScalar(itemTy)) {
      fir::ExtendedValue exv = converter.genExprAddr(expr, stmtCtx, loc);
      // scalar allocatable/pointer may also get here, not clear if
      // genExprAddr will lower them as CharBoxValue or BoxValue.
      if (!exv.getCharBox())
        llvm::report_fatal_error(
            "internal error: scalar character not in CharBox");
      outputFuncArgs.push_back(builder.createConvert(
          loc, outputFunc.getType().getInput(1), fir::getBase(exv)));
      outputFuncArgs.push_back(builder.createConvert(
          loc, outputFunc.getType().getInput(2), fir::getLen(exv)));
    } else {
      fir::ExtendedValue itemBox = converter.genExprValue(expr, stmtCtx, loc);
      mlir::Value itemValue = fir::getBase(itemBox);
      if (fir::isa_complex(itemTy)) {
        auto parts =
            fir::factory::Complex{builder, loc}.extractParts(itemValue);
        outputFuncArgs.push_back(parts.first);
        outputFuncArgs.push_back(parts.second);
      } else {
        itemValue = builder.createConvert(loc, argType, itemValue);
        outputFuncArgs.push_back(itemValue);
      }
    }
    ok = builder.create<fir::CallOp>(loc, outputFunc, outputFuncArgs)
             .getResult(0);
  }
}

/// Get the input function to call for a value of the given type.
static mlir::FuncOp getInputFunc(mlir::Location loc, fir::FirOpBuilder &builder,
                                 mlir::Type type, bool isFormatted) {
  if (!isFormatted)
    return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder);
  if (auto ty = type.dyn_cast<mlir::IntegerType>())
    return ty.getWidth() == 1
               ? getIORuntimeFunc<mkIOKey(InputLogical)>(loc, builder)
               : getIORuntimeFunc<mkIOKey(InputInteger)>(loc, builder);
  if (auto ty = type.dyn_cast<mlir::FloatType>()) {
    if (auto width = ty.getWidth(); width <= 32)
      return getIORuntimeFunc<mkIOKey(InputReal32)>(loc, builder);
    else if (width <= 64)
      return getIORuntimeFunc<mkIOKey(InputReal64)>(loc, builder);
  }
  auto kindMap = fir::getKindMapping(builder.getModule());
  if (auto ty = type.dyn_cast<fir::ComplexType>()) {
    auto width = kindMap.getRealBitsize(ty.getFKind());
    if (width <= 32)
      return getIORuntimeFunc<mkIOKey(InputComplex32)>(loc, builder);
    else if (width <= 64)
      return getIORuntimeFunc<mkIOKey(InputComplex64)>(loc, builder);
  }
  if (type.isa<fir::LogicalType>())
    return getIORuntimeFunc<mkIOKey(InputLogical)>(loc, builder);
  if (fir::factory::CharacterExprHelper::isCharacterScalar(type)) {
    auto asciiKind = kindMap.defaultCharacterKind();
    if (kindMap.getCharacterBitsize(asciiKind) == 8 &&
        fir::factory::CharacterExprHelper::getCharacterKind(type) == asciiKind)
      return getIORuntimeFunc<mkIOKey(InputAscii)>(loc, builder);
  }
  return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder);
}

/// Interpret the lowest byte of a LOGICAL and store that value into the full
/// storage of the LOGICAL. The load, convert, and store effectively (sign or
/// zero) extends the lowest byte into the full LOGICAL value storage, as the
/// runtime is unaware of the LOGICAL value's actual bit width (it was passed
/// as a `bool&` to the runtime in order to be set).
static void boolRefToLogical(mlir::Location loc, fir::FirOpBuilder &builder,
                             mlir::Value addr) {
  auto boolType = builder.getRefType(builder.getI1Type());
  auto boolAddr = builder.createConvert(loc, boolType, addr);
  auto boolValue = builder.create<fir::LoadOp>(loc, boolAddr);
  auto logicalType = fir::unwrapPassByRefType(addr.getType());
  // The convert avoid making any assumptions about how LOGICALs are actually
  // represented (it might end-up being either a signed or zero extension).
  auto logicalValue = builder.createConvert(loc, logicalType, boolValue);
  builder.create<fir::StoreOp>(loc, logicalValue, addr);
}

static mlir::Value createIoRuntimeCallForItem(mlir::Location loc,
                                              fir::FirOpBuilder &builder,
                                              mlir::FuncOp inputFunc,
                                              mlir::Value cookie,
                                              const fir::ExtendedValue &item) {
  mlir::Type argType = inputFunc.getType().getInput(1);
  llvm::SmallVector<mlir::Value> inputFuncArgs = {cookie};
  if (argType.isa<fir::BoxType>()) {
    mlir::Value box = fir::getBase(item);
    assert(box.getType().isa<fir::BoxType>() && "must be previously emboxed");
    inputFuncArgs.push_back(builder.createConvert(loc, argType, box));
  } else {
    mlir::Value itemAddr = fir::getBase(item);
    mlir::Type itemTy = fir::unwrapPassByRefType(itemAddr.getType());
    inputFuncArgs.push_back(builder.createConvert(loc, argType, itemAddr));
    fir::factory::CharacterExprHelper charHelper{builder, loc};
    if (charHelper.isCharacterScalar(itemTy)) {
      mlir::Value len = fir::getLen(item);
      inputFuncArgs.push_back(
          builder.createConvert(loc, inputFunc.getType().getInput(2), len));
    } else if (itemTy.isa<mlir::IntegerType>()) {
      inputFuncArgs.push_back(builder.create<mlir::arith::ConstantOp>(
          loc, builder.getI32IntegerAttr(
                   itemTy.cast<mlir::IntegerType>().getWidth() / 8)));
    }
  }
  auto call = builder.create<fir::CallOp>(loc, inputFunc, inputFuncArgs);
  auto itemAddr = fir::getBase(item);
  auto itemTy = fir::unwrapRefType(itemAddr.getType());
  if (itemTy.isa<fir::LogicalType>())
    boolRefToLogical(loc, builder, itemAddr);
  return call.getResult(0);
}

/// Generate a sequence of input data transfer calls.
static void genInputItemList(Fortran::lower::AbstractConverter &converter,
                             mlir::Value cookie,
                             const std::list<Fortran::parser::InputItem> &items,
                             bool isFormatted, bool checkResult,
                             mlir::Value &ok, bool inLoop,
                             Fortran::lower::StatementContext &stmtCtx) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  for (const Fortran::parser::InputItem &item : items) {
    if (const auto &impliedDo = std::get_if<1>(&item.u)) {
      genIoLoop(converter, cookie, impliedDo->value(), isFormatted, checkResult,
                ok, inLoop, stmtCtx);
      continue;
    }
    auto &pVar = std::get<Fortran::parser::Variable>(item.u);
    mlir::Location loc = converter.genLocation(pVar.GetSource());
    makeNextConditionalOn(builder, loc, checkResult, ok, inLoop);
    const auto *expr = Fortran::semantics::GetExpr(pVar);
    if (!expr)
      fir::emitFatalError(loc, "internal error: could not get evaluate::Expr");
    if (Fortran::evaluate::HasVectorSubscript(*expr)) {
      auto vectorSubscriptBox =
          Fortran::lower::genVectorSubscriptBox(loc, converter, stmtCtx, *expr);
      mlir::FuncOp inputFunc = getInputFunc(
          loc, builder, vectorSubscriptBox.getElementType(), isFormatted);
      const bool mustBox = inputFunc.getType().getInput(1).isa<fir::BoxType>();
      if (!checkResult) {
        auto elementalGenerator = [&](const fir::ExtendedValue &element) {
          createIoRuntimeCallForItem(loc, builder, inputFunc, cookie,
                                     mustBox ? builder.createBox(loc, element)
                                             : element);
        };
        vectorSubscriptBox.loopOverElements(builder, loc, elementalGenerator);
      } else {
        auto elementalGenerator =
            [&](const fir::ExtendedValue &element) -> mlir::Value {
          return createIoRuntimeCallForItem(
              loc, builder, inputFunc, cookie,
              mustBox ? builder.createBox(loc, element) : element);
        };
        if (!ok)
          ok = builder.createBool(loc, true);
        ok = vectorSubscriptBox.loopOverElementsWhile(builder, loc,
                                                      elementalGenerator, ok);
      }
      continue;
    }
    mlir::Type itemTy = converter.genType(*expr);
    mlir::FuncOp inputFunc = getInputFunc(loc, builder, itemTy, isFormatted);
    auto itemExv = inputFunc.getType().getInput(1).isa<fir::BoxType>()
                       ? converter.genExprBox(*expr, stmtCtx, loc)
                       : converter.genExprAddr(expr, stmtCtx, loc);
    ok = createIoRuntimeCallForItem(loc, builder, inputFunc, cookie, itemExv);
  }
}

/// Generate an io-implied-do loop.
template <typename D>
static void genIoLoop(Fortran::lower::AbstractConverter &converter,
                      mlir::Value cookie, const D &ioImpliedDo,
                      bool isFormatted, bool checkResult, mlir::Value &ok,
                      bool inLoop, Fortran::lower::StatementContext &stmtCtx) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::Location loc = converter.getCurrentLocation();
  makeNextConditionalOn(builder, loc, checkResult, ok, inLoop);
  const auto &itemList = std::get<0>(ioImpliedDo.t);
  const auto &control = std::get<1>(ioImpliedDo.t);
  const auto &loopSym = *control.name.thing.thing.symbol;
  mlir::Value loopVar = converter.getSymbolAddress(loopSym);
  auto genControlValue = [&](const Fortran::parser::ScalarIntExpr &expr) {
    mlir::Value v = fir::getBase(
        converter.genExprValue(*Fortran::semantics::GetExpr(expr), stmtCtx));
    return builder.createConvert(loc, builder.getIndexType(), v);
  };
  mlir::Value lowerValue = genControlValue(control.lower);
  mlir::Value upperValue = genControlValue(control.upper);
  mlir::Value stepValue =
      control.step.has_value()
          ? genControlValue(*control.step)
          : builder.create<mlir::arith::ConstantIndexOp>(loc, 1);
  auto genItemList = [&](const D &ioImpliedDo) {
    Fortran::lower::StatementContext loopCtx;
    if constexpr (std::is_same_v<D, Fortran::parser::InputImpliedDo>)
      genInputItemList(converter, cookie, itemList, isFormatted, checkResult,
                       ok, /*inLoop=*/true, loopCtx);
    else
      genOutputItemList(converter, cookie, itemList, isFormatted, checkResult,
                        ok, /*inLoop=*/true, loopCtx);
  };
  if (!checkResult) {
    // No IO call result checks - the loop is a fir.do_loop op.
    auto doLoopOp = builder.create<fir::DoLoopOp>(
        loc, lowerValue, upperValue, stepValue, /*unordered=*/false,
        /*finalCountValue=*/true);
    builder.setInsertionPointToStart(doLoopOp.getBody());
    mlir::Value lcv = builder.createConvert(loc, converter.genType(loopSym),
                                            doLoopOp.getInductionVar());
    builder.create<fir::StoreOp>(loc, lcv, loopVar);
    genItemList(ioImpliedDo);
    builder.setInsertionPointToEnd(doLoopOp.getBody());
    mlir::Value result = builder.create<mlir::arith::AddIOp>(
        loc, doLoopOp.getInductionVar(), doLoopOp.getStep());
    builder.create<fir::ResultOp>(loc, result);
    builder.setInsertionPointAfter(doLoopOp);
    // The loop control variable may be used after the loop.
    lcv = builder.createConvert(loc, converter.genType(loopSym),
                                doLoopOp.getResult(0));
    builder.create<fir::StoreOp>(loc, lcv, loopVar);
    return;
  }
  // Check IO call results - the loop is a fir.iterate_while op.
  if (!ok)
    ok = builder.createBool(loc, true);
  auto iterWhileOp = builder.create<fir::IterWhileOp>(
      loc, lowerValue, upperValue, stepValue, ok, /*finalCountValue*/ true);
  builder.setInsertionPointToStart(iterWhileOp.getBody());
  mlir::Value lcv = builder.createConvert(loc, converter.genType(loopSym),
                                          iterWhileOp.getInductionVar());
  builder.create<fir::StoreOp>(loc, lcv, loopVar);
  ok = iterWhileOp.getIterateVar();
  mlir::Value falseValue =
      builder.createIntegerConstant(loc, builder.getI1Type(), 0);
  genItemList(ioImpliedDo);
  // Unwind nested IO call scopes, filling in true and false ResultOp's.
  for (mlir::Operation *op = builder.getBlock()->getParentOp();
       mlir::isa<fir::IfOp>(op); op = op->getBlock()->getParentOp()) {
    auto ifOp = mlir::dyn_cast<fir::IfOp>(op);
    mlir::Operation *lastOp = &ifOp.getThenRegion().front().back();
    builder.setInsertionPointAfter(lastOp);
    // The primary ifOp result is the result of an IO call or loop.
    if (mlir::isa<fir::CallOp, fir::IfOp>(*lastOp))
      builder.create<fir::ResultOp>(loc, lastOp->getResult(0));
    else
      builder.create<fir::ResultOp>(loc, ok); // loop result
    // The else branch propagates an early exit false result.
    builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
    builder.create<fir::ResultOp>(loc, falseValue);
  }
  builder.setInsertionPointToEnd(iterWhileOp.getBody());
  mlir::OpResult iterateResult = builder.getBlock()->back().getResult(0);
  mlir::Value inductionResult0 = iterWhileOp.getInductionVar();
  auto inductionResult1 = builder.create<mlir::arith::AddIOp>(
      loc, inductionResult0, iterWhileOp.getStep());
  auto inductionResult = builder.create<mlir::arith::SelectOp>(
      loc, iterateResult, inductionResult1, inductionResult0);
  llvm::SmallVector<mlir::Value> results = {inductionResult, iterateResult};
  builder.create<fir::ResultOp>(loc, results);
  ok = iterWhileOp.getResult(1);
  builder.setInsertionPointAfter(iterWhileOp);
  // The loop control variable may be used after the loop.
  lcv = builder.createConvert(loc, converter.genType(loopSym),
                              iterWhileOp.getResult(0));
  builder.create<fir::StoreOp>(loc, lcv, loopVar);
}

//===----------------------------------------------------------------------===//
// Default argument generation.
//===----------------------------------------------------------------------===//

static mlir::Value locToFilename(Fortran::lower::AbstractConverter &converter,
                                 mlir::Location loc, mlir::Type toType) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  return builder.createConvert(loc, toType,
                               fir::factory::locationToFilename(builder, loc));
}

static mlir::Value locToLineNo(Fortran::lower::AbstractConverter &converter,
                               mlir::Location loc, mlir::Type toType) {
  return fir::factory::locationToLineNo(converter.getFirOpBuilder(), loc,
                                        toType);
}

static mlir::Value getDefaultScratch(fir::FirOpBuilder &builder,
                                     mlir::Location loc, mlir::Type toType) {
  mlir::Value null = builder.create<mlir::arith::ConstantOp>(
      loc, builder.getI64IntegerAttr(0));
  return builder.createConvert(loc, toType, null);
}

static mlir::Value getDefaultScratchLen(fir::FirOpBuilder &builder,
                                        mlir::Location loc, mlir::Type toType) {
  return builder.create<mlir::arith::ConstantOp>(
      loc, builder.getIntegerAttr(toType, 0));
}

/// Generate a reference to a buffer and the length of buffer given
/// a character expression. An array expression will be cast to scalar
/// character as long as they are contiguous.
static std::tuple<mlir::Value, mlir::Value>
genBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
          const Fortran::lower::SomeExpr &expr, mlir::Type strTy,
          mlir::Type lenTy, Fortran::lower::StatementContext &stmtCtx) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  fir::ExtendedValue exprAddr = converter.genExprAddr(expr, stmtCtx);
  fir::factory::CharacterExprHelper helper(builder, loc);
  using ValuePair = std::pair<mlir::Value, mlir::Value>;
  auto [buff, len] = exprAddr.match(
      [&](const fir::CharBoxValue &x) -> ValuePair {
        return {x.getBuffer(), x.getLen()};
      },
      [&](const fir::CharArrayBoxValue &x) -> ValuePair {
        fir::CharBoxValue scalar = helper.toScalarCharacter(x);
        return {scalar.getBuffer(), scalar.getLen()};
      },
      [&](const fir::BoxValue &) -> ValuePair {
        // May need to copy before after IO to handle contiguous
        // aspect. Not sure descriptor can get here though.
        TODO(loc, "character descriptor to contiguous buffer");
      },
      [&](const auto &) -> ValuePair {
        llvm::report_fatal_error(
            "internal error: IO buffer is not a character");
      });
  buff = builder.createConvert(loc, strTy, buff);
  len = builder.createConvert(loc, lenTy, len);
  return {buff, len};
}

/// Lower a string literal. Many arguments to the runtime are conveyed as
/// Fortran CHARACTER literals.
template <typename A>
static std::tuple<mlir::Value, mlir::Value, mlir::Value>
lowerStringLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
               Fortran::lower::StatementContext &stmtCtx, const A &syntax,
               mlir::Type strTy, mlir::Type lenTy, mlir::Type ty2 = {}) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  auto *expr = Fortran::semantics::GetExpr(syntax);
  if (!expr)
    fir::emitFatalError(loc, "internal error: null semantic expr in IO");
  auto [buff, len] = genBuffer(converter, loc, *expr, strTy, lenTy, stmtCtx);
  mlir::Value kind;
  if (ty2) {
    auto kindVal = expr->GetType().value().kind();
    kind = builder.create<mlir::arith::ConstantOp>(
        loc, builder.getIntegerAttr(ty2, kindVal));
  }
  return {buff, len, kind};
}

/// Pass the body of the FORMAT statement in as if it were a CHARACTER literal
/// constant. NB: This is the prescribed manner in which the front-end passes
/// this information to lowering.
static std::tuple<mlir::Value, mlir::Value, mlir::Value>
lowerSourceTextAsStringLit(Fortran::lower::AbstractConverter &converter,
                           mlir::Location loc, llvm::StringRef text,
                           mlir::Type strTy, mlir::Type lenTy) {
  text = text.drop_front(text.find('('));
  text = text.take_front(text.rfind(')') + 1);
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::Value addrGlobalStringLit =
      fir::getBase(fir::factory::createStringLiteral(builder, loc, text));
  mlir::Value buff = builder.createConvert(loc, strTy, addrGlobalStringLit);
  mlir::Value len = builder.createIntegerConstant(loc, lenTy, text.size());
  return {buff, len, mlir::Value{}};
}

//===----------------------------------------------------------------------===//
// Handle IO statement specifiers.
// These are threaded together for a single statement via the passed cookie.
//===----------------------------------------------------------------------===//

/// Generic to build an integral argument to the runtime.
template <typename A, typename B>
mlir::Value genIntIOOption(Fortran::lower::AbstractConverter &converter,
                           mlir::Location loc, mlir::Value cookie,
                           const B &spec) {
  Fortran::lower::StatementContext localStatementCtx;
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::FuncOp ioFunc = getIORuntimeFunc<A>(loc, builder);
  mlir::FunctionType ioFuncTy = ioFunc.getType();
  mlir::Value expr = fir::getBase(converter.genExprValue(
      Fortran::semantics::GetExpr(spec.v), localStatementCtx, loc));
  mlir::Value val = builder.createConvert(loc, ioFuncTy.getInput(1), expr);
  llvm::SmallVector<mlir::Value> ioArgs = {cookie, val};
  return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
}

/// Generic to build a string argument to the runtime. This passes a CHARACTER
/// as a pointer to the buffer and a LEN parameter.
template <typename A, typename B>
mlir::Value genCharIOOption(Fortran::lower::AbstractConverter &converter,
                            mlir::Location loc, mlir::Value cookie,
                            const B &spec) {
  Fortran::lower::StatementContext localStatementCtx;
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::FuncOp ioFunc = getIORuntimeFunc<A>(loc, builder);
  mlir::FunctionType ioFuncTy = ioFunc.getType();
  std::tuple<mlir::Value, mlir::Value, mlir::Value> tup =
      lowerStringLit(converter, loc, localStatementCtx, spec,
                     ioFuncTy.getInput(1), ioFuncTy.getInput(2));
  llvm::SmallVector<mlir::Value> ioArgs = {cookie, std::get<0>(tup),
                                           std::get<1>(tup)};
  return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
}

template <typename A>
mlir::Value genIOOption(Fortran::lower::AbstractConverter &converter,
                        mlir::Location loc, mlir::Value cookie, const A &spec) {
  // These specifiers are processed in advance elsewhere - skip them here.
  using PreprocessedSpecs =
      std::tuple<Fortran::parser::EndLabel, Fortran::parser::EorLabel,
                 Fortran::parser::ErrLabel, Fortran::parser::FileUnitNumber,
                 Fortran::parser::Format, Fortran::parser::IoUnit,
                 Fortran::parser::MsgVariable, Fortran::parser::Name,
                 Fortran::parser::StatVariable>;
  static_assert(Fortran::common::HasMember<A, PreprocessedSpecs>,
                "missing genIOOPtion specialization");
  return {};
}

template <>
mlir::Value genIOOption<Fortran::parser::FileNameExpr>(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    mlir::Value cookie, const Fortran::parser::FileNameExpr &spec) {
  Fortran::lower::StatementContext localStatementCtx;
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  // has an extra KIND argument
  mlir::FuncOp ioFunc = getIORuntimeFunc<mkIOKey(SetFile)>(loc, builder);
  mlir::FunctionType ioFuncTy = ioFunc.getType();
  std::tuple<mlir::Value, mlir::Value, mlir::Value> tup =
      lowerStringLit(converter, loc, localStatementCtx, spec,
                     ioFuncTy.getInput(1), ioFuncTy.getInput(2));
  llvm::SmallVector<mlir::Value> ioArgs{cookie, std::get<0>(tup),
                                        std::get<1>(tup)};
  return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
}

template <>
mlir::Value genIOOption<Fortran::parser::ConnectSpec::CharExpr>(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    mlir::Value cookie, const Fortran::parser::ConnectSpec::CharExpr &spec) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::FuncOp ioFunc;
  switch (std::get<Fortran::parser::ConnectSpec::CharExpr::Kind>(spec.t)) {
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Access:
    ioFunc = getIORuntimeFunc<mkIOKey(SetAccess)>(loc, builder);
    break;
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Action:
    ioFunc = getIORuntimeFunc<mkIOKey(SetAction)>(loc, builder);
    break;
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Asynchronous:
    ioFunc = getIORuntimeFunc<mkIOKey(SetAsynchronous)>(loc, builder);
    break;
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Blank:
    ioFunc = getIORuntimeFunc<mkIOKey(SetBlank)>(loc, builder);
    break;
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Decimal:
    ioFunc = getIORuntimeFunc<mkIOKey(SetDecimal)>(loc, builder);
    break;
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Delim:
    ioFunc = getIORuntimeFunc<mkIOKey(SetDelim)>(loc, builder);
    break;
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Encoding:
    ioFunc = getIORuntimeFunc<mkIOKey(SetEncoding)>(loc, builder);
    break;
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Form:
    ioFunc = getIORuntimeFunc<mkIOKey(SetForm)>(loc, builder);
    break;
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Pad:
    ioFunc = getIORuntimeFunc<mkIOKey(SetPad)>(loc, builder);
    break;
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Position:
    ioFunc = getIORuntimeFunc<mkIOKey(SetPosition)>(loc, builder);
    break;
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Round:
    ioFunc = getIORuntimeFunc<mkIOKey(SetRound)>(loc, builder);
    break;
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Sign:
    ioFunc = getIORuntimeFunc<mkIOKey(SetSign)>(loc, builder);
    break;
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Carriagecontrol:
    ioFunc = getIORuntimeFunc<mkIOKey(SetCarriagecontrol)>(loc, builder);
    break;
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Convert:
    TODO(loc, "CONVERT not part of the runtime::io interface");
  case Fortran::parser::ConnectSpec::CharExpr::Kind::Dispose:
    TODO(loc, "DISPOSE not part of the runtime::io interface");
  }
  Fortran::lower::StatementContext localStatementCtx;
  mlir::FunctionType ioFuncTy = ioFunc.getType();
  std::tuple<mlir::Value, mlir::Value, mlir::Value> tup =
      lowerStringLit(converter, loc, localStatementCtx,
                     std::get<Fortran::parser::ScalarDefaultCharExpr>(spec.t),
                     ioFuncTy.getInput(1), ioFuncTy.getInput(2));
  llvm::SmallVector<mlir::Value> ioArgs = {cookie, std::get<0>(tup),
                                           std::get<1>(tup)};
  return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
}

template <>
mlir::Value genIOOption<Fortran::parser::ConnectSpec::Recl>(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    mlir::Value cookie, const Fortran::parser::ConnectSpec::Recl &spec) {
  return genIntIOOption<mkIOKey(SetRecl)>(converter, loc, cookie, spec);
}

template <>
mlir::Value genIOOption<Fortran::parser::StatusExpr>(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    mlir::Value cookie, const Fortran::parser::StatusExpr &spec) {
  return genCharIOOption<mkIOKey(SetStatus)>(converter, loc, cookie, spec.v);
}

template <>
mlir::Value genIOOption<Fortran::parser::IoControlSpec::CharExpr>(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    mlir::Value cookie, const Fortran::parser::IoControlSpec::CharExpr &spec) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::FuncOp ioFunc;
  switch (std::get<Fortran::parser::IoControlSpec::CharExpr::Kind>(spec.t)) {
  case Fortran::parser::IoControlSpec::CharExpr::Kind::Advance:
    ioFunc = getIORuntimeFunc<mkIOKey(SetAdvance)>(loc, builder);
    break;
  case Fortran::parser::IoControlSpec::CharExpr::Kind::Blank:
    ioFunc = getIORuntimeFunc<mkIOKey(SetBlank)>(loc, builder);
    break;
  case Fortran::parser::IoControlSpec::CharExpr::Kind::Decimal:
    ioFunc = getIORuntimeFunc<mkIOKey(SetDecimal)>(loc, builder);
    break;
  case Fortran::parser::IoControlSpec::CharExpr::Kind::Delim:
    ioFunc = getIORuntimeFunc<mkIOKey(SetDelim)>(loc, builder);
    break;
  case Fortran::parser::IoControlSpec::CharExpr::Kind::Pad:
    ioFunc = getIORuntimeFunc<mkIOKey(SetPad)>(loc, builder);
    break;
  case Fortran::parser::IoControlSpec::CharExpr::Kind::Round:
    ioFunc = getIORuntimeFunc<mkIOKey(SetRound)>(loc, builder);
    break;
  case Fortran::parser::IoControlSpec::CharExpr::Kind::Sign:
    ioFunc = getIORuntimeFunc<mkIOKey(SetSign)>(loc, builder);
    break;
  }
  Fortran::lower::StatementContext localStatementCtx;
  mlir::FunctionType ioFuncTy = ioFunc.getType();
  std::tuple<mlir::Value, mlir::Value, mlir::Value> tup =
      lowerStringLit(converter, loc, localStatementCtx,
                     std::get<Fortran::parser::ScalarDefaultCharExpr>(spec.t),
                     ioFuncTy.getInput(1), ioFuncTy.getInput(2));
  llvm::SmallVector<mlir::Value> ioArgs = {cookie, std::get<0>(tup),
                                           std::get<1>(tup)};
  return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
}

template <>
mlir::Value genIOOption<Fortran::parser::IoControlSpec::Asynchronous>(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    mlir::Value cookie,
    const Fortran::parser::IoControlSpec::Asynchronous &spec) {
  return genCharIOOption<mkIOKey(SetAsynchronous)>(converter, loc, cookie,
                                                   spec.v);
}

template <>
mlir::Value genIOOption<Fortran::parser::IdVariable>(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    mlir::Value cookie, const Fortran::parser::IdVariable &spec) {
  TODO(loc, "asynchronous ID not implemented");
}

template <>
mlir::Value genIOOption<Fortran::parser::IoControlSpec::Pos>(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    mlir::Value cookie, const Fortran::parser::IoControlSpec::Pos &spec) {
  return genIntIOOption<mkIOKey(SetPos)>(converter, loc, cookie, spec);
}

template <>
mlir::Value genIOOption<Fortran::parser::IoControlSpec::Rec>(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    mlir::Value cookie, const Fortran::parser::IoControlSpec::Rec &spec) {
  return genIntIOOption<mkIOKey(SetRec)>(converter, loc, cookie, spec);
}

/// Generate runtime call to query the read size after an input statement if
/// the statement has SIZE control-spec.
template <typename A>
static void genIOReadSize(Fortran::lower::AbstractConverter &converter,
                          mlir::Location loc, mlir::Value cookie,
                          const A &specList, bool checkResult) {
  // This call is not conditional on the current IO status (ok) because the size
  // needs to be filled even if some error condition (end-of-file...) was met
  // during the input statement (in which case the runtime may return zero for
  // the size read).
  for (const auto &spec : specList)
    if (const auto *size =
            std::get_if<Fortran::parser::IoControlSpec::Size>(&spec.u)) {

      fir::FirOpBuilder &builder = converter.getFirOpBuilder();
      mlir::FuncOp ioFunc = getIORuntimeFunc<mkIOKey(GetSize)>(loc, builder);
      auto sizeValue =
          builder.create<fir::CallOp>(loc, ioFunc, mlir::ValueRange{cookie})
              .getResult(0);
      Fortran::lower::StatementContext localStatementCtx;
      fir::ExtendedValue var = converter.genExprAddr(
          Fortran::semantics::GetExpr(size->v), localStatementCtx, loc);
      mlir::Value varAddr = fir::getBase(var);
      mlir::Type varType = fir::unwrapPassByRefType(varAddr.getType());
      mlir::Value sizeCast = builder.createConvert(loc, varType, sizeValue);
      builder.create<fir::StoreOp>(loc, sizeCast, varAddr);
      break;
    }
}

//===----------------------------------------------------------------------===//
// Gather IO statement condition specifier information (if any).
//===----------------------------------------------------------------------===//

template <typename SEEK, typename A>
static bool hasX(const A &list) {
  for (const auto &spec : list)
    if (std::holds_alternative<SEEK>(spec.u))
      return true;
  return false;
}

template <typename SEEK, typename A>
static bool hasSpec(const A &stmt) {
  return hasX<SEEK>(stmt.v);
}

/// Get the sought expression from the specifier list.
template <typename SEEK, typename A>
static const Fortran::lower::SomeExpr *getExpr(const A &stmt) {
  for (const auto &spec : stmt.v)
    if (auto *f = std::get_if<SEEK>(&spec.u))
      return Fortran::semantics::GetExpr(f->v);
  llvm::report_fatal_error("must have a file unit");
}

/// For each specifier, build the appropriate call, threading the cookie.
template <typename A>
static void threadSpecs(Fortran::lower::AbstractConverter &converter,
                        mlir::Location loc, mlir::Value cookie,
                        const A &specList, bool checkResult, mlir::Value &ok) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  for (const auto &spec : specList) {
    makeNextConditionalOn(builder, loc, checkResult, ok);
    ok = std::visit(
        Fortran::common::visitors{
            [&](const Fortran::parser::IoControlSpec::Size &x) -> mlir::Value {
              // Size must be queried after the related READ runtime calls, not
              // before.
              return ok;
            },
            [&](const Fortran::parser::ConnectSpec::Newunit &x) -> mlir::Value {
              // Newunit must be queried after OPEN specifier runtime calls
              // that may fail to avoid modifying the newunit variable if
              // there is an error.
              return ok;
            },
            [&](const auto &x) {
              return genIOOption(converter, loc, cookie, x);
            }},
        spec.u);
  }
}

/// Most IO statements allow one or more of five optional exception condition
/// handling specifiers: ERR, EOR, END, IOSTAT, and IOMSG. The first three
/// cause control flow to transfer to another statement. The final two return
/// information from the runtime, via a variable, about the nature of the
/// condition that occurred. These condition specifiers are handled here.
template <typename A>
static void
genConditionHandlerCall(Fortran::lower::AbstractConverter &converter,
                        mlir::Location loc, mlir::Value cookie,
                        const A &specList, ConditionSpecInfo &csi) {
  for (const auto &spec : specList) {
    std::visit(
        Fortran::common::visitors{
            [&](const Fortran::parser::StatVariable &var) {
              csi.ioStatExpr = Fortran::semantics::GetExpr(var);
            },
            [&](const Fortran::parser::InquireSpec::IntVar &var) {
              if (std::get<Fortran::parser::InquireSpec::IntVar::Kind>(var.t) ==
                  Fortran::parser::InquireSpec::IntVar::Kind::Iostat)
                csi.ioStatExpr = Fortran::semantics::GetExpr(
                    std::get<Fortran::parser::ScalarIntVariable>(var.t));
            },
            [&](const Fortran::parser::MsgVariable &var) {
              csi.ioMsgExpr = Fortran::semantics::GetExpr(var);
            },
            [&](const Fortran::parser::InquireSpec::CharVar &var) {
              if (std::get<Fortran::parser::InquireSpec::CharVar::Kind>(
                      var.t) ==
                  Fortran::parser::InquireSpec::CharVar::Kind::Iomsg)
                csi.ioMsgExpr = Fortran::semantics::GetExpr(
                    std::get<Fortran::parser::ScalarDefaultCharVariable>(
                        var.t));
            },
            [&](const Fortran::parser::EndLabel &) { csi.hasEnd = true; },
            [&](const Fortran::parser::EorLabel &) { csi.hasEor = true; },
            [&](const Fortran::parser::ErrLabel &) { csi.hasErr = true; },
            [](const auto &) {}},
        spec.u);
  }
  if (!csi.hasAnyConditionSpec())
    return;
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::FuncOp enableHandlers =
      getIORuntimeFunc<mkIOKey(EnableHandlers)>(loc, builder);
  mlir::Type boolType = enableHandlers.getType().getInput(1);
  auto boolValue = [&](bool specifierIsPresent) {
    return builder.create<mlir::arith::ConstantOp>(
        loc, builder.getIntegerAttr(boolType, specifierIsPresent));
  };
  llvm::SmallVector<mlir::Value> ioArgs = {cookie,
                                           boolValue(csi.ioStatExpr != nullptr),
                                           boolValue(csi.hasErr),
                                           boolValue(csi.hasEnd),
                                           boolValue(csi.hasEor),
                                           boolValue(csi.ioMsgExpr != nullptr)};
  builder.create<fir::CallOp>(loc, enableHandlers, ioArgs);
}

//===----------------------------------------------------------------------===//
// Data transfer helpers
//===----------------------------------------------------------------------===//

template <typename SEEK, typename A>
static bool hasIOControl(const A &stmt) {
  return hasX<SEEK>(stmt.controls);
}

template <typename SEEK, typename A>
static const auto *getIOControl(const A &stmt) {
  for (const auto &spec : stmt.controls)
    if (const auto *result = std::get_if<SEEK>(&spec.u))
      return result;
  return static_cast<const SEEK *>(nullptr);
}

/// Returns true iff the expression in the parse tree is not really a format but
/// rather a namelist group.
template <typename A>
static bool formatIsActuallyNamelist(const A &format) {
  if (auto *e = std::get_if<Fortran::parser::Expr>(&format.u)) {
    auto *expr = Fortran::semantics::GetExpr(*e);
    if (const Fortran::semantics::Symbol *y =
            Fortran::evaluate::UnwrapWholeSymbolDataRef(*expr))
      return y->has<Fortran::semantics::NamelistDetails>();
  }
  return false;
}

template <typename A>
static bool isDataTransferFormatted(const A &stmt) {
  if (stmt.format)
    return !formatIsActuallyNamelist(*stmt.format);
  return hasIOControl<Fortran::parser::Format>(stmt);
}
template <>
constexpr bool isDataTransferFormatted<Fortran::parser::PrintStmt>(
    const Fortran::parser::PrintStmt &) {
  return true; // PRINT is always formatted
}

template <typename A>
static bool isDataTransferList(const A &stmt) {
  if (stmt.format)
    return std::holds_alternative<Fortran::parser::Star>(stmt.format->u);
  if (auto *mem = getIOControl<Fortran::parser::Format>(stmt))
    return std::holds_alternative<Fortran::parser::Star>(mem->u);
  return false;
}
template <>
bool isDataTransferList<Fortran::parser::PrintStmt>(
    const Fortran::parser::PrintStmt &stmt) {
  return std::holds_alternative<Fortran::parser::Star>(
      std::get<Fortran::parser::Format>(stmt.t).u);
}

template <typename A>
static bool isDataTransferInternal(const A &stmt) {
  if (stmt.iounit.has_value())
    return std::holds_alternative<Fortran::parser::Variable>(stmt.iounit->u);
  if (auto *unit = getIOControl<Fortran::parser::IoUnit>(stmt))
    return std::holds_alternative<Fortran::parser::Variable>(unit->u);
  return false;
}
template <>
constexpr bool isDataTransferInternal<Fortran::parser::PrintStmt>(
    const Fortran::parser::PrintStmt &) {
  return false;
}

/// If the variable `var` is an array or of a KIND other than the default
/// (normally 1), then a descriptor is required by the runtime IO API. This
/// condition holds even in F77 sources.
static llvm::Optional<fir::ExtendedValue> getVariableBufferRequiredDescriptor(
    Fortran::lower::AbstractConverter &converter,
    const Fortran::parser::Variable &var,
    Fortran::lower::StatementContext &stmtCtx) {
  fir::ExtendedValue varBox =
      converter.genExprAddr(var.typedExpr->v.value(), stmtCtx);
  fir::KindTy defCharKind = converter.getKindMap().defaultCharacterKind();
  mlir::Value varAddr = fir::getBase(varBox);
  if (fir::factory::CharacterExprHelper::getCharacterOrSequenceKind(
          varAddr.getType()) != defCharKind)
    return varBox;
  if (fir::factory::CharacterExprHelper::isArray(varAddr.getType()))
    return varBox;
  return llvm::None;
}

template <typename A>
static llvm::Optional<fir::ExtendedValue>
maybeGetInternalIODescriptor(Fortran::lower::AbstractConverter &converter,
                             const A &stmt,
                             Fortran::lower::StatementContext &stmtCtx) {
  if (stmt.iounit.has_value())
    if (auto *var = std::get_if<Fortran::parser::Variable>(&stmt.iounit->u))
      return getVariableBufferRequiredDescriptor(converter, *var, stmtCtx);
  if (auto *unit = getIOControl<Fortran::parser::IoUnit>(stmt))
    if (auto *var = std::get_if<Fortran::parser::Variable>(&unit->u))
      return getVariableBufferRequiredDescriptor(converter, *var, stmtCtx);
  return llvm::None;
}
template <>
inline llvm::Optional<fir::ExtendedValue>
maybeGetInternalIODescriptor<Fortran::parser::PrintStmt>(
    Fortran::lower::AbstractConverter &, const Fortran::parser::PrintStmt &,
    Fortran::lower::StatementContext &) {
  return llvm::None;
}

template <typename A>
static bool isDataTransferAsynchronous(mlir::Location loc, const A &stmt) {
  if (auto *asynch =
          getIOControl<Fortran::parser::IoControlSpec::Asynchronous>(stmt)) {
    // FIXME: should contain a string of YES or NO
    TODO(loc, "asynchronous transfers not implemented in runtime");
  }
  return false;
}
template <>
bool isDataTransferAsynchronous<Fortran::parser::PrintStmt>(
    mlir::Location, const Fortran::parser::PrintStmt &) {
  return false;
}

template <typename A>
static bool isDataTransferNamelist(const A &stmt) {
  if (stmt.format)
    return formatIsActuallyNamelist(*stmt.format);
  return hasIOControl<Fortran::parser::Name>(stmt);
}
template <>
constexpr bool isDataTransferNamelist<Fortran::parser::PrintStmt>(
    const Fortran::parser::PrintStmt &) {
  return false;
}

/// Lowers a format statment that uses an assigned variable label reference as
/// a select operation to allow for run-time selection of the format statement.
static std::tuple<mlir::Value, mlir::Value, mlir::Value>
lowerReferenceAsStringSelect(Fortran::lower::AbstractConverter &converter,
                             mlir::Location loc,
                             const Fortran::lower::SomeExpr &expr,
                             mlir::Type strTy, mlir::Type lenTy,
                             Fortran::lower::StatementContext &stmtCtx) {
  // Possible optimization TODO: Instead of inlining a selectOp every time there
  // is a variable reference to a format statement, a function with the selectOp
  // could be generated to reduce code size. It is not clear if such an
  // optimization would be deployed very often or improve the object code
  // beyond, say, what GVN/GCM might produce.

  // Create the requisite blocks to inline a selectOp.
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  mlir::Block *startBlock = builder.getBlock();
  mlir::Block *endBlock = startBlock->splitBlock(builder.getInsertionPoint());
  mlir::Block *block = startBlock->splitBlock(builder.getInsertionPoint());
  builder.setInsertionPointToEnd(block);

  llvm::SmallVector<int64_t> indexList;
  llvm::SmallVector<mlir::Block *> blockList;

  auto symbol = GetLastSymbol(&expr);
  Fortran::lower::pft::LabelSet labels;
  [[maybe_unused]] auto foundLabelSet =
      converter.lookupLabelSet(*symbol, labels);
  assert(foundLabelSet && "Label not found in map");

  for (auto label : labels) {
    indexList.push_back(label);
    auto *eval = converter.lookupLabel(label);
    assert(eval && "Label is missing from the table");

    llvm::StringRef text = toStringRef(eval->position);
    mlir::Value stringRef;
    mlir::Value stringLen;
    if (eval->isA<Fortran::parser::FormatStmt>()) {
      assert(text.find('(') != llvm::StringRef::npos &&
             "FORMAT is unexpectedly ill-formed");
      // This is a format statement, so extract the spec from the text.
      std::tuple<mlir::Value, mlir::Value, mlir::Value> stringLit =
          lowerSourceTextAsStringLit(converter, loc, text, strTy, lenTy);
      stringRef = std::get<0>(stringLit);
      stringLen = std::get<1>(stringLit);
    } else {
      // This is not a format statement, so use null.
      stringRef = builder.createConvert(
          loc, strTy,
          builder.createIntegerConstant(loc, builder.getIndexType(), 0));
      stringLen = builder.createIntegerConstant(loc, lenTy, 0);
    }

    // Pass the format string reference and the string length out of the select
    // statement.
    llvm::SmallVector<mlir::Value> args = {stringRef, stringLen};
    builder.create<mlir::cf::BranchOp>(loc, endBlock, args);

    // Add block to the list of cases and make a new one.
    blockList.push_back(block);
    block = block->splitBlock(builder.getInsertionPoint());
    builder.setInsertionPointToEnd(block);
  }

  // Create the unit case which should result in an error.
  auto *unitBlock = block->splitBlock(builder.getInsertionPoint());
  builder.setInsertionPointToEnd(unitBlock);

  // Crash the program.
  builder.create<fir::UnreachableOp>(loc);

  // Add unit case to the select statement.
  blockList.push_back(unitBlock);

  // Lower the selectOp.
  builder.setInsertionPointToEnd(startBlock);
  auto label = fir::getBase(converter.genExprValue(&expr, stmtCtx, loc));
  builder.create<fir::SelectOp>(loc, label, indexList, blockList);

  builder.setInsertionPointToEnd(endBlock);
  endBlock->addArgument(strTy, loc);
  endBlock->addArgument(lenTy, loc);

  // Handle and return the string reference and length selected by the selectOp.
  auto buff = endBlock->getArgument(0);
  auto len = endBlock->getArgument(1);

  return {buff, len, mlir::Value{}};
}

/// Generate a reference to a format string.  There are four cases - a format
/// statement label, a character format expression, an integer that holds the
/// label of a format statement, and the * case.  The first three are done here.
/// The * case is done elsewhere.
static std::tuple<mlir::Value, mlir::Value, mlir::Value>
genFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
          const Fortran::parser::Format &format, mlir::Type strTy,
          mlir::Type lenTy, Fortran::lower::StatementContext &stmtCtx) {
  if (const auto *label = std::get_if<Fortran::parser::Label>(&format.u)) {
    // format statement label
    auto eval = converter.lookupLabel(*label);
    assert(eval && "FORMAT not found in PROCEDURE");
    return lowerSourceTextAsStringLit(
        converter, loc, toStringRef(eval->position), strTy, lenTy);
  }
  const auto *pExpr = std::get_if<Fortran::parser::Expr>(&format.u);
  assert(pExpr && "missing format expression");
  auto e = Fortran::semantics::GetExpr(*pExpr);
  if (Fortran::semantics::ExprHasTypeCategory(
          *e, Fortran::common::TypeCategory::Character))
    // character expression
    return lowerStringLit(converter, loc, stmtCtx, *pExpr, strTy, lenTy);

  if (Fortran::semantics::ExprHasTypeCategory(
          *e, Fortran::common::TypeCategory::Integer) &&
      e->Rank() == 0 && Fortran::evaluate::UnwrapWholeSymbolDataRef(*e)) {
    // Treat as a scalar integer variable containing an ASSIGN label.
    return lowerReferenceAsStringSelect(converter, loc, *e, strTy, lenTy,
                                        stmtCtx);
  }

  // Legacy extension: it is possible that `*e` is not a scalar INTEGER
  // variable containing a label value. The output appears to be the source text
  // that initialized the variable? Needs more investigatation.
  TODO(loc, "io-control-spec contains a reference to a non-integer, "
            "non-scalar, or non-variable");
}

template <typename A>
std::tuple<mlir::Value, mlir::Value, mlir::Value>
getFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
          const A &stmt, mlir::Type strTy, mlir::Type lenTy,
          Fortran ::lower::StatementContext &stmtCtx) {
  if (stmt.format && !formatIsActuallyNamelist(*stmt.format))
    return genFormat(converter, loc, *stmt.format, strTy, lenTy, stmtCtx);
  return genFormat(converter, loc, *getIOControl<Fortran::parser::Format>(stmt),
                   strTy, lenTy, stmtCtx);
}
template <>
std::tuple<mlir::Value, mlir::Value, mlir::Value>
getFormat<Fortran::parser::PrintStmt>(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    const Fortran::parser::PrintStmt &stmt, mlir::Type strTy, mlir::Type lenTy,
    Fortran::lower::StatementContext &stmtCtx) {
  return genFormat(converter, loc, std::get<Fortran::parser::Format>(stmt.t),
                   strTy, lenTy, stmtCtx);
}

/// Get a buffer for an internal file data transfer.
template <typename A>
std::tuple<mlir::Value, mlir::Value>
getBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
          const A &stmt, mlir::Type strTy, mlir::Type lenTy,
          Fortran::lower::StatementContext &stmtCtx) {
  const Fortran::parser::IoUnit *iounit =
      stmt.iounit ? &*stmt.iounit : getIOControl<Fortran::parser::IoUnit>(stmt);
  if (iounit)
    if (auto *var = std::get_if<Fortran::parser::Variable>(&iounit->u))
      if (auto *expr = Fortran::semantics::GetExpr(*var))
        return genBuffer(converter, loc, *expr, strTy, lenTy, stmtCtx);
  llvm::report_fatal_error("failed to get IoUnit expr in lowering");
}

static mlir::Value genIOUnit(Fortran::lower::AbstractConverter &converter,
                             mlir::Location loc,
                             const Fortran::parser::IoUnit &iounit,
                             mlir::Type ty,
                             Fortran::lower::StatementContext &stmtCtx) {
  auto &builder = converter.getFirOpBuilder();
  if (auto *e = std::get_if<Fortran::parser::FileUnitNumber>(&iounit.u)) {
    auto ex = fir::getBase(
        converter.genExprValue(Fortran::semantics::GetExpr(*e), stmtCtx, loc));
    return builder.createConvert(loc, ty, ex);
  }
  return builder.create<mlir::arith::ConstantOp>(
      loc, builder.getIntegerAttr(ty, Fortran::runtime::io::DefaultUnit));
}

template <typename A>
mlir::Value getIOUnit(Fortran::lower::AbstractConverter &converter,
                      mlir::Location loc, const A &stmt, mlir::Type ty,
                      Fortran::lower::StatementContext &stmtCtx) {
  if (stmt.iounit)
    return genIOUnit(converter, loc, *stmt.iounit, ty, stmtCtx);
  if (auto *iounit = getIOControl<Fortran::parser::IoUnit>(stmt))
    return genIOUnit(converter, loc, *iounit, ty, stmtCtx);
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  return builder.create<mlir::arith::ConstantOp>(
      loc, builder.getIntegerAttr(ty, Fortran::runtime::io::DefaultUnit));
}

//===----------------------------------------------------------------------===//
// Generators for each IO statement type.
//===----------------------------------------------------------------------===//

template <typename K, typename S>
static mlir::Value genBasicIOStmt(Fortran::lower::AbstractConverter &converter,
                                  const S &stmt) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  Fortran::lower::StatementContext stmtCtx;
  mlir::Location loc = converter.getCurrentLocation();
  mlir::FuncOp beginFunc = getIORuntimeFunc<K>(loc, builder);
  mlir::FunctionType beginFuncTy = beginFunc.getType();
  mlir::Value unit = fir::getBase(converter.genExprValue(
      getExpr<Fortran::parser::FileUnitNumber>(stmt), stmtCtx, loc));
  mlir::Value un = builder.createConvert(loc, beginFuncTy.getInput(0), unit);
  mlir::Value file = locToFilename(converter, loc, beginFuncTy.getInput(1));
  mlir::Value line = locToLineNo(converter, loc, beginFuncTy.getInput(2));
  auto call = builder.create<fir::CallOp>(loc, beginFunc,
                                          mlir::ValueRange{un, file, line});
  mlir::Value cookie = call.getResult(0);
  ConditionSpecInfo csi;
  genConditionHandlerCall(converter, loc, cookie, stmt.v, csi);
  mlir::Value ok;
  auto insertPt = builder.saveInsertionPoint();
  threadSpecs(converter, loc, cookie, stmt.v, csi.hasErrorConditionSpec(), ok);
  builder.restoreInsertionPoint(insertPt);
  return genEndIO(converter, converter.getCurrentLocation(), cookie, csi,
                  stmtCtx);
}

mlir::Value Fortran::lower::genBackspaceStatement(
    Fortran::lower::AbstractConverter &converter,
    const Fortran::parser::BackspaceStmt &stmt) {
  return genBasicIOStmt<mkIOKey(BeginBackspace)>(converter, stmt);
}

mlir::Value Fortran::lower::genEndfileStatement(
    Fortran::lower::AbstractConverter &converter,
    const Fortran::parser::EndfileStmt &stmt) {
  return genBasicIOStmt<mkIOKey(BeginEndfile)>(converter, stmt);
}

mlir::Value
Fortran::lower::genFlushStatement(Fortran::lower::AbstractConverter &converter,
                                  const Fortran::parser::FlushStmt &stmt) {
  return genBasicIOStmt<mkIOKey(BeginFlush)>(converter, stmt);
}

mlir::Value
Fortran::lower::genRewindStatement(Fortran::lower::AbstractConverter &converter,
                                   const Fortran::parser::RewindStmt &stmt) {
  return genBasicIOStmt<mkIOKey(BeginRewind)>(converter, stmt);
}

static mlir::Value
genNewunitSpec(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
               mlir::Value cookie,
               const std::list<Fortran::parser::ConnectSpec> &specList) {
  for (const auto &spec : specList)
    if (auto *newunit =
            std::get_if<Fortran::parser::ConnectSpec::Newunit>(&spec.u)) {
      Fortran::lower::StatementContext stmtCtx;
      fir::FirOpBuilder &builder = converter.getFirOpBuilder();
      mlir::FuncOp ioFunc = getIORuntimeFunc<mkIOKey(GetNewUnit)>(loc, builder);
      mlir::FunctionType ioFuncTy = ioFunc.getType();
      const auto *var = Fortran::semantics::GetExpr(newunit->v);
      mlir::Value addr = builder.createConvert(
          loc, ioFuncTy.getInput(1),
          fir::getBase(converter.genExprAddr(var, stmtCtx, loc)));
      auto kind = builder.createIntegerConstant(loc, ioFuncTy.getInput(2),
                                                var->GetType().value().kind());
      llvm::SmallVector<mlir::Value> ioArgs = {cookie, addr, kind};
      return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
    }
  llvm_unreachable("missing Newunit spec");
}

mlir::Value
Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter,
                                 const Fortran::parser::OpenStmt &stmt) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  Fortran::lower::StatementContext stmtCtx;
  mlir::FuncOp beginFunc;
  llvm::SmallVector<mlir::Value> beginArgs;
  mlir::Location loc = converter.getCurrentLocation();
  bool hasNewunitSpec = false;
  if (hasSpec<Fortran::parser::FileUnitNumber>(stmt)) {
    beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenUnit)>(loc, builder);
    mlir::FunctionType beginFuncTy = beginFunc.getType();
    mlir::Value unit = fir::getBase(converter.genExprValue(
        getExpr<Fortran::parser::FileUnitNumber>(stmt), stmtCtx, loc));
    beginArgs.push_back(
        builder.createConvert(loc, beginFuncTy.getInput(0), unit));
    beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(1)));
    beginArgs.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(2)));
  } else {
    hasNewunitSpec = hasSpec<Fortran::parser::ConnectSpec::Newunit>(stmt);
    assert(hasNewunitSpec && "missing unit specifier");
    beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenNewUnit)>(loc, builder);
    mlir::FunctionType beginFuncTy = beginFunc.getType();
    beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(0)));
    beginArgs.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(1)));
  }
  auto cookie =
      builder.create<fir::CallOp>(loc, beginFunc, beginArgs).getResult(0);
  ConditionSpecInfo csi;
  genConditionHandlerCall(converter, loc, cookie, stmt.v, csi);
  mlir::Value ok;
  auto insertPt = builder.saveInsertionPoint();
  threadSpecs(converter, loc, cookie, stmt.v, csi.hasErrorConditionSpec(), ok);
  if (hasNewunitSpec)
    genNewunitSpec(converter, loc, cookie, stmt.v);
  builder.restoreInsertionPoint(insertPt);
  return genEndIO(converter, loc, cookie, csi, stmtCtx);
}

mlir::Value
Fortran::lower::genCloseStatement(Fortran::lower::AbstractConverter &converter,
                                  const Fortran::parser::CloseStmt &stmt) {
  return genBasicIOStmt<mkIOKey(BeginClose)>(converter, stmt);
}

mlir::Value
Fortran::lower::genWaitStatement(Fortran::lower::AbstractConverter &converter,
                                 const Fortran::parser::WaitStmt &stmt) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  Fortran::lower::StatementContext stmtCtx;
  mlir::Location loc = converter.getCurrentLocation();
  bool hasId = hasSpec<Fortran::parser::IdExpr>(stmt);
  mlir::FuncOp beginFunc =
      hasId ? getIORuntimeFunc<mkIOKey(BeginWait)>(loc, builder)
            : getIORuntimeFunc<mkIOKey(BeginWaitAll)>(loc, builder);
  mlir::FunctionType beginFuncTy = beginFunc.getType();
  mlir::Value unit = fir::getBase(converter.genExprValue(
      getExpr<Fortran::parser::FileUnitNumber>(stmt), stmtCtx, loc));
  mlir::Value un = builder.createConvert(loc, beginFuncTy.getInput(0), unit);
  llvm::SmallVector<mlir::Value> args{un};
  if (hasId) {
    mlir::Value id = fir::getBase(converter.genExprValue(
        getExpr<Fortran::parser::IdExpr>(stmt), stmtCtx, loc));
    args.push_back(builder.createConvert(loc, beginFuncTy.getInput(1), id));
  }
  auto cookie = builder.create<fir::CallOp>(loc, beginFunc, args).getResult(0);
  ConditionSpecInfo csi;
  genConditionHandlerCall(converter, loc, cookie, stmt.v, csi);
  return genEndIO(converter, converter.getCurrentLocation(), cookie, csi,
                  stmtCtx);
}

//===----------------------------------------------------------------------===//
// Data transfer statements.
//
// There are several dimensions to the API with regard to data transfer
// statements that need to be considered.
//
//   - input (READ) vs. output (WRITE, PRINT)
//   - unformatted vs. formatted vs. list vs. namelist
//   - synchronous vs. asynchronous
//   - external vs. internal
//===----------------------------------------------------------------------===//

// Get the begin data transfer IO function to call for the given values.
template <bool isInput>
mlir::FuncOp
getBeginDataTransferFunc(mlir::Location loc, fir::FirOpBuilder &builder,
                         bool isFormatted, bool isListOrNml, bool isInternal,
                         bool isInternalWithDesc, bool isAsync) {
  if constexpr (isInput) {
    if (isAsync)
      return getIORuntimeFunc<mkIOKey(BeginAsynchronousInput)>(loc, builder);
    if (isFormatted || isListOrNml) {
      if (isInternal) {
        if (isInternalWithDesc) {
          if (isListOrNml)
            return getIORuntimeFunc<mkIOKey(BeginInternalArrayListInput)>(
                loc, builder);
          return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedInput)>(
              loc, builder);
        }
        if (isListOrNml)
          return getIORuntimeFunc<mkIOKey(BeginInternalListInput)>(loc,
                                                                   builder);
        return getIORuntimeFunc<mkIOKey(BeginInternalFormattedInput)>(loc,
                                                                      builder);
      }
      if (isListOrNml)
        return getIORuntimeFunc<mkIOKey(BeginExternalListInput)>(loc, builder);
      return getIORuntimeFunc<mkIOKey(BeginExternalFormattedInput)>(loc,
                                                                    builder);
    }
    return getIORuntimeFunc<mkIOKey(BeginUnformattedInput)>(loc, builder);
  } else {
    if (isAsync)
      return getIORuntimeFunc<mkIOKey(BeginAsynchronousOutput)>(loc, builder);
    if (isFormatted || isListOrNml) {
      if (isInternal) {
        if (isInternalWithDesc) {
          if (isListOrNml)
            return getIORuntimeFunc<mkIOKey(BeginInternalArrayListOutput)>(
                loc, builder);
          return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedOutput)>(
              loc, builder);
        }
        if (isListOrNml)
          return getIORuntimeFunc<mkIOKey(BeginInternalListOutput)>(loc,
                                                                    builder);
        return getIORuntimeFunc<mkIOKey(BeginInternalFormattedOutput)>(loc,
                                                                       builder);
      }
      if (isListOrNml)
        return getIORuntimeFunc<mkIOKey(BeginExternalListOutput)>(loc, builder);
      return getIORuntimeFunc<mkIOKey(BeginExternalFormattedOutput)>(loc,
                                                                     builder);
    }
    return getIORuntimeFunc<mkIOKey(BeginUnformattedOutput)>(loc, builder);
  }
}

/// Generate the arguments of a begin data transfer statement call.
template <bool hasIOCtrl, typename A>
void genBeginDataTransferCallArgs(
    llvm::SmallVectorImpl<mlir::Value> &ioArgs,
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    const A &stmt, mlir::FunctionType ioFuncTy, bool isFormatted,
    bool isListOrNml, [[maybe_unused]] bool isInternal,
    [[maybe_unused]] bool isAsync,
    const llvm::Optional<fir::ExtendedValue> &descRef,
    Fortran::lower::StatementContext &stmtCtx) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  auto maybeGetFormatArgs = [&]() {
    if (!isFormatted || isListOrNml)
      return;
    auto pair =
        getFormat(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()),
                  ioFuncTy.getInput(ioArgs.size() + 1), stmtCtx);
    ioArgs.push_back(std::get<0>(pair)); // format character string
    ioArgs.push_back(std::get<1>(pair)); // format length
  };
  if constexpr (hasIOCtrl) { // READ or WRITE
    if (isInternal) {
      // descriptor or scalar variable; maybe explicit format; scratch area
      if (descRef.hasValue()) {
        mlir::Value desc = builder.createBox(loc, *descRef);
        ioArgs.push_back(
            builder.createConvert(loc, ioFuncTy.getInput(ioArgs.size()), desc));
      } else {
        std::tuple<mlir::Value, mlir::Value> pair =
            getBuffer(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()),
                      ioFuncTy.getInput(ioArgs.size() + 1), stmtCtx);
        ioArgs.push_back(std::get<0>(pair)); // scalar character variable
        ioArgs.push_back(std::get<1>(pair)); // character length
      }
      maybeGetFormatArgs();
      ioArgs.push_back( // internal scratch area buffer
          getDefaultScratch(builder, loc, ioFuncTy.getInput(ioArgs.size())));
      ioArgs.push_back( // buffer length
          getDefaultScratchLen(builder, loc, ioFuncTy.getInput(ioArgs.size())));
    } else if (isAsync) { // unit; REC; buffer and length
      ioArgs.push_back(getIOUnit(converter, loc, stmt,
                                 ioFuncTy.getInput(ioArgs.size()), stmtCtx));
      TODO(loc, "asynchronous");
    } else { // external IO - maybe explicit format; unit
      maybeGetFormatArgs();
      ioArgs.push_back(getIOUnit(converter, loc, stmt,
                                 ioFuncTy.getInput(ioArgs.size()), stmtCtx));
    }
  } else { // PRINT - maybe explicit format; default unit
    maybeGetFormatArgs();
    ioArgs.push_back(builder.create<mlir::arith::ConstantOp>(
        loc, builder.getIntegerAttr(ioFuncTy.getInput(ioArgs.size()),
                                    Fortran::runtime::io::DefaultUnit)));
  }
  // File name and line number are always the last two arguments.
  ioArgs.push_back(
      locToFilename(converter, loc, ioFuncTy.getInput(ioArgs.size())));
  ioArgs.push_back(
      locToLineNo(converter, loc, ioFuncTy.getInput(ioArgs.size())));
}

template <bool isInput, bool hasIOCtrl = true, typename A>
static mlir::Value
genDataTransferStmt(Fortran::lower::AbstractConverter &converter,
                    const A &stmt) {
  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
  Fortran::lower::StatementContext stmtCtx;
  mlir::Location loc = converter.getCurrentLocation();
  const bool isFormatted = isDataTransferFormatted(stmt);
  const bool isList = isFormatted ? isDataTransferList(stmt) : false;
  const bool isInternal = isDataTransferInternal(stmt);
  llvm::Optional<fir::ExtendedValue> descRef =
      isInternal ? maybeGetInternalIODescriptor(converter, stmt, stmtCtx)
                 : llvm::None;
  const bool isInternalWithDesc = descRef.hasValue();
  const bool isAsync = isDataTransferAsynchronous(loc, stmt);
  const bool isNml = isDataTransferNamelist(stmt);

  // Generate the begin data transfer function call.
  mlir::FuncOp ioFunc = getBeginDataTransferFunc<isInput>(
      loc, builder, isFormatted, isList || isNml, isInternal,
      isInternalWithDesc, isAsync);
  llvm::SmallVector<mlir::Value> ioArgs;
  genBeginDataTransferCallArgs<hasIOCtrl>(
      ioArgs, converter, loc, stmt, ioFunc.getType(), isFormatted,
      isList || isNml, isInternal, isAsync, descRef, stmtCtx);
  mlir::Value cookie =
      builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);

  // Generate an EnableHandlers call and remaining specifier calls.
  ConditionSpecInfo csi;
  auto insertPt = builder.saveInsertionPoint();
  mlir::Value ok;
  if constexpr (hasIOCtrl) {
    genConditionHandlerCall(converter, loc, cookie, stmt.controls, csi);
    threadSpecs(converter, loc, cookie, stmt.controls,
                csi.hasErrorConditionSpec(), ok);
  }

  // Generate data transfer list calls.
  if constexpr (isInput) { // READ
    if (isNml)
      genNamelistIO(converter, cookie,
                    getIORuntimeFunc<mkIOKey(InputNamelist)>(loc, builder),
                    *getIOControl<Fortran::parser::Name>(stmt)->symbol,
                    csi.hasTransferConditionSpec(), ok, stmtCtx);
    else
      genInputItemList(converter, cookie, stmt.items, isFormatted,
                       csi.hasTransferConditionSpec(), ok, /*inLoop=*/false,
                       stmtCtx);
  } else if constexpr (std::is_same_v<A, Fortran::parser::WriteStmt>) {
    if (isNml)
      genNamelistIO(converter, cookie,
                    getIORuntimeFunc<mkIOKey(OutputNamelist)>(loc, builder),
                    *getIOControl<Fortran::parser::Name>(stmt)->symbol,
                    csi.hasTransferConditionSpec(), ok, stmtCtx);
    else
      genOutputItemList(converter, cookie, stmt.items, isFormatted,
                        csi.hasTransferConditionSpec(), ok,
                        /*inLoop=*/false, stmtCtx);
  } else { // PRINT
    genOutputItemList(converter, cookie, std::get<1>(stmt.t), isFormatted,
                      csi.hasTransferConditionSpec(), ok,
                      /*inLoop=*/false, stmtCtx);
  }
  stmtCtx.finalize();

  builder.restoreInsertionPoint(insertPt);
  if constexpr (hasIOCtrl) {
    genIOReadSize(converter, loc, cookie, stmt.controls,
                  csi.hasErrorConditionSpec());
  }
  // Generate end statement call/s.
  return genEndIO(converter, loc, cookie, csi, stmtCtx);
}

void Fortran::lower::genPrintStatement(
    Fortran::lower::AbstractConverter &converter,
    const Fortran::parser::PrintStmt &stmt) {
  // PRINT does not take an io-control-spec. It only has a format specifier, so
  // it is a simplified case of WRITE.
  genDataTransferStmt</*isInput=*/false, /*ioCtrl=*/false>(converter, stmt);
}

mlir::Value
Fortran::lower::genWriteStatement(Fortran::lower::AbstractConverter &converter,
                                  const Fortran::parser::WriteStmt &stmt) {
  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 width = eleTy.cast<mlir::IntegerType>().getWidth();
  mlir::IndexType idxTy = builder.getIndexType();
  mlir::Value kind = builder.createIntegerConstant(loc, idxTy, width / 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));
  auto call = builder.create<fir::CallOp>(loc, specFunc, args);
  boolRefToLogical(loc, builder, addr);
  return call.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);
}