[flang] upstream of CHARACTER helper and runtime lowering

[schweitz]

Summary

This patch upstreams files used by the lowering of CHARACTER type expressions. There is a builder helper class as well as some code to interface to the Fortran runtime.

Included in this diff are the files Bridge.h and IntrinsicCall.h. The implementations for these interfaces will be upstreamed in a subsequent diff.

Also included are a number of small patches to sources that have already been upstreamed. These changes are to keep those files in synch with active development, upstream bug fixes, and to allow builds of these sources to continue to be successful. All these changes underwent review at https://github.com/flang-compiler/f18-llvm-project

flang/include/flang/Lower/Bridge.h

+//===-- Lower/Bridge.h -- main interface to lowering ------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+///
+/// \file
+/// Implements lowering. Convert Fortran source to
+/// [MLIR](https://github.com/tensorflow/mlir).
+///
+/// [Coding style](https://llvm.org/docs/CodingStandards.html)
+///
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_BRIDGE_H
+#define FORTRAN_LOWER_BRIDGE_H
+
+#include "flang/Common/Fortran.h"
+#include "flang/Lower/AbstractConverter.h"
+#include "flang/Optimizer/Support/KindMapping.h"
+#include "mlir/IR/Module.h"
+
+namespace fir {
+struct NameUniquer;
+}
+
+namespace Fortran {
+namespace common {
+class IntrinsicTypeDefaultKinds;
+} // namespace common
+namespace evaluate {
+class IntrinsicProcTable;
+} // namespace evaluate
+namespace parser {
+class CookedSource;
+struct Program;
+} // namespace parser
+namespace semantics {
+class SemanticsContext;
+} // namespace semantics
+
+namespace lower {
+
+//===----------------------------------------------------------------------===//
+// Lowering bridge
+//===----------------------------------------------------------------------===//
+
+/// The lowering bridge converts the front-end parse trees and semantics
+/// checking residual to MLIR (FIR dialect) code.
+class LoweringBridge {
+public:
+  /// Create a lowering bridge instance.
+  static LoweringBridge
+  create(const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds,
+         const Fortran::evaluate::IntrinsicProcTable &intrinsics,
+         const Fortran::parser::CookedSource &cooked) {
+    return LoweringBridge{defaultKinds, intrinsics, cooked};
+  }
+
+  //===--------------------------------------------------------------------===//
+  // Getters
+  //===--------------------------------------------------------------------===//
+
+  mlir::MLIRContext &getMLIRContext() { return *context.get(); }
+  mlir::ModuleOp &getModule() { return *module.get(); }
+  const Fortran::common::IntrinsicTypeDefaultKinds &getDefaultKinds() const {
+    return defaultKinds;
+  }
+  const Fortran::evaluate::IntrinsicProcTable &getIntrinsicTable() const {
+    return intrinsics;
+  }
+  const Fortran::parser::CookedSource *getCookedSource() const {
+    return cooked;
+  }
+
+  /// Get the kind map.
+  const fir::KindMapping &getKindMap() const { return kindMap; }
+
+  /// Create a folding context. Careful: this is very expensive.
+  Fortran::evaluate::FoldingContext createFoldingContext() const;
+
+  bool validModule() { return getModule(); }
+
+  //===--------------------------------------------------------------------===//
+  // Perform the creation of an mlir::ModuleOp
+  //===--------------------------------------------------------------------===//
+
+  /// Read in an MLIR input file rather than lowering Fortran sources.
+  /// This is intended to be used for testing.
+  void parseSourceFile(llvm::SourceMgr &);
+
+  /// Cross the bridge from the Fortran parse-tree, etc. to MLIR dialects
+  void lower(const Fortran::parser::Program &program, fir::NameUniquer &uniquer,
+             const Fortran::semantics::SemanticsContext &semanticsContext);
+
+private:
+  explicit LoweringBridge(
+      const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds,
+      const Fortran::evaluate::IntrinsicProcTable &intrinsics,
+      const Fortran::parser::CookedSource &cooked);
+  LoweringBridge() = delete;
+  LoweringBridge(const LoweringBridge &) = delete;
+
+  const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds;
+  const Fortran::evaluate::IntrinsicProcTable &intrinsics;
+  const Fortran::parser::CookedSource *cooked;
+  std::unique_ptr<mlir::MLIRContext> context;
+  std::unique_ptr<mlir::ModuleOp> module;
+  fir::KindMapping kindMap;
+};
+
+} // namespace lower
+} // namespace Fortran
+
+#endif // FORTRAN_LOWER_BRIDGE_H

flang/include/flang/Lower/CharacterExpr.h

