[flang] addition of Coarray and some header files

[schweitz]

Summary

This continues to upstream small chunks of the bridge from the flang front-end to the FIR dialect of MLIR.

Add Coarray lowering hooks.
Also add several header files.

    
AbstractConverter is an interface for lowering front-end data structures t
BoxValue defines tuples of related values used in the lowering process.
RTBuilder defines models for lowering C++ functions decls to MLIR.
SymbolMap defines a mapping of front-end symbols to box values.

For now, Bridge.h is a placeholder. It will be upstreamed in a later diff.

[schweitz]

minor edits on a comments

[PeteSteinfeld]

I'm not qualified to comment on the contents of this patch, but everything builds and tests correctly in an out-of-tree build.

[schweitz]

In D82067#2100790, @PeteSteinfeld wrote:

I'm not qualified to comment on the contents of this patch, but everything builds and tests correctly in an out-of-tree build.

Thanks for checking, Pete.

[kiranchandramohan]

I have a few comments/questions.

Could this have been better as more than one patch? Box, symbolmap in one, RTBuilder in another, and corray in another?

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

176–177

RangeBoxValue is not used.
Also, is the name a misnomer since it has nothing to do with the abstract box classes?

flang/lib/Lower/Coarray.cpp

15–16

Are these two headers needed here?

flang/lib/Lower/RTBuilder.h

28

should this header be in the include directory?

flang/lib/Lower/SymbolMap.h

129

https://github.com/llvm-mirror/llvm/blob/2c4ca6832fa6b306ee6a7010bfb80a3f2596f824/include/llvm/ADT/SmallVector.h#L149

Isn't this assert part of the SmallVector implementation?

[schweitz]

In D82067#2101516, @kiranchandramohan wrote:

I have a few comments/questions.

Could this have been better as more than one patch? Box, symbolmap in one, RTBuilder in another, and corray in another?

Indeed, I really did consider that. With this one, I just went with increasing the scope a bit to include four smaller support files that will be need to be merged to start upstreaming future modules. It is a change of pace from the eyedropper approach.

Trying to figure out what size patch is too big or too small is always a problem. If this patch must be broken down into 4 or 5 much smaller pieces, it can be abandoned.

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

176–177

Nice spot.

It will be used. It's included now rather than create fussy merge conflicts.

flang/lib/Lower/Coarray.cpp

15–16

Technically, no.

On the other hand, it's hard to imagine how one might lower a coarray without access to symbols or calls to runtime libraries with runtime library building code.

flang/lib/Lower/RTBuilder.h

28

It's only germane to lowering itself, so it is better not to expose it.

flang/lib/Lower/SymbolMap.h

129

Thanks. I'll get rid of these.

[schweitz]

flang/lib/Lower/RTBuilder.h

28

I misunderstood the question. My bad.

Flang has some pieces stuck in different places. The runtime is one of those.

flang/include/flang/Lower/AbstractConverter.h

 //===-- Lower/AbstractConverter.h -------------------------------*- 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_ABSTRACTCONVERTER_H
 #define FORTRAN_LOWER_ABSTRACTCONVERTER_H
 
