//===-- 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/Bridge.h"
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/PFTBuilder.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/Support/Utils.h"
#include "flang/Lower/Todo.h"
#include "flang/Optimizer/Builder/BoxValue.h"
#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/Complex.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/MutableBox.h"
#include "flang/Optimizer/Builder/Runtime/RTBuilder.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();
}

/// 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;
    }
    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;
      if (auto desc =
              builder.getNamedGlobal(converter.mangleName(s) + ".desc")) {
        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);
#ifdef __SIZEOF_INT128__
    case 128:
      return getIORuntimeFunc<mkIOKey(OutputInteger128)>(loc, builder);
#endif
    }
    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);
  }
  if (auto ty = type.dyn_cast<fir::ComplexType>()) {
    if (auto kind = ty.getFKind(); kind == 4)
      return getIORuntimeFunc<mkIOKey(OutputComplex32)>(loc, builder);
    else if (kind == 8)
      return getIORuntimeFunc<mkIOKey(OutputComplex64)>(loc, builder);
  }
  if (type.isa<fir::LogicalType>())
    return getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder);
  if (fir::factory::CharacterExprHelper::isCharacterScalar(type))
    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);
  }
  if (auto ty = type.dyn_cast<fir::ComplexType>()) {
    if (auto kind = ty.getFKind(); kind <= 4)
      return getIORuntimeFunc<mkIOKey(InputComplex32)>(loc, builder);
    else if (kind <= 8)
      return getIORuntimeFunc<mkIOKey(InputComplex64)>(loc, builder);
  }
  if (type.isa<fir::LogicalType>())
    return getIORuntimeFunc<mkIOKey(InputLogical)>(loc, builder);
  if (fir::factory::CharacterExprHelper::isCharacterScalar(type))
    return getIORuntimeFunc<mkIOKey(InputAscii)>(loc, builder);
  return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder);
}

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)));
    }
  }
  return builder.create<fir::CallOp>(loc, inputFunc, inputFuncArgs)
      .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)) {
      TODO(loc, "genInputItemList with VectorSubscript");
    }
    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();
       isa<fir::IfOp>(op); op = op->getBlock()->getParentOp()) {
    auto ifOp = 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::ConnectSpec::Newunit>(
    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
    mlir::Value cookie, const Fortran::parser::ConnectSpec::Newunit &spec) {
  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(spec);
  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);
}

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

/// 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 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));
}

//===----------------------------------------------------------------------===//
// 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);
}