+//===-- Lower/CharacterExpr.h -- lowering of characters ---------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_CHARACTEREXPR_H
+#define FORTRAN_LOWER_CHARACTEREXPR_H
+
+#include "flang/Lower/FIRBuilder.h"
+#include "flang/Lower/Support/BoxValue.h"
+
+namespace Fortran::lower {
+
+/// Helper to facilitate lowering of CHARACTER in FIR.
+class CharacterExprHelper {
+public:
+  /// Constructor.
+  explicit CharacterExprHelper(FirOpBuilder &builder, mlir::Location loc)
+      : builder{builder}, loc{loc} {}
+  CharacterExprHelper(const CharacterExprHelper &) = delete;
+
+  /// Unless otherwise stated, all mlir::Value inputs of these pseudo-fir ops
+  /// must be of type:
+  /// - fir.boxchar<kind> (dynamic length character),
+  /// - fir.ref<fir.array<len x fir.char<kind>>> (character with compile time
+  ///      constant length),
+  /// - fir.array<len x fir.char<kind>> (compile time constant character)
+
+  /// Copy the \p count first characters of \p src into \p dest.
+  /// \p count can have any integer type.
+  void createCopy(mlir::Value dest, mlir::Value src, mlir::Value count);
+
+  /// Set characters of \p str at position [\p lower, \p upper) to blanks.
+  /// \p lower and \upper bounds are zero based.
+  /// If \p upper <= \p lower, no padding is done.
+  /// \p upper and \p lower can have any integer type.
+  void createPadding(mlir::Value str, mlir::Value lower, mlir::Value upper);
+
+  /// Create str(lb:ub), lower bounds must always be specified, upper
+  /// bound is optional.
+  mlir::Value createSubstring(mlir::Value str,
+                              llvm::ArrayRef<mlir::Value> bounds);
+
+  /// Return blank character of given \p type !fir.char<kind>
+  mlir::Value createBlankConstant(fir::CharacterType type);
+
+  /// Lower \p lhs = \p rhs where \p lhs and \p rhs are scalar characters.
+  /// It handles cases where \p lhs and \p rhs may overlap.
+  void createAssign(mlir::Value lhs, mlir::Value rhs);
+
+  /// Lower an assignment where the buffer and LEN parameter are known and do
+  /// not need to be unboxed.
+  void createAssign(mlir::Value lptr, mlir::Value llen, mlir::Value rptr,
+                    mlir::Value rlen);
+
+  /// Create lhs // rhs in temp obtained with fir.alloca
+  mlir::Value createConcatenate(mlir::Value lhs, mlir::Value rhs);
+
+  /// LEN_TRIM intrinsic.
+  mlir::Value createLenTrim(mlir::Value str);
+
+  /// Embox \p addr and \p len and return fir.boxchar.
+  /// Take care of type conversions before emboxing.
+  /// \p len is converted to the integer type for character lengths if needed.
+  mlir::Value createEmboxChar(mlir::Value addr, mlir::Value len);
+
+  /// Unbox \p boxchar into (fir.ref<fir.char<kind>>, getLengthType()).
+  std::pair<mlir::Value, mlir::Value> createUnboxChar(mlir::Value boxChar);
+
+  /// Allocate a temp of fir::CharacterType type and length len.
+  /// Returns related fir.ref<fir.char<kind>>.
+  mlir::Value createCharacterTemp(mlir::Type type, mlir::Value len);
+
+  /// Allocate a temp of compile time constant length.
+  /// Returns related fir.ref<fir.array<len x fir.char<kind>>>.
+  mlir::Value createCharacterTemp(mlir::Type type, int len) {
+    return createTemp(type, len);
+  }
+
+  /// Return buffer/length pair of character str, if str is a constant,
+  /// it is allocated into a temp, otherwise, its memory reference is
+  /// returned as the buffer.
+  /// The buffer type of str is of type:
+  ///   - fir.ref<fir.array<len x fir.char<kind>>> if str has compile time
+  ///      constant length.
+  ///   - fir.ref<fir.char<kind>> if str has dynamic length.
+  std::pair<mlir::Value, mlir::Value> materializeCharacter(mlir::Value str);
+
+  /// Return true if \p type is a character literal type (is
+  /// fir.array<len x fir.char<kind>>).;
+  static bool isCharacterLiteral(mlir::Type type);
+
+  /// Return true if \p type is one of the following type
+  /// - fir.boxchar<kind>
+  /// - fir.ref<fir.array<len x fir.char<kind>>>
+  /// - fir.array<len x fir.char<kind>>
+  static bool isCharacter(mlir::Type type);
+
+  /// Extract the kind of a character type
+  static int getCharacterKind(mlir::Type type);
+
+  /// Return the integer type that must be used to manipulate
+  /// Character lengths. TODO: move this to FirOpBuilder?
+  mlir::Type getLengthType() { return builder.getIndexType(); }
+
+private:
+  fir::CharBoxValue materializeValue(const fir::CharBoxValue &str);
+  fir::CharBoxValue toDataLengthPair(mlir::Value character);
+  mlir::Type getReferenceType(const fir::CharBoxValue &c) const;
+  mlir::Value createEmbox(const fir::CharBoxValue &str);
+  mlir::Value createLoadCharAt(const fir::CharBoxValue &str, mlir::Value index);
+  void createStoreCharAt(const fir::CharBoxValue &str, mlir::Value index,
+                         mlir::Value c);
+  void createCopy(const fir::CharBoxValue &dest, const fir::CharBoxValue &src,
+                  mlir::Value count);
+  void createPadding(const fir::CharBoxValue &str, mlir::Value lower,
+                     mlir::Value upper);
+  fir::CharBoxValue createTemp(mlir::Type type, mlir::Value len);
+  void createLengthOneAssign(const fir::CharBoxValue &lhs,
+                             const fir::CharBoxValue &rhs);
+  void createAssign(const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs);
+  fir::CharBoxValue createConcatenate(const fir::CharBoxValue &lhs,
+                                      const fir::CharBoxValue &rhs);
+  fir::CharBoxValue createSubstring(const fir::CharBoxValue &str,
+                                    llvm::ArrayRef<mlir::Value> bounds);
+  mlir::Value createLenTrim(const fir::CharBoxValue &str);
+  mlir::Value createTemp(mlir::Type type, int len);
+  mlir::Value createBlankConstantCode(fir::CharacterType type);
+
+private:
+  FirOpBuilder &builder;
+  mlir::Location loc;
+};
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_CHARACTEREXPR_H

flang/include/flang/Lower/CharacterRuntime.h

+//===-- Lower/CharacterRuntime.h -- lower CHARACTER operations --*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_CHARACTERRUNTIME_H
+#define FORTRAN_LOWER_CHARACTERRUNTIME_H
+
+#include "mlir/Dialect/StandardOps/IR/Ops.h"
+
+namespace Fortran {
+namespace lower {
+class AbstractConverter;
+
+/// Generate call to a character comparison for two ssa-values of type
+/// `boxchar`.
+mlir::Value genBoxCharCompare(AbstractConverter &converter, mlir::Location loc,
+                              mlir::CmpIPredicate cmp, mlir::Value lhs,
+                              mlir::Value rhs);
+
+/// Generate call to a character comparison op for two unboxed variables. There
+/// are 4 arguments, 2 for the lhs and 2 for the rhs. Each CHARACTER must pass a
+/// reference to its buffer (`ref<char<K>>`) and its LEN type parameter (some
+/// integral type).
+mlir::Value genRawCharCompare(AbstractConverter &converter, mlir::Location loc,
+                              mlir::CmpIPredicate cmp, mlir::Value lhsBuff,
+                              mlir::Value lhsLen, mlir::Value rhsBuff,
+                              mlir::Value rhsLen);
+
+} // namespace lower
+} // namespace Fortran
+
+#endif // FORTRAN_LOWER_CHARACTERRUNTIME_H

flang/include/flang/Lower/FIRBuilder.h

mlir::Value convertWithSemantics(mlir::Location loc, mlir::Type toTy,
                                    mlir::Value val);
 
   /// Get the entry block of the current Function
   mlir::Block *getEntryBlock() { return &getFunction().front(); }
 
   /// Safely create a reference type to the type `eleTy`.
   mlir::Type getRefType(mlir::Type eleTy);
 
+  /// Create a null constant of type RefType and value 0. Need to pass in the
+  /// Location information.
+  mlir::Value createNullConstant(mlir::Location loc);
+
   /// Create an integer constant of type \p type and value \p i.
   mlir::Value createIntegerConstant(mlir::Location loc, mlir::Type integerType,
                                     std::int64_t i);
 
   mlir::Value createRealConstant(mlir::Location loc, mlir::Type realType,
                                  const llvm::APFloat &val);
   /// Create a real constant of type \p realType with a value zero.
   mlir::Value createRealZeroConstant(mlir::Location loc, mlir::Type realType);

flang/include/flang/Lower/IntrinsicCall.h

+//===-- Lower/IntrinsicCall.h -- lowering of intrinsics ---------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_INTRINSICCALL_H
+#define FORTRAN_LOWER_INTRINSICCALL_H
+
+#include "flang/Lower/FIRBuilder.h"
+
+namespace fir {
+class ExtendedValue;
+}
+
+namespace Fortran::lower {
+
+// TODO: Expose interface to get specific intrinsic function address.
+// TODO: Handle intrinsic subroutine.
+// TODO: Intrinsics that do not require their arguments to be defined
+//   (e.g shape inquiries) might not fit in the current interface that
+//   requires mlir::Value to be provided.
+// TODO: Error handling interface ?
+// TODO: Implementation is incomplete. Many intrinsics to tbd.
+
+/// Helper for building calls to intrinsic functions in the runtime support
+/// libraries.
+class IntrinsicCallOpsHelper {
+public:
+  explicit IntrinsicCallOpsHelper(FirOpBuilder &builder, mlir::Location loc)
+      : builder(builder), loc(loc) {}
+  IntrinsicCallOpsHelper(const IntrinsicCallOpsHelper &) = delete;
+
+  /// Generate the FIR+MLIR operations for the generic intrinsic \p name
+  /// with arguments \p args and expected result type \p resultType.
+  /// Returned mlir::Value is the returned Fortran intrinsic value.
+  fir::ExtendedValue genIntrinsicCall(llvm::StringRef name,
+                                      mlir::Type resultType,
+                                      llvm::ArrayRef<fir::ExtendedValue> args);
+
+  //===--------------------------------------------------------------------===//
+  // Direct access to intrinsics that may be used by lowering outside
+  // of intrinsic call lowering.
+  //===--------------------------------------------------------------------===//
+
+  /// Generate maximum. There must be at least one argument and all arguments
+  /// must have the same type.
+  mlir::Value genMax(llvm::ArrayRef<mlir::Value> args);
+
+  /// Generate minimum. Same constraints as genMax.
+  mlir::Value genMin(llvm::ArrayRef<mlir::Value> args);
+
+  /// Generate power function x**y with given the expected
+  /// result type.
+  mlir::Value genPow(mlir::Type resultType, mlir::Value x, mlir::Value y);
+
+private:
+  FirOpBuilder &builder;
+  mlir::Location loc;
+};
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_INTRINSICCALL_H

flang/include/flang/Lower/PFTBuilder.h

struct Evaluation : EvaluationVariant {
   constexpr bool isConstruct() const {
     return visit(common::visitors{
         [](auto &r) { return pft::isConstruct<std::decay_t<decltype(r)>>; }});
   }
   constexpr bool isDirective() const {
     return visit(common::visitors{
         [](auto &r) { return pft::isDirective<std::decay_t<decltype(r)>>; }});
   }
+  constexpr bool isNopConstructStmt() const {
+    return visit(common::visitors{[](auto &r) {
+      return pft::isNopConstructStmt<std::decay_t<decltype(r)>>;
+    }});
+  }
+
   /// Return the predicate:  "This is a non-initial, non-terminal construct
   /// statement."  For an IfConstruct, this is ElseIfStmt and ElseStmt.
   constexpr bool isIntermediateConstructStmt() const {
     return visit(common::visitors{[](auto &r) {
       return pft::isIntermediateConstructStmt<std::decay_t<decltype(r)>>;
     }});
   }
-  constexpr bool isNopConstructStmt() const {
-    return visit(common::visitors{[](auto &r) {
-      return pft::isNopConstructStmt<std::decay_t<decltype(r)>>;
-    }});
+
+  /// Return the first non-nop successor of an evaluation, possibly exiting
+  /// from one or more enclosing constructs.
+  Evaluation &nonNopSuccessor() const {
+    Evaluation *successor = lexicalSuccessor;
+    if (successor && successor->isNopConstructStmt()) {
+      successor = successor->parentConstruct->constructExit;
+    }
+    assert(successor && "missing successor");
+    return *successor;
+  }
+
+  /// Return true if this Evaluation has at least one nested evaluation.
+  bool hasNestedEvaluations() const {
+    return evaluationList && !evaluationList->empty();
+  }
+
+  /// Return nested evaluation list.
+  EvaluationList &getNestedEvaluations() {
+    assert(evaluationList && "no nested evaluations");
+    return *evaluationList;
+  }
+
+  Evaluation &getFirstNestedEvaluation() {
+    assert(hasNestedEvaluations() && "no nested evaluations");
+    return evaluationList->front();
+  }
+
+  Evaluation &getLastNestedEvaluation() {
+    assert(hasNestedEvaluations() && "no nested evaluations");
+    return evaluationList->back();
   }
 
-  /// Return FunctionLikeUnit to which this evaluation
-  /// belongs. Nullptr if it does not belong to such unit.
+  /// Return the FunctionLikeUnit containing this evaluation (or nullptr).
   FunctionLikeUnit *getOwningProcedure() const;
 
   bool lowerAsStructured() const;
   bool lowerAsUnstructured() const;
 
   // FIR generation looks primarily at PFT statement (leaf) nodes.  So members
   // such as lexicalSuccessor and the various block fields are only applicable
   // to statement nodes.  One exception is that an internal construct node is
struct Evaluation : EvaluationVariant {
   parser::CharBlock position{};
   std::optional<parser::Label> label{};
   std::unique_ptr<EvaluationList> evaluationList; // nested evaluations
   Evaluation *parentConstruct{nullptr};  // set for nodes below the top level
   Evaluation *lexicalSuccessor{nullptr}; // set for ActionStmt, ConstructStmt
   Evaluation *controlSuccessor{nullptr}; // set for some statements
   Evaluation *constructExit{nullptr};    // set for constructs
   bool isNewBlock{false};                // evaluation begins a new basic block
-  bool isUnstructured{false};        // evaluation has unstructured control flow
-  bool skip{false};                  // evaluation has been processed in advance
-  class mlir::Block *block{nullptr}; // isNewBlock block
+  bool isUnstructured{false};  // evaluation has unstructured control flow
+  bool skip{false};            // evaluation has been processed in advance
+  mlir::Block *block{nullptr}; // isNewBlock block
   llvm::SmallVector<mlir::Block *, 1> localBlocks{}; // construct local blocks
   int printIndex{0}; // (ActionStmt, ConstructStmt) evaluation index for dumps
 };
 
 using ProgramVariant =
     ReferenceVariant<parser::MainProgram, parser::FunctionSubprogram,
                      parser::SubroutineSubprogram, parser::Module,
                      parser::Submodule, parser::SeparateModuleSubprogram,

 /// known to be very large may be transformed into a heap allocated entity by
 /// lowering. That decision would be tracked in its Variable instance.
 struct Variable {
   explicit Variable(const Fortran::semantics::Symbol &sym, bool global = false,
                     int depth = 0)
       : sym{&sym}, depth{depth}, global{global} {}
 
   const Fortran::semantics::Symbol &getSymbol() const { return *sym; }
-  
   bool isGlobal() const { return global; }
   bool isHeapAlloc() const { return heapAlloc; }
   bool isPointer() const { return pointer; }
   bool isTarget() const { return target; }
   int getDepth() const { return depth; }
-  
   void setHeapAlloc(bool to = true) { heapAlloc = to; }
   void setPointer(bool to = true) { pointer = to; }
   void setTarget(bool to = true) { target = to; }
 
 private:
   const Fortran::semantics::Symbol *sym;
   int depth;
   bool global;

flang/include/flang/Lower/Support/BoxValue.h

 //===-- Lower/Support/BoxValue.h -- internal box values ---------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef LOWER_SUPPORT_BOXVALUE_H
 #define LOWER_SUPPORT_BOXVALUE_H
 
 #include "mlir/IR/Value.h"
 #include "llvm/ADT/SmallVector.h"
+#include "llvm/Support/Compiler.h"
 #include "llvm/Support/raw_ostream.h"
 #include <utility>
 #include <variant>
 
 namespace fir {
 class CharBoxValue;
 class ArrayBoxValue;
 class CharArrayBoxValue;
public:
 
   CharBoxValue clone(mlir::Value newBase) const { return {newBase, len}; }
 
   mlir::Value getLen() const { return len; }
   mlir::Value getBuffer() const { return getAddr(); }
 
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
                                        const CharBoxValue &);
-  void dump() const { llvm::errs() << *this; }
+  LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this; }
 
 protected:
   mlir::Value len;
 };
 
 /// Abstract base class.
 /// Expressions of type array have at minimum a shape. These expressions may
 /// have lbound attributes (dynamic values) that affect the interpretation of
ArrayBoxValue(mlir::Value addr, llvm::ArrayRef<mlir::Value> extents,
       : AbstractBox{addr}, AbstractArrayBox{extents, lbounds} {}
 
   ArrayBoxValue clone(mlir::Value newBase) const {
     return {newBase, extents, lbounds};
   }
 
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
                                        const ArrayBoxValue &);
-  void dump() const { operator<<(llvm::errs(), *this); }
+  LLVM_DUMP_METHOD void dump() const { operator<<(llvm::errs(), *this); }
 };
 
 /// Expressions of type CHARACTER and with rank > 0.
 class CharArrayBoxValue : public CharBoxValue, public AbstractArrayBox {
 public:
   CharArrayBoxValue(mlir::Value addr, mlir::Value len,
                     llvm::ArrayRef<mlir::Value> extents,
                     llvm::ArrayRef<mlir::Value> lbounds = {})
       : CharBoxValue{addr, len}, AbstractArrayBox{extents, lbounds} {}
 
   CharArrayBoxValue clone(mlir::Value newBase) const {
     return {newBase, len, extents, lbounds};
   }
 
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
                                        const CharArrayBoxValue &);
-  void dump() const { operator<<(llvm::errs(), *this); }
+  LLVM_DUMP_METHOD void dump() const { operator<<(llvm::errs(), *this); }
 };
 
 /// Expressions that are procedure POINTERs may need a set of references to
 /// variables in the host scope.
 class ProcBoxValue : public AbstractBox {
 public:
   ProcBoxValue(mlir::Value addr, mlir::Value context)
       : AbstractBox{addr}, hostContext{context} {}
 
   ProcBoxValue clone(mlir::Value newBase) const {
     return {newBase, hostContext};
   }
 
   mlir::Value getHostContext() const { return hostContext; }
 
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
                                        const ProcBoxValue &);
-  void dump() const { operator<<(llvm::errs(), *this); }
+  LLVM_DUMP_METHOD void dump() const { operator<<(llvm::errs(), *this); }
 
 protected:
   mlir::Value hostContext;
 };
 
 /// In the generalized form, a boxed value can have a dynamic size, be an array
 /// with dynamic extents and lbounds, and take dynamic type parameters.
 class BoxValue : public AbstractBox, public AbstractArrayBox {
public:
   }
 
   mlir::Value getLen() const { return len; }
   const llvm::SmallVectorImpl<mlir::Value> &getLenTypeParams() const {
     return params;
   }
 
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const BoxValue &);
-  void dump() const { operator<<(llvm::errs(), *this); }
+  LLVM_DUMP_METHOD void dump() const { operator<<(llvm::errs(), *this); }
 
 protected:
   mlir::Value len;
   llvm::SmallVector<mlir::Value, 2> params;
 };
 
 /// Used for triple notation (array slices)
 using RangeBoxValue = std::tuple<mlir::Value, mlir::Value, mlir::Value>;