-namespace Fortran::lower {
+#include "flang/Common/Fortran.h"
+#include "mlir/IR/Module.h"
 
-// temporary stub
-class AbstractConverter;
+namespace Fortran {
+namespace common {
+template <typename>
+class Reference;
+}
+namespace evaluate {
+struct DataRef;
+template <typename>
+class Expr;
+class FoldingContext;
+struct SomeType;
+} // namespace evaluate
 
-} // namespace Fortran::lower
+namespace parser {
+class CharBlock;
+}
+namespace semantics {
+class Symbol;
+}
+
+namespace lower {
+namespace pft {
+struct Variable;
+}
+
+using SomeExpr = Fortran::evaluate::Expr<Fortran::evaluate::SomeType>;
+using SymbolRef = Fortran::common::Reference<const Fortran::semantics::Symbol>;
+class FirOpBuilder;
+
+//===----------------------------------------------------------------------===//
+// AbstractConverter interface
+//===----------------------------------------------------------------------===//
+
+/// The abstract interface for converter implementations to lower Fortran
+/// front-end fragments such as expressions, types, etc. to the FIR dialect of
+/// MLIR.
+class AbstractConverter {
+public:
+  //===--------------------------------------------------------------------===//
+  // Symbols     
+  //===--------------------------------------------------------------------===//
+
+  /// Get the mlir instance of a symbol.
+  virtual mlir::Value getSymbolAddress(SymbolRef sym) = 0;
+
+  //===--------------------------------------------------------------------===//
+  // Expressions
+  //===--------------------------------------------------------------------===//
+
+  /// Generate the address of the location holding the expression, someExpr
+  virtual mlir::Value genExprAddr(const SomeExpr &,
+                                  mlir::Location *loc = nullptr) = 0;
+  /// Generate the address of the location holding the expression, someExpr
+  mlir::Value genExprAddr(const SomeExpr *someExpr, mlir::Location loc) {
+    return genExprAddr(*someExpr, &loc);
+  }
+
+  /// Generate the computations of the expression to produce a value
+  virtual mlir::Value genExprValue(const SomeExpr &,
+                                   mlir::Location *loc = nullptr) = 0;
+  /// Generate the computations of the expression, someExpr, to produce a value
+  mlir::Value genExprValue(const SomeExpr *someExpr, mlir::Location loc) {
+    return genExprValue(*someExpr, &loc);
+  }
+
+  /// Get FoldingContext that is required for some expression
+  /// analysis.
+  virtual Fortran::evaluate::FoldingContext &getFoldingContext() = 0;
+
+  //===--------------------------------------------------------------------===//
+  // Types
+  //===--------------------------------------------------------------------===//
+
+  /// Generate the type of a DataRef
+  virtual mlir::Type genType(const Fortran::evaluate::DataRef &) = 0;
+  /// Generate the type of an Expr
+  virtual mlir::Type genType(const SomeExpr &) = 0;
+  /// Generate the type of a Symbol
+  virtual mlir::Type genType(SymbolRef) = 0;
+  /// Generate the type from a category
+  virtual mlir::Type genType(Fortran::common::TypeCategory tc) = 0;
+  /// Generate the type from a category and kind
+  virtual mlir::Type genType(Fortran::common::TypeCategory tc, int kind) = 0;
+  /// Generate the type from a Variable
+  virtual mlir::Type genType(const pft::Variable &) = 0;
+
+  //===--------------------------------------------------------------------===//
+  // Locations
+  //===--------------------------------------------------------------------===//
+
+  /// Get the converter's current location
+  virtual mlir::Location getCurrentLocation() = 0;
+  /// Generate a dummy location
+  virtual mlir::Location genLocation() = 0;
+  /// Generate the location as converted from a CharBlock
+  virtual mlir::Location genLocation(const Fortran::parser::CharBlock &) = 0;
+
+  //===--------------------------------------------------------------------===//
+  // FIR/MLIR
+  //===--------------------------------------------------------------------===//
+
+  /// Get the OpBuilder
+  virtual Fortran::lower::FirOpBuilder &getFirOpBuilder() = 0;
+  /// Get the ModuleOp
+  virtual mlir::ModuleOp &getModuleOp() = 0;
+  /// Get the MLIRContext
+  virtual mlir::MLIRContext &getMLIRContext() = 0;
+  /// Unique a symbol
+  virtual std::string mangleName(const Fortran::semantics::Symbol &) = 0;
+  /// Unique a compiler generated identifier. A short prefix should be provided
+  /// to hint at the origin of the identifier.
+  virtual std::string uniqueCGIdent(llvm::StringRef prefix,
+                                    llvm::StringRef name) = 0;
+
+  virtual ~AbstractConverter() = default;
+};
+
+} // namespace lower
+} // namespace Fortran
 
 #endif // FORTRAN_LOWER_ABSTRACTCONVERTER_H

flang/include/flang/Lower/Bridge.h

