[fir] Add character utility functions in FIRBuilder

Extract part of D111337 in order to mke it smaller
and easier to review. This patch add some utility
functions to the FIRBuilder.

Add the following utility functions:
- getCharacterLengthType
- createStringLiteral
- locationToFilename
- characterWithDynamicLen
- sequenceWithNonConstantShape
- hasDynamicSize

These bring up the BoxValue implementation together with it.

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

Reviewed By: AlexisPerry

Differential Revision: https://reviews.llvm.org/D112074

Co-authored-by: Jean Perier <[email protected]>
Co-authored-by: Eric Schweitz <[email protected]>

Author: 3 people

flang/include/flang/Optimizer/Builder/BoxValue.h

@@ -23,6 +23,7 @@
 #include "mlir/IR/BuiltinOps.h"
 
 namespace fir {
+class ExtendedValue;
 
 //===----------------------------------------------------------------------===//
 // FirOpBuilder
@@ -55,6 +56,9 @@ class FirOpBuilder : public mlir::OpBuilder {
   /// Create a sequence of `eleTy` with `rank` dimensions of unknown size.
   mlir::Type getVarLenSeqTy(mlir::Type eleTy, unsigned rank = 1);
 
+  /// Get character length type
+  mlir::Type getCharacterLengthType() { return getIndexType(); }
+
   /// Get the integer type whose bit width corresponds to the width of pointer
   /// types, or is bigger.
   mlir::Type getIntPtrType() {
@@ -266,9 +270,14 @@ class FirOpBuilder : public mlir::OpBuilder {
 
 namespace fir::factory {
 
-//===--------------------------------------------------------------------===//
+//===----------------------------------------------------------------------===//
 // String literal helper helpers
-//===--------------------------------------------------------------------===//
+//===----------------------------------------------------------------------===//
+
+/// Create a !fir.char<1> string literal global and returns a
+/// fir::CharBoxValue with its address and length.
+fir::ExtendedValue createStringLiteral(fir::FirOpBuilder &, mlir::Location,
+                                       llvm::StringRef string);
 
 /// Unique a compiler generated identifier. A short prefix should be provided
 /// to hint at the origin of the identifier.
@@ -278,6 +287,9 @@ std::string uniqueCGIdent(llvm::StringRef prefix, llvm::StringRef name);
 // Location helpers
 //===----------------------------------------------------------------------===//
 
+/// Generate a string literal containing the file name and return its address
+mlir::Value locationToFilename(fir::FirOpBuilder &, mlir::Location);
+
 /// Generate a constant of the given type with the location line number
 mlir::Value locationToLineNo(fir::FirOpBuilder &, mlir::Location, mlir::Type);
 

flang/include/flang/Optimizer/Builder/FIRBuilder.h

@@ -138,6 +138,22 @@ inline bool isa_char_string(mlir::Type t) {
 /// of unknown rank or type.
 bool isa_unknown_size_box(mlir::Type t);
 
+/// Returns true iff `t` is a fir.char type and has an unknown length.
+inline bool characterWithDynamicLen(mlir::Type t) {
+  if (auto charTy = t.dyn_cast<fir::CharacterType>())
+    return charTy.hasDynamicLen();
+  return false;
+}
+
+/// Returns true iff `seqTy` has either an unknown shape or a non-constant shape
+/// (where rank > 0).
+inline bool sequenceWithNonConstantShape(fir::SequenceType seqTy) {
+  return seqTy.hasUnknownShape() || !seqTy.hasConstantShape();
+}
+
+/// Returns true iff the type `t` does not have a constant size.
+bool hasDynamicSize(mlir::Type t);
+
 /// If `t` is a SequenceType return its element type, otherwise return `t`.
 inline mlir::Type unwrapSequenceType(mlir::Type t) {
   if (auto seqTy = t.dyn_cast<fir::SequenceType>())

flang/include/flang/Optimizer/Dialect/FIRType.h

@@ -0,0 +1,35 @@
+//===-- Optimizer/Support/Matcher.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
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_OPTIMIZER_SUPPORT_MATCHER_H
+#define FORTRAN_OPTIMIZER_SUPPORT_MATCHER_H
+
+#include <variant>
+
+// Boilerplate CRTP class for a simplified type-casing syntactic sugar. This
+// lets one write pattern matchers using a more compact syntax.
+namespace fir::details {
+// clang-format off
+template<class... Ts> struct matches : Ts... { using Ts::operator()...; };
+template<class... Ts> matches(Ts...) -> matches<Ts...>;
+template<typename N> struct matcher {
+  template<typename... Ts> auto match(Ts... ts) {
+    return std::visit(matches{ts...}, static_cast<N*>(this)->matchee());
+  }
+  template<typename... Ts> auto match(Ts... ts) const {
+    return std::visit(matches{ts...}, static_cast<N const*>(this)->matchee());
+  }
+};
+// clang-format on
+} // namespace fir::details
+
+#endif // FORTRAN_OPTIMIZER_SUPPORT_MATCHER_H

flang/include/flang/Optimizer/Support/Matcher.h

@@ -0,0 +1,228 @@
+//===-- BoxValue.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
+//
+//===----------------------------------------------------------------------===//
+//
+// Pretty printers for box values, etc.
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Optimizer/Builder/BoxValue.h"
+#include "mlir/IR/BuiltinTypes.h"
+#include "llvm/Support/Debug.h"
+
+#define DEBUG_TYPE "flang-box-value"
+
+mlir::Value fir::getBase(const fir::ExtendedValue &exv) {
+  return exv.match([](const fir::UnboxedValue &x) { return x; },
+                   [](const auto &x) { return x.getAddr(); });
+}
+
+mlir::Value fir::getLen(const fir::ExtendedValue &exv) {
+  return exv.match(
+      [](const fir::CharBoxValue &x) { return x.getLen(); },
+      [](const fir::CharArrayBoxValue &x) { return x.getLen(); },
+      [](const fir::BoxValue &) -> mlir::Value {
+        llvm::report_fatal_error("Need to read len from BoxValue Exv");
+      },
+      [](const fir::MutableBoxValue &) -> mlir::Value {
+        llvm::report_fatal_error("Need to read len from MutableBoxValue Exv");
+      },
+      [](const auto &) { return mlir::Value{}; });
+}
+
+fir::ExtendedValue fir::substBase(const fir::ExtendedValue &exv,
+                                  mlir::Value base) {
+  return exv.match(
+      [=](const fir::UnboxedValue &x) { return fir::ExtendedValue(base); },
+      [=](const fir::BoxValue &) -> fir::ExtendedValue {
+        llvm::report_fatal_error("TODO: substbase of BoxValue");
+      },
+      [=](const fir::MutableBoxValue &) -> fir::ExtendedValue {
+        llvm::report_fatal_error("TODO: substbase of MutableBoxValue");
+      },
+      [=](const auto &x) { return fir::ExtendedValue(x.clone(base)); });
+}
+
+llvm::SmallVector<mlir::Value> fir::getTypeParams(const ExtendedValue &exv) {
+  using RT = llvm::SmallVector<mlir::Value>;
+  auto baseTy = fir::getBase(exv).getType();
+  if (auto t = fir::dyn_cast_ptrEleTy(baseTy))
+    baseTy = t;
+  baseTy = fir::unwrapSequenceType(baseTy);
+  if (!fir::hasDynamicSize(baseTy))
+    return {}; // type has constant size, no type parameters needed
+  [[maybe_unused]] auto loc = fir::getBase(exv).getLoc();
+  return exv.match(
+      [](const fir::CharBoxValue &x) -> RT { return {x.getLen()}; },
+      [](const fir::CharArrayBoxValue &x) -> RT { return {x.getLen()}; },
+      [&](const fir::BoxValue &) -> RT {
+        LLVM_DEBUG(mlir::emitWarning(
+            loc, "TODO: box value is missing type parameters"));
+        return {};
+      },
+      [&](const fir::MutableBoxValue &) -> RT {
+        // In this case, the type params may be bound to the variable in an
+        // ALLOCATE statement as part of a type-spec.
+        LLVM_DEBUG(mlir::emitWarning(
+            loc, "TODO: mutable box value is missing type parameters"));
+        return {};
+      },
+      [](const auto &) -> RT { return {}; });
+}
+
+bool fir::isArray(const fir::ExtendedValue &exv) {
+  return exv.match(
+      [](const fir::ArrayBoxValue &) { return true; },
+      [](const fir::CharArrayBoxValue &) { return true; },
+      [](const fir::BoxValue &box) { return box.hasRank(); },
+      [](const fir::MutableBoxValue &box) { return box.hasRank(); },
+      [](auto) { return false; });
+}
+
+llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
+                                   const fir::CharBoxValue &box) {
+  return os << "boxchar { addr: " << box.getAddr() << ", len: " << box.getLen()
+            << " }";
+}
+
+llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
+                                   const fir::ArrayBoxValue &box) {
+  os << "boxarray { addr: " << box.getAddr();
+  if (box.getLBounds().size()) {
+    os << ", lbounds: [";
+    llvm::interleaveComma(box.getLBounds(), os);
+    os << "]";
+  } else {
+    os << ", lbounds: all-ones";
+  }
+  os << ", shape: [";
+  llvm::interleaveComma(box.getExtents(), os);
+  return os << "]}";
+}
+
+llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
+                                   const fir::CharArrayBoxValue &box) {
+  os << "boxchararray { addr: " << box.getAddr() << ", len : " << box.getLen();
+  if (box.getLBounds().size()) {
+    os << ", lbounds: [";
+    llvm::interleaveComma(box.getLBounds(), os);
+    os << "]";
+  } else {
+    os << " lbounds: all-ones";
+  }
+  os << ", shape: [";
+  llvm::interleaveComma(box.getExtents(), os);
+  return os << "]}";
+}
+
+llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
+                                   const fir::ProcBoxValue &box) {
+  return os << "boxproc: { procedure: " << box.getAddr()
+            << ", context: " << box.hostContext << "}";
+}
+
+llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
+                                   const fir::BoxValue &box) {
+  os << "box: { value: " << box.getAddr();
+  if (box.lbounds.size()) {
+    os << ", lbounds: [";
+    llvm::interleaveComma(box.lbounds, os);
+    os << "]";
+  }
+  if (!box.explicitParams.empty()) {
+    os << ", explicit type params: [";
+    llvm::interleaveComma(box.explicitParams, os);
+    os << "]";
+  }
+  if (!box.extents.empty()) {
+    os << ", explicit extents: [";
+    llvm::interleaveComma(box.extents, os);
+    os << "]";
+  }
+  return os << "}";
+}
+
+llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
+                                   const fir::MutableBoxValue &box) {
+  os << "mutablebox: { addr: " << box.getAddr();
+  if (!box.lenParams.empty()) {
+    os << ", non deferred type params: [";
+    llvm::interleaveComma(box.lenParams, os);
+    os << "]";
+  }
+  const auto &properties = box.mutableProperties;
+  if (!properties.isEmpty()) {
+    os << ", mutableProperties: { addr: " << properties.addr;
+    if (!properties.lbounds.empty()) {
+      os << ", lbounds: [";
+      llvm::interleaveComma(properties.lbounds, os);
+      os << "]";
+    }
+    if (!properties.extents.empty()) {
+      os << ", shape: [";
+      llvm::interleaveComma(properties.extents, os);
+      os << "]";
+    }
+    if (!properties.deferredParams.empty()) {
+      os << ", deferred type params: [";
+      llvm::interleaveComma(properties.deferredParams, os);
+      os << "]";
+    }
+    os << "}";
+  }
+  return os << "}";
+}
+
+llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
+                                   const fir::ExtendedValue &exv) {
+  exv.match([&](const auto &value) { os << value; });
+  return os;
+}
+
+/// Debug verifier for MutableBox ctor. There is no guarantee that this will
+/// always be called, so it should not have any functional side effects,
+/// the const is here to enforce that.
+bool fir::MutableBoxValue::verify() const {
+  auto type = fir::dyn_cast_ptrEleTy(getAddr().getType());
+  if (!type)
+    return false;
+  auto box = type.dyn_cast<fir::BoxType>();
+  if (!box)
+    return false;
+  auto eleTy = box.getEleTy();
+  if (!eleTy.isa<fir::PointerType>() && !eleTy.isa<fir::HeapType>())
+    return false;
+
+  auto nParams = lenParams.size();
+  if (isCharacter()) {
+    if (nParams > 1)
+      return false;
+  } else if (!isDerived()) {
+    if (nParams != 0)
+      return false;
+  }
+  return true;
+}
+
+/// Debug verifier for BoxValue ctor. There is no guarantee this will
+/// always be called.
+bool fir::BoxValue::verify() const {
+  if (!addr.getType().isa<fir::BoxType>())
+    return false;
+  if (!lbounds.empty() && lbounds.size() != rank())
+    return false;
+  // Explicit extents are here to cover cases where an explicit-shape dummy
+  // argument comes as a fir.box. This can only happen with derived types and
+  // unlimited polymorphic.
+  if (!extents.empty() && !(isDerived() || isUnlimitedPolymorphic()))
+    return false;
+  if (!extents.empty() && extents.size() != rank())
+    return false;
+  if (isCharacter() && explicitParams.size() > 1)
+    return false;
+  return true;
+}