constexpr const CharBoxValue *getCharBox() const {
     return std::get_if<CharBoxValue>(&box);
   }
 
   constexpr const UnboxedValue *getUnboxed() const {
     return std::get_if<UnboxedValue>(&box);
   }
 
   /// LLVM style debugging of extended values
-  void dump() const { llvm::errs() << *this << '\n'; }
+  LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this << '\n'; }
 
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
                                        const ExtendedValue &);
   friend mlir::Value getBase(const ExtendedValue &exv);
   friend ExtendedValue substBase(const ExtendedValue &exv, mlir::Value base);
 
 private:
   std::variant<UnboxedValue, CharBoxValue, ArrayBoxValue, CharArrayBoxValue,
                BoxValue, ProcBoxValue>
       box;
 };
 } // namespace fir
 
 #endif // LOWER_SUPPORT_BOXVALUE_H

flang/include/flang/Optimizer/Support/KindMapping.h

-//===-- Optimizer/Support/KindMapping.h -------------------------*- C++ -*-===//
+//===-- Optimizer/Support/KindMapping.h -- support kind mapping -*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef OPTIMIZER_SUPPORT_KINDMAPPING_H
 #define OPTIMIZER_SUPPORT_KINDMAPPING_H
 
 #include "mlir/IR/OpDefinition.h"
 #include "llvm/ADT/DenseMap.h"
 #include "llvm/IR/Type.h"
 
 namespace llvm {
-template <typename>
-class Optional;
 struct fltSemantics;
 } // namespace llvm
 
-namespace mlir {
-class MLIRContext;
-} // namespace mlir
-
 namespace fir {
 
 /// The kind mapping is an encoded string that informs FIR how the Fortran KIND
 /// values from the front-end should be converted to LLVM IR types.  This
 /// encoding allows the mapping from front-end KIND values to backend LLVM IR
 /// types to be customized by the front-end.
 ///
 /// The provided string uses the following syntax.
public:
   using Bitsize = unsigned;
   using LLVMTypeID = llvm::Type::TypeID;
   using MatchResult = mlir::ParseResult;
 
   explicit KindMapping(mlir::MLIRContext *context);
   explicit KindMapping(mlir::MLIRContext *context, llvm::StringRef map);
 
   /// Get the size in bits of !fir.char<kind>
-  Bitsize getCharacterBitsize(KindTy kind);
+  Bitsize getCharacterBitsize(KindTy kind) const;
 
   /// Get the size in bits of !fir.int<kind>
-  Bitsize getIntegerBitsize(KindTy kind);
+  Bitsize getIntegerBitsize(KindTy kind) const;
 
   /// Get the size in bits of !fir.logical<kind>
-  Bitsize getLogicalBitsize(KindTy kind);
+  Bitsize getLogicalBitsize(KindTy kind) const;
+
+  /// Get the size in bits of !fir.real<kind>
+  Bitsize getRealBitsize(KindTy kind) const;
 
   /// Get the LLVM Type::TypeID of !fir.real<kind>
-  LLVMTypeID getRealTypeID(KindTy kind);
+  LLVMTypeID getRealTypeID(KindTy kind) const;
 
   /// Get the LLVM Type::TypeID of !fir.complex<kind>
-  LLVMTypeID getComplexTypeID(KindTy kind);
+  LLVMTypeID getComplexTypeID(KindTy kind) const;
 
   mlir::MLIRContext *getContext() const { return context; }
 
   /// Get the float semantics of !fir.real<kind>
-  const llvm::fltSemantics &getFloatSemantics(KindTy kind);
+  const llvm::fltSemantics &getFloatSemantics(KindTy kind) const;
 
 private:
   MatchResult badMapString(const llvm::Twine &ptr);
   MatchResult parse(llvm::StringRef kindMap);
 
   mlir::MLIRContext *context;
   llvm::DenseMap<std::pair<char, KindTy>, Bitsize> intMap;
   llvm::DenseMap<std::pair<char, KindTy>, LLVMTypeID> floatMap;
 };
 
 } // namespace fir
 
 #endif // OPTIMIZER_SUPPORT_KINDMAPPING_H