+/* empty stub for upstreaming */

flang/include/flang/Lower/Coarray.h

+//===-- Lower/Coarray.h -- image related 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_COARRAY_H
+#define FORTRAN_LOWER_COARRAY_H
+
+#include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/Support/BoxValue.h"
+
+namespace Fortran {
+
+namespace parser {
+struct ChangeTeamConstruct;
+struct ChangeTeamStmt;
+struct EndChangeTeamStmt;
+struct FormTeamStmt;
+} // namespace parser
+
+namespace evaluate {
+class CoarrayRef;
+} // namespace evaluate
+
+namespace lower {
+
+class SymMap;
+
+namespace pft {
+struct Evaluation;
+} // namespace pft
+
+//===----------------------------------------------------------------------===//
+// TEAM constructs
+//===----------------------------------------------------------------------===//
+
+void genChangeTeamConstruct(AbstractConverter &, pft::Evaluation &eval,
+                            const parser::ChangeTeamConstruct &);
+void genChangeTeamStmt(AbstractConverter &, pft::Evaluation &eval,
+                       const parser::ChangeTeamStmt &);
+void genEndChangeTeamStmt(AbstractConverter &, pft::Evaluation &eval,
+                          const parser::EndChangeTeamStmt &);
+void genFormTeamStatement(AbstractConverter &, pft::Evaluation &eval,
+                          const parser::FormTeamStmt &);
+
+//===----------------------------------------------------------------------===//
+// COARRAY expressions
+//===----------------------------------------------------------------------===//
+
+/// Coarray expression lowering helper. A coarray expression is expected to be
+/// lowered into runtime support calls. For example, expressions may use a
+/// message-passing runtime to access another image's data.
+class CoarrayExprHelper {
+public:
+  explicit CoarrayExprHelper(AbstractConverter &converter, mlir::Location loc,
+                             SymMap &syms)
+      : converter{converter}, symMap{syms}, loc{loc} {}
+  CoarrayExprHelper(const CoarrayExprHelper &) = delete;
+
+  /// Generate the address of a co-array expression.
+  ExValue genAddr(const evaluate::CoarrayRef &expr);
+
+  /// Generate the value of a co-array expression.
+  ExValue genValue(const evaluate::CoarrayRef &expr);
+
+private:
+  AbstractConverter &converter;
+  SymMap &symMap;
+  mlir::Location loc;
+};
+
+} // namespace lower
+} // namespace Fortran
+
+#endif // FORTRAN_LOWER_COARRAY_H

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/raw_ostream.h"
+#include <utility>
+#include <variant>
+
+namespace fir {
+struct CharBoxValue;
+struct ArrayBoxValue;
+struct CharArrayBoxValue;
+struct BoxValue;
+struct ProcBoxValue;
+
+llvm::raw_ostream &operator<<(llvm::raw_ostream &, const CharBoxValue &);
+llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ArrayBoxValue &);
+llvm::raw_ostream &operator<<(llvm::raw_ostream &, const CharArrayBoxValue &);
+llvm::raw_ostream &operator<<(llvm::raw_ostream &, const BoxValue &);
+llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ProcBoxValue &);
+
+//===----------------------------------------------------------------------===//
+//
+// Boxed values
+//
+// Define a set of containers to use internal to the lowering bridge to keep
+// track of extended values associated with a Fortran subexpression. These
+// associations are maintained during the construction of FIR.
+//
+//===----------------------------------------------------------------------===//
+
+/// Most expressions of intrinsic type can be passed unboxed. Their properties
+/// are known statically.
+using UnboxedValue = mlir::Value;
+
+/// Abstract base class.
+struct AbstractBox {
+  AbstractBox() = delete;
+  AbstractBox(mlir::Value addr) : addr{addr} {}
+  mlir::Value getAddr() const { return addr; }
+
+  mlir::Value addr;
+};
+
+/// Expressions of CHARACTER type have an associated, possibly dynamic LEN
+/// value.
+struct CharBoxValue : public AbstractBox {
+  CharBoxValue(mlir::Value addr, mlir::Value len)
+      : AbstractBox{addr}, len{len} {}
+
+  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; }
+
+  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
+/// indexing expressions.
+struct AbstractArrayBox {
+  AbstractArrayBox() = default;
+  AbstractArrayBox(llvm::ArrayRef<mlir::Value> extents,
+                   llvm::ArrayRef<mlir::Value> lbounds)
+      : extents{extents.begin(), extents.end()}, lbounds{lbounds.begin(),
+                                                         lbounds.end()} {}
+
+  // Every array has extents that describe its shape.
+  const llvm::SmallVectorImpl<mlir::Value> &getExtents() const {
+    return extents;
+  }
+
+  // An array expression may have user-defined lower bound values.
+  // If this vector is empty, the default in all dimensions in `1`.
+  const llvm::SmallVectorImpl<mlir::Value> &getLBounds() const {
+    return lbounds;
+  }
+
+  bool lboundsAllOne() const { return lbounds.empty(); }
+
+  llvm::SmallVector<mlir::Value, 4> extents;
+  llvm::SmallVector<mlir::Value, 4> lbounds;
+};
+
+/// Expressions with rank > 0 have extents. They may also have lbounds that are
+/// not 1.
+struct ArrayBoxValue : public AbstractBox, public AbstractArrayBox {
+  ArrayBoxValue(mlir::Value addr, llvm::ArrayRef<mlir::Value> extents,
+                llvm::ArrayRef<mlir::Value> lbounds = {})
+      : 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); }
+};
+
+/// Expressions of type CHARACTER and with rank > 0.
+struct CharArrayBoxValue : public CharBoxValue, public AbstractArrayBox {
+  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); }
+};
+
+/// Expressions that are procedure POINTERs may need a set of references to
+/// variables in the host scope.
+struct ProcBoxValue : public AbstractBox {
+  ProcBoxValue(mlir::Value addr, mlir::Value context)
+      : AbstractBox{addr}, hostContext{context} {}
+
+  ProcBoxValue clone(mlir::Value newBase) const {
+    return {newBase, hostContext};
+  }
+
+  friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
+                                       const ProcBoxValue &);
+  void dump() const { operator<<(llvm::errs(), *this); }
+
+  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.
+struct BoxValue : public AbstractBox, public AbstractArrayBox {
+  BoxValue(mlir::Value addr) : AbstractBox{addr}, AbstractArrayBox{} {}
+  BoxValue(mlir::Value addr, mlir::Value len)
+      : AbstractBox{addr}, AbstractArrayBox{}, len{len} {}
+  BoxValue(mlir::Value addr, llvm::ArrayRef<mlir::Value> extents,
+           llvm::ArrayRef<mlir::Value> lbounds = {})
+      : AbstractBox{addr}, AbstractArrayBox{extents, lbounds} {}
+  BoxValue(mlir::Value addr, mlir::Value len,
+           llvm::ArrayRef<mlir::Value> params,
+           llvm::ArrayRef<mlir::Value> extents,
+           llvm::ArrayRef<mlir::Value> lbounds = {})
+      : AbstractBox{addr}, AbstractArrayBox{extents, lbounds}, len{len},
+        params{params.begin(), params.end()} {}
+
+  BoxValue clone(mlir::Value newBase) const {
+    return {newBase, len, params, extents, lbounds};
+  }
+
+  friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const BoxValue &);
+  void dump() const { operator<<(llvm::errs(), *this); }
+
+  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>;
+
+class ExtendedValue;
+
+mlir::Value getBase(const ExtendedValue &exv);
+llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ExtendedValue &);
+ExtendedValue substBase(const ExtendedValue &exv, mlir::Value base);
+
+/// An extended value is a box of values pertaining to a discrete entity. It is
+/// used in lowering to track all the runtime values related to an entity. For
+/// example, an entity may have an address in memory that contains its value(s)
+/// as well as various attribute values that describe the shape and starting
+/// indices if it is an array entity.
+class ExtendedValue {
+public:
+  template <typename A>
+  constexpr ExtendedValue(A &&box) : box{std::forward<A>(box)} {}
+
+  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'; }
+
+  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
+
+namespace Fortran::lower {
+
+using ExValue = fir::ExtendedValue;
+
+} // namespace Fortran::lower
+
+#endif // LOWER_SUPPORT_BOXVALUE_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
+  Coarray.cpp
   ComplexExpr.cpp
   ConvertType.cpp
   DoLoopHelper.cpp
   Mangler.cpp
   OpenMP.cpp
   PFTBuilder.cpp
 
   DEPENDS

flang/lib/Lower/Coarray.cpp

+//===-- Coarray.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
+//
+//===----------------------------------------------------------------------===//
+///
+/// Implementation of the lowering of image related constructs and expressions.
+/// Fortran images can form teams, communicate via coarrays, etc.
+///
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/Coarray.h"
+#include "RTBuilder.h"
+#include "SymbolMap.h"
+#include "flang/Lower/Bridge.h"
+#include "flang/Lower/FIRBuilder.h"
+#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/expression.h"
+
+#undef TODO
+#define TODO(MSG)                                                              \
+  {                                                                            \
+    mlir::emitError(converter.getCurrentLocation(), "not yet implemented")     \
+        << MSG;                                                                \
+    exit(1);                                                                   \
+  }
+
+//===----------------------------------------------------------------------===//
+// TEAM statements and constructs
+//===----------------------------------------------------------------------===//
+
+void Fortran::lower::genChangeTeamConstruct(
+    Fortran::lower::AbstractConverter &converter,
+    Fortran::lower::pft::Evaluation &,
+    const Fortran::parser::ChangeTeamConstruct &) {
+  TODO("CHANGE TEAM construct");
+}
+
+void Fortran::lower::genChangeTeamStmt(
+    Fortran::lower::AbstractConverter &converter,
+    Fortran::lower::pft::Evaluation &,
+    const Fortran::parser::ChangeTeamStmt &) {
+  TODO("CHANGE TEAM stmt");
+}
+
+void Fortran::lower::genEndChangeTeamStmt(
+    Fortran::lower::AbstractConverter &converter,
+    Fortran::lower::pft::Evaluation &,
+    const Fortran::parser::EndChangeTeamStmt &) {
+  TODO("END CHANGE TEAM");
+}
+
+void Fortran::lower::genFormTeamStatement(
+    Fortran::lower::AbstractConverter &converter,
+    Fortran::lower::pft::Evaluation &, const Fortran::parser::FormTeamStmt &) {
+  TODO("FORM TEAM");
+}
+
+//===----------------------------------------------------------------------===//
+// COARRAY expressions
+//===----------------------------------------------------------------------===//
+
+Fortran::lower::ExValue Fortran::lower::CoarrayExprHelper::genAddr(
+    const Fortran::evaluate::CoarrayRef &expr) {
+  TODO("co-array address");
+}
+
+Fortran::lower::ExValue Fortran::lower::CoarrayExprHelper::genValue(
+    const Fortran::evaluate::CoarrayRef &expr) {
+  TODO("co-array value");
+}

flang/lib/Lower/RTBuilder.h

+//===-- RTBuilder.h ---------------------------------------------*- 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
+/// This file defines some C++17 template classes that are used to convert the
+/// signatures of plain old C functions into a model that can be used to
+/// generate MLIR calls to those functions. This can be used to autogenerate
+/// tables at compiler compile-time to call runtime support code.
+///
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_RTBUILDER_H
+#define FORTRAN_LOWER_RTBUILDER_H
+
+#include "flang/Lower/ConvertType.h"
+#include "flang/Optimizer/Dialect/FIRType.h"
+#include "mlir/IR/MLIRContext.h"
+#include "mlir/IR/StandardTypes.h"
+#include "llvm/ADT/SmallVector.h"
+#include <functional>
+
+// List the runtime headers we want to be able to dissect
+#include "../../runtime/io-api.h"
+
+namespace Fortran::lower {
+
+using TypeBuilderFunc = mlir::Type (*)(mlir::MLIRContext *);
+using FuncTypeBuilderFunc = mlir::FunctionType (*)(mlir::MLIRContext *);
+
+/// Return a function that returns the type signature model for the type `T`
+/// when provided an MLIRContext*. This allows one to translate C(++) function
+/// signatures from runtime header files to MLIR signatures into a static table
+/// at compile-time.
+///
+/// For example, when `T` is `int`, return a function that returns the MLIR
+/// standard type `i32` when `sizeof(int)` is 4.
+template <typename T>
+static constexpr TypeBuilderFunc getModel();
+template <>
+constexpr TypeBuilderFunc getModel<int>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(8 * sizeof(int), context);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<int &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<int>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<Fortran::runtime::io::Iostat>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(8 * sizeof(Fortran::runtime::io::Iostat),
+                                  context);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<char *>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::ReferenceType::get(mlir::IntegerType::get(8, context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const char *>() {
+  return getModel<char *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<const char16_t *>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::ReferenceType::get(mlir::IntegerType::get(16, context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const char32_t *>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::ReferenceType::get(mlir::IntegerType::get(32, context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<void **>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::ReferenceType::get(
+        fir::PointerType::get(mlir::IntegerType::get(8, context)));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<std::int64_t>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(64, context);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<std::int64_t &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<std::int64_t>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<std::size_t>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(8 * sizeof(std::size_t), context);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<Fortran::runtime::io::IoStatementState *>() {
+  return getModel<char *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<double>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::FloatType::getF64(context);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<double &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<double>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<float>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::FloatType::getF32(context);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<float &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<float>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<bool>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(1, context);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<bool &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<bool>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+
+template <>
+constexpr TypeBuilderFunc getModel<float _Complex>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::CplxType::get(context, sizeof(float));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<double _Complex>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::CplxType::get(context, sizeof(double));
+  };
+}
+
+template <>
+constexpr TypeBuilderFunc getModel<const Fortran::runtime::Descriptor &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::BoxType::get(mlir::NoneType::get(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const Fortran::runtime::NamelistGroup &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    // FIXME: a namelist group must be some well-defined data structure, use a
+    // tuple as a proxy for the moment
+    return mlir::TupleType::get(llvm::None, context);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<void>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::NoneType::get(context);
+  };
+}
+
+template <typename...>
+struct RuntimeTableKey;
+template <typename RT, typename... ATs>
+struct RuntimeTableKey<RT(ATs...)> {
+  static constexpr FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctxt) {
+      TypeBuilderFunc ret = getModel<RT>();
+      std::array<TypeBuilderFunc, sizeof...(ATs)> args = {getModel<ATs>()...};
+      mlir::Type retTy = ret(ctxt);
+      llvm::SmallVector<mlir::Type, sizeof...(ATs)> argTys;
+      for (auto f : args)
+        argTys.push_back(f(ctxt));
+      return mlir::FunctionType::get(argTys, {retTy}, ctxt);
+    };
+  }
+};
+
+#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() {
+  return {};
+}
+
+#if defined(__clang__)
+#pragma clang diagnostic pop
+#endif
+
+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)
+#define mkKey(X)                                                               \
+  Fortran::lower::RuntimeTableEntry<                                           \
+      Fortran::lower::RuntimeTableKey<decltype(X)>, decltype(ExpandKey(X))>
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_RTBUILDER_H

flang/lib/Lower/SymbolMap.h

+//===-- SymbolMap.h -- lowering internal symbol map -------------*- 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_SYMBOLMAP_H
+#define FORTRAN_LOWER_SYMBOLMAP_H
+
+#include "flang/Common/idioms.h"
+#include "flang/Common/reference.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"
+
+namespace Fortran::lower {
+
+/// A dictionary entry of ssa-values that together compose a variable referenced
+/// by a Symbol. For example, the declaration
+///
+///   CHARACTER(LEN=i) :: c(j1,j2)
+///
+/// is a single variable `c`. This variable is a two-dimensional array of
+/// CHARACTER. It has a starting address and three dynamic properties: the LEN
+/// parameter `i` a runtime value describing the length of the CHARACTER, and
+/// the `j1` and `j2` runtime values, which describe the shape of the array.
+///
+/// The lowering bridge needs to be able to record all four of these ssa-values
+/// in the lookup table to be able to correctly lower Fortran to FIR.
+struct SymbolBox {
+  // For lookups that fail, have a monostate
+  using None = std::monostate;
+
+  // Trivial intrinsic type
+  using Intrinsic = fir::AbstractBox;
+
+  // Array variable that uses bounds notation
+  using FullDim = fir::ArrayBoxValue;
+
+  // CHARACTER type variable with its dependent type LEN parameter
+  using Char = fir::CharBoxValue;
+
+  // CHARACTER array variable using bounds notation
+  using CharFullDim = fir::CharArrayBoxValue;
+
+  // Generalized derived type variable
+  using Derived = fir::BoxValue;
+
+  //===--------------------------------------------------------------------===//
+  // Constructors
+  //===--------------------------------------------------------------------===//
+
+  SymbolBox() : box{None{}} {}
+  template <typename A>
+  SymbolBox(const A &x) : box{x} {}
+
+  operator bool() const { return !std::holds_alternative<None>(box); }
+  operator mlir::Value() const { return getAddr(); }
+
+  //===--------------------------------------------------------------------===//
+  // Accessors
+  //===--------------------------------------------------------------------===//
+
+  mlir::Value getAddr() const {
+    return std::visit(common::visitors{
+                          [](const None &) { return mlir::Value{}; },
+                          [](const auto &x) { return x.addr; },
+                      },
+                      box);
+  }
+
+  llvm::Optional<mlir::Value> getCharLen() const {
+    using T = llvm::Optional<mlir::Value>;
+    return std::visit(common::visitors{
+                          [](const Char &x) { return T{x.len}; },
+                          [](const CharFullDim &x) { return T{x.len}; },
+                          [](const auto &) { return T{}; },
+                      },
+                      box);
+  }
+
+  bool isIntrinsic() const {
+    return std::visit(common::visitors{
+                          [](const Intrinsic &) { return true; },
+                          [](const Char &) { return true; },
+                          [](const auto &x) { return false; },
+                      },
+                      box);
+  }
+
+  bool hasRank() const {
+    return std::visit(common::visitors{
+                          [](const Intrinsic &) { return false; },
+                          [](const Char &) { return false; },
+                          [](const None &) { return false; },
+                          [](const auto &x) { return x.extents.size() > 0; },
+                      },
+                      box);
+  }
+
+  bool hasSimpleLBounds() const {
+    if (auto *arr = std::get_if<FullDim>(&box))
+      return arr->lbounds.empty();
+    if (auto *arr = std::get_if<CharFullDim>(&box))
+      return arr->lbounds.empty();
+    if (auto *arr = std::get_if<Derived>(&box))
+      return (arr->extents.size() > 0) && arr->lbounds.empty();
+    return false;
+  }
+
+  bool hasConstantShape() const {
+    if (auto eleTy = fir::dyn_cast_ptrEleTy(getAddr().getType()))
+      if (auto arrTy = eleTy.dyn_cast<fir::SequenceType>())
+        return arrTy.hasConstantShape();
+    return false;
+  }
+
+  /// Get the lbound if the box explicitly contains it.
+  mlir::Value getLBound(unsigned dim) const {
+    return std::visit(
+        common::visitors{[&](const FullDim &box) {
+                           assert(dim < box.lbounds.size());
+                           return box.lbounds[dim];
+                         },
+                         [&](const CharFullDim &box) {
+                           assert(dim < box.lbounds.size());
+                           return box.lbounds[dim];
+                         },
+                         [&](const Derived &box) {
+                           assert(dim < box.lbounds.size());
+                           return box.lbounds[dim];
+                         },
+                         [](const auto &) { return mlir::Value{}; }},
+        box);
+  }
+
+  template <typename ON, typename RT>
+  constexpr RT apply(RT(&&func)(const ON &)) const {
+    if (auto *x = std::get_if<ON>(&box))
+      return func(*x);
+    return RT{};
+  }
+
+  std::variant<Intrinsic, FullDim, Char, CharFullDim, Derived, None> box;
+};
+
+/// Helper class to map front-end symbols to their MLIR representation. This
+/// provides a way to lookup the ssa-values that comprise a Fortran symbol's
+/// runtime attributes. These attributes include its address, its dynamic size,
+/// dynamic bounds information for non-scalar entities, dynamic type parameters,
+/// etc.
+class SymMap {
+public:
+  /// Add a trivial symbol mapping to an address.
+  void addSymbol(semantics::SymbolRef sym, mlir::Value value,
+                 bool force = false) {
+    makeSym(sym, SymbolBox::Intrinsic(value), force);
+  }
+
+  /// Add a scalar CHARACTER mapping to an (address, len).
+  void addCharSymbol(semantics::SymbolRef sym, mlir::Value value,
+                     mlir::Value len, bool force = false) {
+    makeSym(sym, SymbolBox::Char(value, len), force);
+  }
+
+  /// Add an array mapping with (address, shape).
+  void addSymbolWithShape(semantics::SymbolRef sym, mlir::Value value,
+                          llvm::ArrayRef<mlir::Value> shape,
+                          bool force = false) {
+    makeSym(sym, SymbolBox::FullDim(value, shape), force);
+  }
+
+  /// Add an array of CHARACTER mapping.
+  void addCharSymbolWithShape(semantics::SymbolRef sym, mlir::Value value,
+                              mlir::Value len,
+                              llvm::ArrayRef<mlir::Value> shape,
+                              bool force = false) {
+    makeSym(sym, SymbolBox::CharFullDim(value, len, shape), force);
+  }
+
+  /// Add an array mapping with bounds notation.
+  void addSymbolWithBounds(semantics::SymbolRef sym, mlir::Value value,
+                           llvm::ArrayRef<mlir::Value> extents,
+                           llvm::ArrayRef<mlir::Value> lbounds,
+                           bool force = false) {
+    makeSym(sym, SymbolBox::FullDim(value, extents, lbounds), force);
+  }
+
+  /// Add an array of CHARACTER with bounds notation.
+  void addCharSymbolWithBounds(semantics::SymbolRef sym, mlir::Value value,
+                               mlir::Value len,
+                               llvm::ArrayRef<mlir::Value> extents,
+                               llvm::ArrayRef<mlir::Value> lbounds,
+                               bool force = false) {
+    makeSym(sym, SymbolBox::CharFullDim(value, len, extents, lbounds), force);
+  }
+
+  /// Generalized derived type mapping.
+  void addDerivedSymbol(semantics::SymbolRef sym, mlir::Value value,
+                        mlir::Value size, llvm::ArrayRef<mlir::Value> extents,
+                        llvm::ArrayRef<mlir::Value> lbounds,
+                        llvm::ArrayRef<mlir::Value> params,
+                        bool force = false) {
+    makeSym(sym, SymbolBox::Derived(value, size, params, extents, lbounds),
+            force);
+  }
+
+  /// Find `symbol` and return its value if it appears in the current mappings.
+  SymbolBox lookupSymbol(semantics::SymbolRef sym) {
+    auto iter = symbolMap.find(&*sym);
+    return (iter == symbolMap.end()) ? SymbolBox() : iter->second;
+  }
+
+  void erase(semantics::SymbolRef sym) { symbolMap.erase(&*sym); }
+
+  void clear() { symbolMap.clear(); }
+
+  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");
+    symbolMap.try_emplace(&*sym, box);
+  }
+
+  llvm::DenseMap<const semantics::Symbol *, SymbolBox> symbolMap;
+};
+
+} // namespace Fortran::lower
+
+#endif // FORTRAN_LOWER_SYMBOL_H