flang/lib/Optimizer/Builder/BoxValue.cpp

@@ -1,5 +1,6 @@
 get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 add_flang_library(FIRBuilder
+  BoxValue.cpp
   DoLoopHelper.cpp
   FIRBuilder.cpp
 

flang/lib/Optimizer/Builder/CMakeLists.txt

@@ -7,6 +7,7 @@
 //===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Builder/BoxValue.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Optimizer/Support/FatalError.h"
 #include "flang/Optimizer/Support/InternalNames.h"
@@ -207,10 +208,41 @@ std::string fir::factory::uniqueCGIdent(llvm::StringRef prefix,
       nm.append(".").append(llvm::toHex(name)));
 }
 
+mlir::Value fir::factory::locationToFilename(fir::FirOpBuilder &builder,
+                                             mlir::Location loc) {
+  if (auto flc = loc.dyn_cast<mlir::FileLineColLoc>()) {
+    // must be encoded as asciiz, C string
+    auto fn = flc.getFilename().str() + '\0';
+    return fir::getBase(createStringLiteral(builder, loc, fn));
+  }
+  return builder.createNullConstant(loc);
+}
+
 mlir::Value fir::factory::locationToLineNo(fir::FirOpBuilder &builder,
                                            mlir::Location loc,
                                            mlir::Type type) {
   if (auto flc = loc.dyn_cast<mlir::FileLineColLoc>())
     return builder.createIntegerConstant(loc, type, flc.getLine());
   return builder.createIntegerConstant(loc, type, 0);
 }
+
+fir::ExtendedValue fir::factory::createStringLiteral(fir::FirOpBuilder &builder,
+                                                     mlir::Location loc,
+                                                     llvm::StringRef str) {
+  std::string globalName = fir::factory::uniqueCGIdent("cl", str);
+  auto type = fir::CharacterType::get(builder.getContext(), 1, str.size());
+  auto global = builder.getNamedGlobal(globalName);
+  if (!global)
+    global = builder.createGlobalConstant(
+        loc, type, globalName,
+        [&](fir::FirOpBuilder &builder) {
+          auto stringLitOp = builder.createStringLitOp(loc, str);
+          builder.create<fir::HasValueOp>(loc, stringLitOp);
+        },
+        builder.createLinkOnceLinkage());
+  auto addr = builder.create<fir::AddrOfOp>(loc, global.resultType(),
+                                            global.getSymbol());
+  auto len = builder.createIntegerConstant(
+      loc, builder.getCharacterLengthType(), str.size());
+  return fir::CharBoxValue{addr, len};
+}