flang/lib/Lower/CMakeLists.txt

 set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-error -Wno-unused-parameter")
 get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 
 add_flang_library(FortranLower
+  CharacterExpr.cpp
+  CharacterRuntime.cpp
   ComplexExpr.cpp
   ConvertType.cpp
   DoLoopHelper.cpp
   Mangler.cpp
   OpenMP.cpp
   PFTBuilder.cpp
 
   DEPENDS

flang/lib/Lower/CharacterExpr.cpp

+//===-- CharacterExpr.cpp -------------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/CharacterExpr.h"
+#include "flang/Lower/ConvertType.h"
+#include "flang/Lower/DoLoopHelper.h"
+#include "flang/Lower/IntrinsicCall.h"
+
+//===----------------------------------------------------------------------===//
+// CharacterExprHelper implementation
+//===----------------------------------------------------------------------===//
+
+/// Get fir.char<kind> type with the same kind as inside str.
+static fir::CharacterType getCharacterType(mlir::Type type) {
+  if (auto boxType = type.dyn_cast<fir::BoxCharType>())
+    return boxType.getEleTy();
+  if (auto refType = type.dyn_cast<fir::ReferenceType>())
+    type = refType.getEleTy();
+  if (auto seqType = type.dyn_cast<fir::SequenceType>())
+    type = seqType.getEleTy();
+  if (auto charType = type.dyn_cast<fir::CharacterType>())
+    return charType;
+  llvm_unreachable("Invalid character value type");
+}
+
+static fir::CharacterType getCharacterType(const fir::CharBoxValue &box) {
+  return getCharacterType(box.getBuffer().getType());
+}
+
+static bool needToMaterialize(const fir::CharBoxValue &box) {
+  return box.getBuffer().getType().isa<fir::SequenceType>() ||
+         box.getBuffer().getType().isa<fir::CharacterType>();
+}
+
+static std::optional<fir::SequenceType::Extent>
+getCompileTimeLength(const fir::CharBoxValue &box) {
+  // FIXME: should this just return box.getLen() ??
+  auto type = box.getBuffer().getType();
+  if (type.isa<fir::CharacterType>())
+    return 1;
+  if (auto refType = type.dyn_cast<fir::ReferenceType>())
+    type = refType.getEleTy();
+  if (auto seqType = type.dyn_cast<fir::SequenceType>()) {
+    auto shape = seqType.getShape();
+    assert(shape.size() == 1 && "only scalar character supported");
+    if (shape[0] != fir::SequenceType::getUnknownExtent())
+      return shape[0];
+  }
+  return {};
+}
+
+fir::CharBoxValue Fortran::lower::CharacterExprHelper::materializeValue(
+    const fir::CharBoxValue &str) {
+  if (!needToMaterialize(str))
+    return str;
+  auto variable = builder.create<fir::AllocaOp>(loc, str.getBuffer().getType());
+  builder.create<fir::StoreOp>(loc, str.getBuffer(), variable);
+  return {variable, str.getLen()};
+}
+
+fir::CharBoxValue
+Fortran::lower::CharacterExprHelper::toDataLengthPair(mlir::Value character) {
+  auto lenType = getLengthType();
+  auto type = character.getType();
+  if (auto boxCharType = type.dyn_cast<fir::BoxCharType>()) {
+    auto refType = builder.getRefType(boxCharType.getEleTy());
+    auto unboxed =
+        builder.create<fir::UnboxCharOp>(loc, refType, lenType, character);
+    return {unboxed.getResult(0), unboxed.getResult(1)};
+  }
+  if (auto seqType = type.dyn_cast<fir::CharacterType>()) {
+    // Materialize length for usage into character manipulations.
+    auto len = builder.createIntegerConstant(loc, lenType, 1);
+    return {character, len};
+  }
+  if (auto refType = type.dyn_cast<fir::ReferenceType>())
+    type = refType.getEleTy();
+  if (auto seqType = type.dyn_cast<fir::SequenceType>()) {
+    assert(seqType.hasConstantShape() &&
+           "ssa array value must have constant length");
+    auto shape = seqType.getShape();
+    assert(shape.size() == 1 && "only scalar character supported");
+    // Materialize length for usage into character manipulations.
+    auto len = builder.createIntegerConstant(loc, lenType, shape[0]);
+    // FIXME: this seems to work for tests, but don't think it is correct
+    if (auto load = dyn_cast<fir::LoadOp>(character.getDefiningOp()))
+      return {load.memref(), len};
+    return {character, len};
+  }
+  if (auto charTy = type.dyn_cast<fir::CharacterType>()) {
+    auto len = builder.createIntegerConstant(loc, lenType, 1);
+    return {character, len};
+  }
+  llvm::report_fatal_error("unexpected character type");
+}
+
+/// Get fir.ref<fir.char<kind>> type.
+mlir::Type Fortran::lower::CharacterExprHelper::getReferenceType(
+    const fir::CharBoxValue &box) const {
+  return builder.getRefType(getCharacterType(box));
+}
+
+mlir::Value
+Fortran::lower::CharacterExprHelper::createEmbox(const fir::CharBoxValue &box) {
+  // BoxChar require a reference.
+  auto str = box;
+  if (needToMaterialize(box))
+    str = materializeValue(box);
+  auto kind = getCharacterType(str).getFKind();
+  auto boxCharType = fir::BoxCharType::get(builder.getContext(), kind);
+  auto refType = getReferenceType(str);
+  // So far, fir.emboxChar fails lowering to llvm when it is given
+  // fir.data<fir.array<len x fir.char<kind>>> types, so convert to
+  // fir.data<fir.char<kind>> if needed.
+  auto buff = str.getBuffer();
+  if (refType != str.getBuffer().getType())
+    buff = builder.createConvert(loc, refType, buff);
+  // Convert in case the provided length is not of the integer type that must
+  // be used in boxchar.
+  auto lenType = getLengthType();
+  auto len = str.getLen();
+  if (str.getLen().getType() != lenType)
+    len = builder.createConvert(loc, lenType, len);
+  return builder.create<fir::EmboxCharOp>(loc, boxCharType, buff, len);
+}
+
+mlir::Value Fortran::lower::CharacterExprHelper::createLoadCharAt(
+    const fir::CharBoxValue &str, mlir::Value index) {
+  // In case this is addressing a length one character scalar simply return
+  // the single character.
+  if (str.getBuffer().getType().isa<fir::CharacterType>())
+    return str.getBuffer();
+  auto addr = builder.create<fir::CoordinateOp>(loc, getReferenceType(str),
+                                                str.getBuffer(), index);
+  return builder.create<fir::LoadOp>(loc, addr);
+}
+
+void Fortran::lower::CharacterExprHelper::createStoreCharAt(
+    const fir::CharBoxValue &str, mlir::Value index, mlir::Value c) {
+  assert(!needToMaterialize(str) && "not in memory");
+  auto addr = builder.create<fir::CoordinateOp>(loc, getReferenceType(str),
+                                                str.getBuffer(), index);
+  builder.create<fir::StoreOp>(loc, c, addr);
+}
+
+void Fortran::lower::CharacterExprHelper::createCopy(
+    const fir::CharBoxValue &dest, const fir::CharBoxValue &src,
+    mlir::Value count) {
+  Fortran::lower::DoLoopHelper{builder, loc}.createLoop(
+      count, [&](Fortran::lower::FirOpBuilder &, mlir::Value index) {
+        auto charVal = createLoadCharAt(src, index);
+        createStoreCharAt(dest, index, charVal);
+      });
+}
+
+void Fortran::lower::CharacterExprHelper::createPadding(
+    const fir::CharBoxValue &str, mlir::Value lower, mlir::Value upper) {
+  auto blank = createBlankConstant(getCharacterType(str));
+  // Always create the loop, if upper < lower, no iteration will be
+  // executed.
+  Fortran::lower::DoLoopHelper{builder, loc}.createLoop(
+      lower, upper, [&](Fortran::lower::FirOpBuilder &, mlir::Value index) {
+        createStoreCharAt(str, index, blank);
+      });
+}
+
+fir::CharBoxValue
+Fortran::lower::CharacterExprHelper::createTemp(mlir::Type type,
+                                                mlir::Value len) {
+  assert(type.isa<fir::CharacterType>() && "expected fir character type");
+  llvm::SmallVector<mlir::Value, 3> sizes{len};
+  auto ref = builder.allocateLocal(loc, type, llvm::StringRef{}, sizes);
+  return {ref, len};
+}
+
+// Simple length one character assignment without loops.
+void Fortran::lower::CharacterExprHelper::createLengthOneAssign(
+    const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) {
+  auto addr = lhs.getBuffer();
+  auto refType = getReferenceType(lhs);
+  addr = builder.createConvert(loc, refType, addr);
+
+  auto val = rhs.getBuffer();
+  if (!needToMaterialize(rhs)) {
+    mlir::Value rhsAddr = rhs.getBuffer();
+    rhsAddr = builder.createConvert(loc, refType, rhsAddr);
+    val = builder.create<fir::LoadOp>(loc, rhsAddr);
+  }
+
+  builder.create<fir::StoreOp>(loc, val, addr);
+}
+
+void Fortran::lower::CharacterExprHelper::createAssign(
+    const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) {
+  auto rhsCstLen = getCompileTimeLength(rhs);
+  auto lhsCstLen = getCompileTimeLength(lhs);
+  bool compileTimeSameLength =
+      lhsCstLen && rhsCstLen && *lhsCstLen == *rhsCstLen;
+
+  if (compileTimeSameLength && *lhsCstLen == 1) {
+    createLengthOneAssign(lhs, rhs);
+    return;
+  }
+
+  // Copy the minimum of the lhs and rhs lengths and pad the lhs remainder
+  // if needed.
+  mlir::Value copyCount = lhs.getLen();
+  if (!compileTimeSameLength)
+    copyCount = Fortran::lower::IntrinsicCallOpsHelper{builder, loc}.genMin(
+        {lhs.getLen(), rhs.getLen()});
+
+  fir::CharBoxValue safeRhs = rhs;
+  if (needToMaterialize(rhs)) {
+    // TODO: revisit now that character constant handling changed.
+    // Need to materialize the constant to get its elements.
+    // (No equivalent of fir.coordinate_of for array value).
+    safeRhs = materializeValue(rhs);
+  } else {
+    // If rhs is in memory, always assumes rhs might overlap with lhs
+    // in a way that require a temp for the copy. That can be optimize later.
+    // Only create a temp of copyCount size because we do not need more from
+    // rhs.
+    auto temp = createTemp(getCharacterType(rhs), copyCount);
+    createCopy(temp, rhs, copyCount);
+    safeRhs = temp;
+  }
+
+  // Actual copy
+  createCopy(lhs, safeRhs, copyCount);
+
+  // Pad if needed.
+  if (!compileTimeSameLength) {
+    auto one = builder.createIntegerConstant(loc, lhs.getLen().getType(), 1);
+    auto maxPadding = builder.create<mlir::SubIOp>(loc, lhs.getLen(), one);
+    createPadding(lhs, copyCount, maxPadding);
+  }
+}
+
+fir::CharBoxValue Fortran::lower::CharacterExprHelper::createConcatenate(
+    const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) {
+  mlir::Value len =
+      builder.create<mlir::AddIOp>(loc, lhs.getLen(), rhs.getLen());
+  auto temp = createTemp(getCharacterType(rhs), len);
+  createCopy(temp, lhs, lhs.getLen());
+  auto one = builder.createIntegerConstant(loc, len.getType(), 1);
+  auto upperBound = builder.create<mlir::SubIOp>(loc, len, one);
+  auto lhsLen =
+      builder.createConvert(loc, builder.getIndexType(), lhs.getLen());
+  Fortran::lower::DoLoopHelper{builder, loc}.createLoop(
+      lhs.getLen(), upperBound, one,
+      [&](Fortran::lower::FirOpBuilder &bldr, mlir::Value index) {
+        auto rhsIndex = bldr.create<mlir::SubIOp>(loc, index, lhsLen);
+        auto charVal = createLoadCharAt(rhs, rhsIndex);
+        createStoreCharAt(temp, index, charVal);
+      });
+  return temp;
+}
+
+fir::CharBoxValue Fortran::lower::CharacterExprHelper::createSubstring(
+    const fir::CharBoxValue &box, llvm::ArrayRef<mlir::Value> bounds) {
+  // Constant need to be materialize in memory to use fir.coordinate_of.
+  auto str = box;
+  if (needToMaterialize(box))
+    str = materializeValue(box);
+
+  auto nbounds{bounds.size()};
+  if (nbounds < 1 || nbounds > 2) {
+    mlir::emitError(loc, "Incorrect number of bounds in substring");
+    return {mlir::Value{}, mlir::Value{}};
+  }
+  mlir::SmallVector<mlir::Value, 2> castBounds;
+  // Convert bounds to length type to do safe arithmetic on it.
+  for (auto bound : bounds)
+    castBounds.push_back(builder.createConvert(loc, getLengthType(), bound));
+  auto lowerBound = castBounds[0];
+  // FIR CoordinateOp is zero based but Fortran substring are one based.
+  auto one = builder.createIntegerConstant(loc, lowerBound.getType(), 1);
+  auto offset = builder.create<mlir::SubIOp>(loc, lowerBound, one).getResult();
+  auto idxType = builder.getIndexType();
+  if (offset.getType() != idxType)
+    offset = builder.createConvert(loc, idxType, offset);
+  auto substringRef = builder.create<fir::CoordinateOp>(
+      loc, getReferenceType(str), str.getBuffer(), offset);
+
+  // Compute the length.
+  mlir::Value substringLen{};
+  if (nbounds < 2) {
+    substringLen =
+        builder.create<mlir::SubIOp>(loc, str.getLen(), castBounds[0]);
+  } else {
+    substringLen =
+        builder.create<mlir::SubIOp>(loc, castBounds[1], castBounds[0]);
+  }
+  substringLen = builder.create<mlir::AddIOp>(loc, substringLen, one);
+
+  // Set length to zero if bounds were reversed (Fortran 2018 9.4.1)
+  auto zero = builder.createIntegerConstant(loc, substringLen.getType(), 0);
+  auto cdt = builder.create<mlir::CmpIOp>(loc, mlir::CmpIPredicate::slt,
+                                          substringLen, zero);
+  substringLen = builder.create<mlir::SelectOp>(loc, cdt, zero, substringLen);
+
+  return {substringRef, substringLen};
+}
+
+mlir::Value Fortran::lower::CharacterExprHelper::createLenTrim(
+    const fir::CharBoxValue &str) {
+  // Note: Runtime for LEN_TRIM should also be available at some
+  // point. For now use an inlined implementation.
+  auto indexType = builder.getIndexType();
+  auto len = builder.createConvert(loc, indexType, str.getLen());
+  auto one = builder.createIntegerConstant(loc, indexType, 1);
+  auto minusOne = builder.createIntegerConstant(loc, indexType, -1);
+  auto zero = builder.createIntegerConstant(loc, indexType, 0);
+  auto trueVal = builder.createIntegerConstant(loc, builder.getI1Type(), 1);
+  auto blank = createBlankConstantCode(getCharacterType(str));
+  mlir::Value lastChar = builder.create<mlir::SubIOp>(loc, len, one);
+
+  auto iterWhile = builder.create<fir::IterWhileOp>(
+      loc, lastChar, zero, minusOne, trueVal, lastChar);
+  auto insPt = builder.saveInsertionPoint();
+  builder.setInsertionPointToStart(iterWhile.getBody());
+  auto index = iterWhile.getInductionVar();
+  // Look for first non-blank from the right of the character.
+  auto c = createLoadCharAt(str, index);
+  c = builder.createConvert(loc, blank.getType(), c);
+  auto isBlank =
+      builder.create<mlir::CmpIOp>(loc, mlir::CmpIPredicate::eq, blank, c);
+  llvm::SmallVector<mlir::Value, 2> results = {isBlank, index};
+  builder.create<fir::ResultOp>(loc, results);
+  builder.restoreInsertionPoint(insPt);
+  // Compute length after iteration (zero if all blanks)
+  mlir::Value newLen =
+      builder.create<mlir::AddIOp>(loc, iterWhile.getResult(1), one);
+  auto result =
+      builder.create<SelectOp>(loc, iterWhile.getResult(0), zero, newLen);
+  return builder.createConvert(loc, getLengthType(), result);
+}
+
+mlir::Value Fortran::lower::CharacterExprHelper::createTemp(mlir::Type type,
+                                                            int len) {
+  assert(type.isa<fir::CharacterType>() && "expected fir character type");
+  assert(len >= 0 && "expected positive length");
+  fir::SequenceType::Shape shape{len};
+  auto seqType = fir::SequenceType::get(shape, type);
+  return builder.create<fir::AllocaOp>(loc, seqType);
+}
+
+// Returns integer with code for blank. The integer has the same
+// size as the character. Blank has ascii space code for all kinds.
+mlir::Value Fortran::lower::CharacterExprHelper::createBlankConstantCode(
+    fir::CharacterType type) {
+  auto bits = builder.getKindMap().getCharacterBitsize(type.getFKind());
+  auto intType = builder.getIntegerType(bits);
+  return builder.createIntegerConstant(loc, intType, ' ');
+}
+
+mlir::Value Fortran::lower::CharacterExprHelper::createBlankConstant(
+    fir::CharacterType type) {
+  return builder.createConvert(loc, type, createBlankConstantCode(type));
+}
+
+void Fortran::lower::CharacterExprHelper::createCopy(mlir::Value dest,
+                                                     mlir::Value src,
+                                                     mlir::Value count) {
+  createCopy(toDataLengthPair(dest), toDataLengthPair(src), count);
+}
+
+void Fortran::lower::CharacterExprHelper::createPadding(mlir::Value str,
+                                                        mlir::Value lower,
+                                                        mlir::Value upper) {
+  createPadding(toDataLengthPair(str), lower, upper);
+}
+
+mlir::Value Fortran::lower::CharacterExprHelper::createSubstring(
+    mlir::Value str, llvm::ArrayRef<mlir::Value> bounds) {
+  return createEmbox(createSubstring(toDataLengthPair(str), bounds));
+}
+
+void Fortran::lower::CharacterExprHelper::createAssign(mlir::Value lhs,
+                                                       mlir::Value rhs) {
+  createAssign(toDataLengthPair(lhs), toDataLengthPair(rhs));
+}
+
+mlir::Value
+Fortran::lower::CharacterExprHelper::createLenTrim(mlir::Value str) {
+  return createLenTrim(toDataLengthPair(str));
+}
+
+void Fortran::lower::CharacterExprHelper::createAssign(mlir::Value lptr,
+                                                       mlir::Value llen,
+                                                       mlir::Value rptr,
+                                                       mlir::Value rlen) {
+  createAssign(fir::CharBoxValue{lptr, llen}, fir::CharBoxValue{rptr, rlen});
+}
+
+mlir::Value
+Fortran::lower::CharacterExprHelper::createConcatenate(mlir::Value lhs,
+                                                       mlir::Value rhs) {
+  return createEmbox(
+      createConcatenate(toDataLengthPair(lhs), toDataLengthPair(rhs)));
+}
+
+mlir::Value
+Fortran::lower::CharacterExprHelper::createEmboxChar(mlir::Value addr,
+                                                     mlir::Value len) {
+  return createEmbox(fir::CharBoxValue{addr, len});
+}
+
+std::pair<mlir::Value, mlir::Value>
+Fortran::lower::CharacterExprHelper::createUnboxChar(mlir::Value boxChar) {
+  auto box = toDataLengthPair(boxChar);
+  return {box.getBuffer(), box.getLen()};
+}
+
+mlir::Value
+Fortran::lower::CharacterExprHelper::createCharacterTemp(mlir::Type type,
+                                                         mlir::Value len) {
+  return createEmbox(createTemp(type, len));
+}
+
+std::pair<mlir::Value, mlir::Value>
+Fortran::lower::CharacterExprHelper::materializeCharacter(mlir::Value str) {
+  auto box = toDataLengthPair(str);
+  if (needToMaterialize(box))
+    box = materializeValue(box);
+  return {box.getBuffer(), box.getLen()};
+}
+
+bool Fortran::lower::CharacterExprHelper::isCharacterLiteral(mlir::Type type) {
+  if (auto seqType = type.dyn_cast<fir::SequenceType>())
+    return seqType.getEleTy().isa<fir::CharacterType>();
+  return false;
+}
+
+bool Fortran::lower::CharacterExprHelper::isCharacter(mlir::Type type) {
+  if (type.isa<fir::BoxCharType>())
+    return true;
+  if (auto refType = type.dyn_cast<fir::ReferenceType>())
+    type = refType.getEleTy();
+  if (auto seqType = type.dyn_cast<fir::SequenceType>()) {
+    type = seqType.getEleTy();
+  }
+  return type.isa<fir::CharacterType>();
+}
+
+int Fortran::lower::CharacterExprHelper::getCharacterKind(mlir::Type type) {
+  return getCharacterType(type).getFKind();
+}

flang/lib/Lower/CharacterRuntime.cpp

+//===-- CharacterRuntime.cpp -- runtime for CHARACTER type entities -------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/CharacterRuntime.h"
+#include "../../runtime/character.h"
+#include "RTBuilder.h"
+#include "flang/Lower/Bridge.h"
+#include "flang/Lower/CharacterExpr.h"
+#include "flang/Lower/FIRBuilder.h"
+#include "mlir/Dialect/StandardOps/IR/Ops.h"
+
+using namespace Fortran::runtime;
+
+#define NAMIFY_HELPER(X) #X
+#define NAMIFY(X) NAMIFY_HELPER(IONAME(X))
+#define mkRTKey(X) mkKey(RTNAME(X))
+
+namespace Fortran::lower {
+/// Static table of CHARACTER runtime calls
+///
+/// This logical map contains the name and type builder function for each
+/// runtime function listed in the tuple. This table is fully constructed at
+/// compile-time. Use the `mkRTKey` macro to access the table.
+static constexpr std::tuple<
+    mkRTKey(CharacterCompareScalar), mkRTKey(CharacterCompareScalar1),
+    mkRTKey(CharacterCompareScalar2), mkRTKey(CharacterCompareScalar4),
+    mkRTKey(CharacterCompare)>
+    newCharRTTable;
+} // namespace Fortran::lower
+
+using namespace Fortran::lower;
+
+/// 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>(newCharRTTable).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 FuncTypeBuilderFunc getTypeModel() {
+  return std::get<A>(newCharRTTable).getTypeModel();
+}
+
+inline int64_t getLength(mlir::Type argTy) {
+  return argTy.cast<fir::SequenceType>().getShape()[0];
+}
+
+/// Get (or generate) the MLIR FuncOp for a given runtime function.
+template <typename E>
+static mlir::FuncOp getRuntimeFunc(mlir::Location loc,
+                                   Fortran::lower::FirOpBuilder &builder) {
+  auto name = getName<E>();
+  auto 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());
+  return func;
+}
+
+/// Helper function to recover the KIND from the FIR type.
+static int discoverKind(mlir::Type ty) {
+  if (auto charTy = ty.dyn_cast<fir::CharacterType>())
+    return charTy.getFKind();
+  if (auto eleTy = fir::dyn_cast_ptrEleTy(ty))
+    return discoverKind(eleTy);
+  if (auto arrTy = ty.dyn_cast<fir::SequenceType>())
+    return discoverKind(arrTy.getEleTy());
+  if (auto boxTy = ty.dyn_cast<fir::BoxCharType>())
+    return discoverKind(boxTy.getEleTy());
+  if (auto boxTy = ty.dyn_cast<fir::BoxType>())
+    return discoverKind(boxTy.getEleTy());
+  llvm_unreachable("unexpected character type");
+}
+
+//===----------------------------------------------------------------------===//
+// Lower character operations
+//===----------------------------------------------------------------------===//
+
+mlir::Value
+Fortran::lower::genRawCharCompare(Fortran::lower::AbstractConverter &converter,
+                                  mlir::Location loc, mlir::CmpIPredicate cmp,
+                                  mlir::Value lhsBuff, mlir::Value lhsLen,
+                                  mlir::Value rhsBuff, mlir::Value rhsLen) {
+  auto &builder = converter.getFirOpBuilder();
+  mlir::FuncOp beginFunc;
+  switch (discoverKind(lhsBuff.getType())) {
+  case 1:
+    beginFunc = getRuntimeFunc<mkRTKey(CharacterCompareScalar1)>(loc, builder);
+    break;
+  case 2:
+    beginFunc = getRuntimeFunc<mkRTKey(CharacterCompareScalar2)>(loc, builder);
+    break;
+  case 4:
+    beginFunc = getRuntimeFunc<mkRTKey(CharacterCompareScalar4)>(loc, builder);
+    break;
+  default:
+    llvm_unreachable("runtime does not support CHARACTER KIND");
+  }
+  auto fTy = beginFunc.getType();
+  auto lptr = builder.createConvert(loc, fTy.getInput(0), lhsBuff);
+  auto llen = builder.createConvert(loc, fTy.getInput(2), lhsLen);
+  auto rptr = builder.createConvert(loc, fTy.getInput(1), rhsBuff);
+  auto rlen = builder.createConvert(loc, fTy.getInput(3), rhsLen);
+  llvm::SmallVector<mlir::Value, 4> args = {lptr, rptr, llen, rlen};
+  auto tri = builder.create<mlir::CallOp>(loc, beginFunc, args).getResult(0);
+  auto zero = builder.createIntegerConstant(loc, tri.getType(), 0);
+  return builder.create<mlir::CmpIOp>(loc, cmp, tri, zero);
+}
+
+mlir::Value
+Fortran::lower::genBoxCharCompare(Fortran::lower::AbstractConverter &converter,
+                                  mlir::Location loc, mlir::CmpIPredicate cmp,
+                                  mlir::Value lhs, mlir::Value rhs) {
+  auto &builder = converter.getFirOpBuilder();
+  Fortran::lower::CharacterExprHelper helper{builder, loc};
+  auto lhsPair = helper.materializeCharacter(lhs);
+  auto rhsPair = helper.materializeCharacter(rhs);
+  return genRawCharCompare(converter, loc, cmp, lhsPair.first, lhsPair.second,
+                           rhsPair.first, rhsPair.second);
+}

flang/lib/Lower/OpenMP.cpp

 //===-- OpenMP.cpp -- Open MP directive 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
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/OpenMP.h"
-#include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/Bridge.h"
 #include "flang/Lower/PFTBuilder.h"
 #include "flang/Parser/parse-tree.h"
 
 #define TODO() llvm_unreachable("not yet implemented")
 
 void Fortran::lower::genOpenMPConstruct(
     Fortran::lower::AbstractConverter &, Fortran::lower::pft::Evaluation &,
     const Fortran::parser::OpenMPConstruct &) {
   TODO();
 }
 
 void Fortran::lower::genOpenMPEndLoop(
     Fortran::lower::AbstractConverter &, Fortran::lower::pft::Evaluation &,
     const Fortran::parser::OmpEndLoopDirective &) {
   TODO();
 }

flang/lib/Lower/PFTBuilder.cpp

auto &unit =
         addUnit(lower::pft::ModuleLikeUnit{func, parentVariantStack.back()});
     functionList = &unit.nestedFunctions;
     parentVariantStack.emplace_back(unit);
     return true;
   }
 
   void exitModule() {
     parentVariantStack.pop_back();
-    resetFunctionList();
+    resetFunctionState();
+  }
+
+  /// Ensure that a function has a branch target after the last user statement.
+  void endFunctionBody() {
+    if (lastLexicalEvaluation) {
+      static const parser::ContinueStmt endTarget{};
+      addEvaluation(
+          lower::pft::Evaluation{endTarget, parentVariantStack.back(), {}, {}});
+      lastLexicalEvaluation = nullptr;
+    }
   }
 
   /// Initialize a new function-like unit and make it the builder's focus.
   template <typename A>
   bool enterFunction(const A &func,
                      const semantics::SemanticsContext &semanticsContext) {
+    endFunctionBody(); // enclosing host subprogram body, if any
     auto &unit = addFunction(lower::pft::FunctionLikeUnit{
         func, parentVariantStack.back(), semanticsContext});
     labelEvaluationMap = &unit.labelEvaluationMap;
     assignSymbolLabelMap = &unit.assignSymbolLabelMap;
     functionList = &unit.nestedFunctions;
     pushEvaluationList(&unit.evaluationList);
     parentVariantStack.emplace_back(unit);
     return true;
   }
 
   void exitFunction() {
-    // Guarantee that there is a branch target after the last user statement.
-    static const parser::ContinueStmt endTarget{};
-    addEvaluation(
-        lower::pft::Evaluation{endTarget, parentVariantStack.back(), {}, {}});
-    lastLexicalEvaluation = nullptr;
+    endFunctionBody();
     analyzeBranches(nullptr, *evaluationListStack.back()); // add branch links
     popEvaluationList();
     labelEvaluationMap = nullptr;
     assignSymbolLabelMap = nullptr;
     parentVariantStack.pop_back();
-    resetFunctionList();
+    resetFunctionState();
   }
 
   /// Initialize a new construct and make it the builder's focus.
   template <typename A>
   bool enterConstructOrDirective(const A &construct) {
     auto &eval = addEvaluation(
         lower::pft::Evaluation{construct, parentVariantStack.back()});
     eval.evaluationList.reset(new lower::pft::EvaluationList);
     pushEvaluationList(eval.evaluationList.get());
     parentVariantStack.emplace_back(eval);
     constructAndDirectiveStack.emplace_back(&eval);
     return true;
   }
 
   void exitConstructOrDirective() {
     popEvaluationList();
     parentVariantStack.pop_back();
     constructAndDirectiveStack.pop_back();
   }
 
-  /// Reset functionList to an enclosing function's functionList.
-  void resetFunctionList() {
+  /// Reset function state to that of an enclosing host function.
+  void resetFunctionState() {
     if (!parentVariantStack.empty()) {
       parentVariantStack.back().visit(common::visitors{
           [&](lower::pft::FunctionLikeUnit &p) {
             functionList = &p.nestedFunctions;
+            labelEvaluationMap = &p.labelEvaluationMap;
+            assignSymbolLabelMap = &p.assignSymbolLabelMap;
           },
           [&](lower::pft::ModuleLikeUnit &p) {
             functionList = &p.nestedFunctions;
           },
           [&](auto &) { functionList = nullptr; },
       });
     }
   }
if constexpr (std::is_same_v<A, parser::ReadStmt> ||
       // Always crash if this is instantiated
       static_assert(!std::is_same_v<A, parser::ReadStmt>,
                     "Unexpected IO statement");
     }
   }
 
   /// Set the exit of a construct, possibly from multiple enclosing constructs.
   void setConstructExit(lower::pft::Evaluation &eval) {
-    eval.constructExit = eval.evaluationList->back().lexicalSuccessor;
-    if (eval.constructExit && eval.constructExit->isNopConstructStmt()) {
-      eval.constructExit = eval.constructExit->parentConstruct->constructExit;
-    }
-    assert(eval.constructExit && "missing construct exit");
+    eval.constructExit = &eval.evaluationList->back().nonNopSuccessor();
   }
 
+  /// Mark the target of a branch as a new block.
   void markBranchTarget(lower::pft::Evaluation &sourceEvaluation,
                         lower::pft::Evaluation &targetEvaluation) {
     sourceEvaluation.isUnstructured = true;
     if (!sourceEvaluation.controlSuccessor) {
       sourceEvaluation.controlSuccessor = &targetEvaluation;
     }
     targetEvaluation.isNewBlock = true;
+    // If this is a branch into the body of a construct (usually illegal,
+    // but allowed in some legacy cases), then the targetEvaluation and its
+    // ancestors must be marked as unstructured.
+    auto *sourceConstruct = sourceEvaluation.parentConstruct;
+    auto *targetConstruct = targetEvaluation.parentConstruct;
+    if (targetEvaluation.isConstructStmt() &&
+        &targetConstruct->getFirstNestedEvaluation() == &targetEvaluation)
+      // A branch to an initial constructStmt is a branch to the construct.
+      targetConstruct = targetConstruct->parentConstruct;
+    if (targetConstruct) {
+      while (sourceConstruct && sourceConstruct != targetConstruct)
+        sourceConstruct = sourceConstruct->parentConstruct;
+      if (sourceConstruct != targetConstruct)
+        for (auto *eval = &targetEvaluation; eval; eval = eval->parentConstruct)
+          eval->isUnstructured = true;
+    }
   }
   void markBranchTarget(lower::pft::Evaluation &sourceEvaluation,
                         parser::Label label) {
     assert(label && "missing branch target label");
     lower::pft::Evaluation *targetEvaluation{
         labelEvaluationMap->find(label)->second};
     assert(targetEvaluation && "missing branch target evaluation");
     markBranchTarget(sourceEvaluation, *targetEvaluation);
   }
 
-  /// Return the first non-nop successor of an evaluation, possibly exiting
-  /// from one or more enclosing constructs.
-  lower::pft::Evaluation *exitSuccessor(lower::pft::Evaluation &eval) {
-    lower::pft::Evaluation *successor{eval.lexicalSuccessor};
-    if (successor && successor->isNopConstructStmt()) {
-      successor = successor->parentConstruct->constructExit;
-    }
-    assert(successor && "missing exit successor");
-    return successor;
-  }
-
-  /// Mark the exit successor of an Evaluation as a new block.
+  /// Mark the successor of an Evaluation as a new block.
   void markSuccessorAsNewBlock(lower::pft::Evaluation &eval) {
-    exitSuccessor(eval)->isNewBlock = true;
+    eval.nonNopSuccessor().isNewBlock = true;
   }
 
   template <typename A>
   inline std::string getConstructName(const A &stmt) {
     using MaybeConstructNameWrapper =
         std::tuple<parser::BlockStmt, parser::CycleStmt, parser::ElseStmt,
                    parser::ElsewhereStmt, parser::EndAssociateStmt,
                    parser::EndBlockStmt, parser::EndCriticalStmt,
for (auto &eval : evaluationList) {
               assignSymbolLabelMap->try_emplace(*sym, labelSet);
             } else {
               iter->second.insert(label);
             }
           },
           [&](const parser::AssignedGotoStmt &) {
             // Although this statement is a branch, it doesn't have any
             // explicit control successors.  So the code at the end of the
-            // loop won't mark the exit successor.  Do that here.
+            // loop won't mark the successor.  Do that here.
+            eval.isUnstructured = true;
             markSuccessorAsNewBlock(eval);
           },
 
           // Construct statements
           [&](const parser::AssociateStmt &s) {
             insertConstructName(s, parentConstruct);
           },
           [&](const parser::BlockStmt &s) {
             insertConstructName(s, parentConstruct);
           },
           [&](const parser::SelectCaseStmt &s) {
             insertConstructName(s, parentConstruct);
             lastConstructStmtEvaluation = &eval;
           },
           [&](const parser::CaseStmt &) {
             eval.isNewBlock = true;
             lastConstructStmtEvaluation->controlSuccessor = &eval;
             lastConstructStmtEvaluation = &eval;
           },
           [&](const parser::EndSelectStmt &) {
-            eval.lexicalSuccessor->isNewBlock = true;
+            eval.nonNopSuccessor().isNewBlock = true;
             lastConstructStmtEvaluation = nullptr;
           },
           [&](const parser::ChangeTeamStmt &s) {
             insertConstructName(s, parentConstruct);
           },
           [&](const parser::CriticalStmt &s) {
             insertConstructName(s, parentConstruct);
           },
           [&](const parser::NonLabelDoStmt &s) {
             insertConstructName(s, parentConstruct);
             doConstructStack.push_back(parentConstruct);
             auto &control{std::get<std::optional<parser::LoopControl>>(s.t)};
             // eval.block is the loop preheader block, which will be set
             // elsewhere if the NonLabelDoStmt is itself a target.
             // eval.localBlocks[0] is the loop header block.
             eval.localBlocks.emplace_back(nullptr);
             if (!control.has_value()) {
               eval.isUnstructured = true; // infinite loop
               return;
             }
-            eval.lexicalSuccessor->isNewBlock = true;
+            eval.nonNopSuccessor().isNewBlock = true;
             eval.controlSuccessor = &evaluationList.back();
             if (std::holds_alternative<parser::ScalarLogicalExpr>(control->u)) {
               eval.isUnstructured = true; // while loop
             }
             // Defer additional processing for an unstructured concurrent loop
             // to the EndDoStmt, when the loop is known to be unstructured.
           },
           [&](const parser::EndDoStmt &) {
for (auto &eval : evaluationList) {
       // Insert branch links for an unstructured IF statement.
       if (lastIfStmtEvaluation && lastIfStmtEvaluation != &eval) {
         // eval is the action substatement of an IfStmt.
         if (eval.lowerAsUnstructured()) {
           eval.isNewBlock = true;
           markSuccessorAsNewBlock(eval);
           lastIfStmtEvaluation->isUnstructured = true;
         }
-        lastIfStmtEvaluation->controlSuccessor = exitSuccessor(eval);
+        lastIfStmtEvaluation->controlSuccessor = &eval.nonNopSuccessor();
         lastIfStmtEvaluation = nullptr;
       }
 
       // Set the successor of the last statement in an IF or SELECT block.
       if (!eval.controlSuccessor && eval.lexicalSuccessor &&
           eval.lexicalSuccessor->isIntermediateConstructStmt()) {
         eval.controlSuccessor = parentConstruct->constructExit;
         eval.lexicalSuccessor->isNewBlock = true;
       }
 
       // Propagate isUnstructured flag to enclosing construct.
       if (parentConstruct && eval.isUnstructured) {
         parentConstruct->isUnstructured = true;
       }
 
-      // The lexical successor of a branch starts a new block.
+      // The successor of a branch starts a new block.
       if (eval.controlSuccessor && eval.isActionStmt() &&
           eval.lowerAsUnstructured()) {
         markSuccessorAsNewBlock(eval);
       }
     }
   }
 
   std::unique_ptr<lower::pft::Program> pgm;
private:
 
   llvm::SmallSet<const semantics::Symbol *, 32> seen;
   std::vector<std::vector<lower::pft::Variable>> &vars;
 };
 } // namespace
 
 void Fortran::lower::pft::FunctionLikeUnit::processSymbolTable(
     const semantics::Scope &scope) {
+  // TODO: handle equivalence and common blocks
+  if (!scope.equivalenceSets().empty()) {
+    llvm::errs() << "TODO: equivalence not yet handled in lowering.\n"
+                 << "note: equivalence used in "
+                 << (scope.GetName() && !scope.GetName()->empty()
+                         ? scope.GetName()->ToString()
+                         : "unnamed program"s)
+                 << "\n";
+    exit(1);
+  }
   SymbolDependenceDepth sdd{varList};
   for (const auto &iter : scope)
     sdd.analyze(iter.second.get());
   sdd.finalize();
 }
 
 Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
     const parser::MainProgram &func, const lower::pft::ParentVariant &parent,

flang/lib/Lower/RTBuilder.h

static constexpr FuncTypeBuilderFunc getTypeModel() {
     };
   }
 };
 
 //===----------------------------------------------------------------------===//
 // Runtime table building (constexpr folded)
 //===----------------------------------------------------------------------===//
 
-#if defined(__clang__)
-#pragma clang diagnostic push
-#pragma clang diagnostic ignored "-Wgnu-string-literal-operator-template"
-#endif
-
-// clang++ generates warnings about usage of a GNU extension, ignore them
 template <char... Cs>
 using RuntimeIdentifier = std::integer_sequence<char, Cs...>;
-template <typename T, T... Cs>
-static constexpr RuntimeIdentifier<Cs...> operator""_rt_ident() {
+
+namespace details {
+template <typename T, T... As, T... Bs>
+static constexpr std::integer_sequence<T, As..., Bs...>
+concat(std::integer_sequence<T, As...>, std::integer_sequence<T, Bs...>) {
   return {};
 }
-
-#if defined(__clang__)
-#pragma clang diagnostic pop
-#endif
+template <typename T, T... As, T... Bs, typename... Cs>
+static constexpr auto concat(std::integer_sequence<T, As...>,
+                             std::integer_sequence<T, Bs...>, Cs...) {
+  return concat(std::integer_sequence<T, As..., Bs...>{}, Cs{}...);
+}
+template <typename T>
+static constexpr std::integer_sequence<T> concat(std::integer_sequence<T>) {
+  return {};
+}
+template <typename T, T a>
+static constexpr auto filterZero(std::integer_sequence<T, a>) {
+  if constexpr (a != 0) {
+    return std::integer_sequence<T, a>{};
+  } else {
+    return std::integer_sequence<T>{};
+  }
+}
+template <typename T, T... b>
+static constexpr auto filter(std::integer_sequence<T, b...>) {
+  if constexpr (sizeof...(b) > 0) {
+    return details::concat(filterZero(std::integer_sequence<T, b>{})...);
+  } else {
+    return std::integer_sequence<T>{};
+  }
+}
+} // namespace details
 
 template <typename...>
 struct RuntimeTableEntry;
 template <typename KT, char... Cs>
 struct RuntimeTableEntry<RuntimeTableKey<KT>, RuntimeIdentifier<Cs...>> {
   static constexpr FuncTypeBuilderFunc getTypeModel() {
     return RuntimeTableKey<KT>::getTypeModel();
   }
   static constexpr const char name[sizeof...(Cs) + 1] = {Cs..., '\0'};
 };
 
-#define QuoteKey(X) #X##_rt_ident
-#define ExpandKey(X) QuoteKey(X)
+#undef E
+#define E(L, I) (I < sizeof(L) / sizeof(*L) ? L[I] : 0)
+#define QuoteKey(X) #X
+#define MacroExpandKey(X)                                                      \
+  E(X, 0), E(X, 1), E(X, 2), E(X, 3), E(X, 4), E(X, 5), E(X, 6), E(X, 7),      \
+      E(X, 8), E(X, 9), E(X, 10), E(X, 11), E(X, 12), E(X, 13), E(X, 14),      \
+      E(X, 15), E(X, 16), E(X, 17), E(X, 18), E(X, 19), E(X, 20), E(X, 21),    \
+      E(X, 22), E(X, 23), E(X, 24), E(X, 25), E(X, 26), E(X, 27), E(X, 28),    \
+      E(X, 29), E(X, 30), E(X, 31), E(X, 32), E(X, 33), E(X, 34), E(X, 35),    \
+      E(X, 36), E(X, 37), E(X, 38), E(X, 39), E(X, 40), E(X, 41), E(X, 42),    \
+      E(X, 43), E(X, 44), E(X, 45), E(X, 46), E(X, 47), E(X, 48), E(X, 49)
+#define ExpandKey(X) MacroExpandKey(QuoteKey(X))
+#define FullSeq(X) std::integer_sequence<char, ExpandKey(X)>
+#define AsSequence(X) decltype(Fortran::lower::details::filter(FullSeq(X){}))
 #define mkKey(X)                                                               \
   Fortran::lower::RuntimeTableEntry<                                           \
-      Fortran::lower::RuntimeTableKey<decltype(X)>, decltype(ExpandKey(X))>
+      Fortran::lower::RuntimeTableKey<decltype(X)>, AsSequence(X)>
 
 } // namespace Fortran::lower
 
 #endif // FORTRAN_LOWER_RTBUILDER_H

flang/lib/Lower/SymbolMap.h

 #include "flang/Lower/Support/BoxValue.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
 #include "flang/Semantics/symbol.h"
 #include "mlir/IR/Value.h"
 #include "llvm/ADT/ArrayRef.h"
 #include "llvm/ADT/DenseMap.h"
 #include "llvm/ADT/Optional.h"
 #include "llvm/ADT/SmallVector.h"
+#include "llvm/Support/Compiler.h"
 
 namespace Fortran::lower {
 
 //===----------------------------------------------------------------------===//
 // Symbol information
 //===----------------------------------------------------------------------===//
 
 /// A dictionary entry of ssa-values that together compose a variable referenced
public:
 
   /// Remove `sym` from the map.
   void erase(semantics::SymbolRef sym) { symbolMap.erase(&*sym); }
 
   /// Remove all symbols from the map.
   void clear() { symbolMap.clear(); }
 
   /// Dump the map. For debugging.
-  void dump() const;
+  LLVM_DUMP_METHOD void dump() const;
 
 private:
   /// Add `symbol` to the current map and bind a `box`.
   void makeSym(semantics::SymbolRef sym, const SymbolBox &box,
                bool force = false) {
     if (force)
       erase(sym);
     assert(box && "cannot add an undefined symbol box");

flang/lib/Optimizer/Support/KindMapping.cpp

 //===-- KindMapping.cpp ---------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/Support/KindMapping.h"
 #include "mlir/Dialect/LLVMIR/LLVMDialect.h"
-#include "llvm/ADT/Optional.h"
 #include "llvm/Support/CommandLine.h"
 
 /// Allow the user to set the FIR intrinsic type kind value to LLVM type
 /// mappings.  Note that these are not mappings from kind values to any
 /// other MLIR dialect, only to LLVM IR. The default values follow the f18
 /// front-end kind mappings.
 
 using Bitsize = fir::KindMapping::Bitsize;
while (true) {
     if (parseComma(srcPtr))
       break;
   }
   if (*srcPtr)
     return badMapString(srcPtr);
   return mlir::success();
 }
 
-Bitsize fir::KindMapping::getCharacterBitsize(KindTy kind) {
+Bitsize fir::KindMapping::getCharacterBitsize(KindTy kind) const {
   return getIntegerLikeBitsize<'a'>(kind, intMap);
 }
 
-Bitsize fir::KindMapping::getIntegerBitsize(KindTy kind) {
+Bitsize fir::KindMapping::getIntegerBitsize(KindTy kind) const {
   return getIntegerLikeBitsize<'i'>(kind, intMap);
 }
 
-Bitsize fir::KindMapping::getLogicalBitsize(KindTy kind) {
+Bitsize fir::KindMapping::getLogicalBitsize(KindTy kind) const {
   return getIntegerLikeBitsize<'l'>(kind, intMap);
 }
 
-LLVMTypeID fir::KindMapping::getRealTypeID(KindTy kind) {
+LLVMTypeID fir::KindMapping::getRealTypeID(KindTy kind) const {
   return getFloatLikeTypeID<'r'>(kind, floatMap);
 }
 
-LLVMTypeID fir::KindMapping::getComplexTypeID(KindTy kind) {
+LLVMTypeID fir::KindMapping::getComplexTypeID(KindTy kind) const {
   return getFloatLikeTypeID<'c'>(kind, floatMap);
 }
 
-const llvm::fltSemantics &fir::KindMapping::getFloatSemantics(KindTy kind) {
+Bitsize fir::KindMapping::getRealBitsize(KindTy kind) const {
+  auto typeId = getFloatLikeTypeID<'r'>(kind, floatMap);
+  llvm::LLVMContext llCtxt; // FIXME
+  return llvm::Type::getPrimitiveType(llCtxt, typeId)->getPrimitiveSizeInBits();
+}
+
+const llvm::fltSemantics &
+fir::KindMapping::getFloatSemantics(KindTy kind) const {
   return getFloatSemanticsOfKind<'r'>(kind, floatMap);
 }