[flang] Lower basic function with scalar integer/logical return value

This patch allows the lowring of simple empty function with a
scalar integer or logical return value.
The code in ConvertType.cpp is cleaned up as well. This file was landed
together with the initial flang push and lowering was still a prototype
at that time. Some more cleaning will come with follow up patches.

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

Reviewed By: PeteSteinfeld

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

Co-authored-by: Jean Perier <jperier@nvidia.com>

1 files changed, 122 insertions, 185 deletions

diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 8900ce3..ca34947 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -9,6 +9,7 @@
 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/AbstractConverter.h"
 #include "flang/Lower/PFTBuilder.h"
+#include "flang/Lower/Todo.h"
 #include "flang/Lower/Utils.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
 #include "flang/Semantics/tools.h"
@@ -16,15 +17,61 @@
 #include "mlir/IR/Builders.h"
 #include "mlir/IR/BuiltinTypes.h"
 
-#undef QUOTE
-#undef TODO
-#define QUOTE(X) #X
-#define TODO(S)                                                                \
-  {                                                                            \
-    emitError(__FILE__ ":" QUOTE(__LINE__) ": type lowering of " S             \
-                                           " not implemented");                \
-    exit(1);                                                                   \
+#define DEBUG_TYPE "flang-lower-type"
+
+//===--------------------------------------------------------------------===//
+// Intrinsic type translation helpers
+//===--------------------------------------------------------------------===//
+
+template <int KIND>
+int getIntegerBits() {
+  return Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
+                                 KIND>::Scalar::bits;
+}
+static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind) {
+  if (Fortran::evaluate::IsValidKindOfIntrinsicType(
+          Fortran::common::TypeCategory::Integer, kind)) {
+    switch (kind) {
+    case 1:
+      return mlir::IntegerType::get(context, getIntegerBits<1>());
+    case 2:
+      return mlir::IntegerType::get(context, getIntegerBits<2>());
+    case 4:
+      return mlir::IntegerType::get(context, getIntegerBits<4>());
+    case 8:
+      return mlir::IntegerType::get(context, getIntegerBits<8>());
+    case 16:
+      return mlir::IntegerType::get(context, getIntegerBits<16>());
+    }
+  }
+  llvm_unreachable("INTEGER kind not translated");
+}
+
+static mlir::Type genLogicalType(mlir::MLIRContext *context, int KIND) {
+  if (Fortran::evaluate::IsValidKindOfIntrinsicType(
+          Fortran::common::TypeCategory::Logical, KIND))
+    return fir::LogicalType::get(context, KIND);
+  return {};
+}
+
+static mlir::Type genFIRType(mlir::MLIRContext *context,
+                             Fortran::common::TypeCategory tc, int kind) {
+  switch (tc) {
+  case Fortran::common::TypeCategory::Real:
+    TODO_NOLOC("genFIRType Real");
+  case Fortran::common::TypeCategory::Integer:
+    return genIntegerType(context, kind);
+  case Fortran::common::TypeCategory::Complex:
+    TODO_NOLOC("genFIRType Complex");
+  case Fortran::common::TypeCategory::Logical:
+    return genLogicalType(context, kind);
+  case Fortran::common::TypeCategory::Character:
+    TODO_NOLOC("genFIRType Character");
+  default:
+    break;
   }
+  llvm_unreachable("unhandled type category");
+}
 
 template <typename A>
 bool isConstant(const Fortran::evaluate::Expr<A> &e) {
@@ -122,38 +169,6 @@ genFIRType<Fortran::common::TypeCategory::Real>(mlir::MLIRContext *context,
 
 template <>
 mlir::Type
-genFIRType<Fortran::common::TypeCategory::Integer>(mlir::MLIRContext *context,
-                                                   int kind) {
-  if (Fortran::evaluate::IsValidKindOfIntrinsicType(
-          Fortran::common::TypeCategory::Integer, kind)) {
-    switch (kind) {
-    case 1:
-      return genFIRType<Fortran::common::TypeCategory::Integer, 1>(context);
-    case 2:
-      return genFIRType<Fortran::common::TypeCategory::Integer, 2>(context);
-    case 4:
-      return genFIRType<Fortran::common::TypeCategory::Integer, 4>(context);
-    case 8:
-      return genFIRType<Fortran::common::TypeCategory::Integer, 8>(context);
-    case 16:
-      return genFIRType<Fortran::common::TypeCategory::Integer, 16>(context);
-    }
-  }
-  llvm_unreachable("INTEGER type translation not implemented");
-}
-
-template <>
-mlir::Type
-genFIRType<Fortran::common::TypeCategory::Logical>(mlir::MLIRContext *context,
-                                                   int KIND) {
-  if (Fortran::evaluate::IsValidKindOfIntrinsicType(
-          Fortran::common::TypeCategory::Logical, KIND))
-    return fir::LogicalType::get(context, KIND);
-  return {};
-}
-
-template <>
-mlir::Type
 genFIRType<Fortran::common::TypeCategory::Character>(mlir::MLIRContext *context,
                                                      int KIND) {
   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
@@ -179,7 +194,54 @@ namespace {
 class TypeBuilder {
 public:
   TypeBuilder(Fortran::lower::AbstractConverter &converter)
-      : context{&converter.getMLIRContext()} {}
+      : converter{converter}, context{&converter.getMLIRContext()} {}
+
+  template <typename A>
+  std::optional<std::int64_t> toInt64(A &&expr) {
+    return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
+        converter.getFoldingContext(), std::move(expr)));
+  }
+
+  mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol,
+                           bool isAlloc = false, bool isPtr = false) {
+    mlir::Location loc = converter.genLocation(symbol.name());
+    mlir::Type ty;
+    // If the symbol is not the same as the ultimate one (i.e, it is host or use
+    // associated), all the symbol properties are the ones of the ultimate
+    // symbol but the volatile and asynchronous attributes that may differ. To
+    // avoid issues with helper functions that would not follow association
+    // links, the fir type is built based on the ultimate symbol. This relies
+    // on the fact volatile and asynchronous are not reflected in fir types.
+    const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
+    if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
+      if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
+              type->AsIntrinsic()) {
+        int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value();
+        ty = genFIRType(context, tySpec->category(), kind);
+      } else if (type->IsPolymorphic()) {
+        TODO(loc, "genSymbolType polymorphic types");
+      } else if (type->AsDerived()) {
+        TODO(loc, "genSymbolType derived type");
+      } else {
+        fir::emitFatalError(loc, "symbol's type must have a type spec");
+      }
+    } else {
+      fir::emitFatalError(loc, "symbol must have a type");
+    }
+
+    if (Fortran::semantics::IsPointer(symbol))
+      return fir::BoxType::get(fir::PointerType::get(ty));
+    if (Fortran::semantics::IsAllocatable(symbol))
+      return fir::BoxType::get(fir::HeapType::get(ty));
+    // isPtr and isAlloc are variable that were promoted to be on the
+    // heap or to be pointers, but they do not have Fortran allocatable
+    // or pointer semantics, so do not use box for them.
+    if (isPtr)
+      return fir::PointerType::get(ty);
+    if (isAlloc)
+      return fir::HeapType::get(ty);
+    return ty;
+  }
 
   //===--------------------------------------------------------------------===//
   // Generate type entry points
@@ -207,26 +269,18 @@ public:
   template <Fortran::common::TypeCategory TC>
   mlir::Type
   gen(const Fortran::evaluate::Expr<Fortran::evaluate::SomeKind<TC>> &expr) {
-    return genVariant(expr);
+    return {};
   }
 
   template <typename A>
   mlir::Type gen(const Fortran::evaluate::Expr<A> &expr) {
-    return genVariant(expr);
+    return {};
   }
 
-  mlir::Type gen(const Fortran::evaluate::DataRef &dref) {
-    return genVariant(dref);
-  }
+  mlir::Type gen(const Fortran::evaluate::DataRef &dref) { return {}; }
 
   mlir::Type genVariableType(const Fortran::lower::pft::Variable &var) {
-    return genSymbolHelper(var.getSymbol(), var.isHeapAlloc(), var.isPointer());
-  }
-
-  /// Type consing from a symbol. A symbol's type must be created from the type
-  /// discovered by the front-end at runtime.
-  mlir::Type gen(Fortran::semantics::SymbolRef symbol) {
-    return genSymbolHelper(symbol);
+    return genSymbolType(var.getSymbol(), var.isHeapAlloc(), var.isPointer());
   }
 
   // non-template, category is runtime values, kind is defaulted
@@ -280,9 +334,7 @@ private:
     return fir::SequenceType::get(trivialShape(ptr->itemBytes()), byteTy);
   }
 
-  mlir::Type gen(const Fortran::evaluate::Substring &ss) {
-    return genVariant(ss.GetBaseObject());
-  }
+  mlir::Type gen(const Fortran::evaluate::Substring &ss) { return {}; }
 
   mlir::Type gen(const Fortran::evaluate::NullPointer &) {
     return genTypelessPtr();
@@ -296,17 +348,23 @@ private:
   mlir::Type gen(const Fortran::evaluate::BOZLiteralConstant &) {
     return genTypelessPtr();
   }
-  mlir::Type gen(const Fortran::evaluate::ArrayRef &) { TODO("array ref"); }
-  mlir::Type gen(const Fortran::evaluate::CoarrayRef &) { TODO("coarray ref"); }
-  mlir::Type gen(const Fortran::evaluate::Component &) { TODO("component"); }
+  mlir::Type gen(const Fortran::evaluate::ArrayRef &) {
+    TODO_NOLOC("array ref");
+  }
+  mlir::Type gen(const Fortran::evaluate::CoarrayRef &) {
+    TODO_NOLOC("coarray ref");
+  }
+  mlir::Type gen(const Fortran::evaluate::Component &) {
+    TODO_NOLOC("component");
+  }
   mlir::Type gen(const Fortran::evaluate::ComplexPart &) {
-    TODO("complex part");
+    TODO_NOLOC("complex part");
   }
   mlir::Type gen(const Fortran::evaluate::DescriptorInquiry &) {
-    TODO("descriptor inquiry");
+    TODO_NOLOC("descriptor inquiry");
   }
   mlir::Type gen(const Fortran::evaluate::StructureConstructor &) {
-    TODO("structure constructor");
+    TODO_NOLOC("structure constructor");
   }
 
   fir::SequenceType::Shape genSeqShape(Fortran::semantics::SymbolRef symbol) {
@@ -323,84 +381,6 @@ private:
     return seqShapeHelper(symbol, bounds);
   }
 
-  mlir::Type genSymbolHelper(const Fortran::semantics::Symbol &symbol,
-                             bool isAlloc = false, bool isPtr = false) {
-    mlir::Type ty;
-    if (auto *type{symbol.GetType()}) {
-      if (auto *tySpec{type->AsIntrinsic()}) {
-        int kind = toConstant(tySpec->kind());
-        switch (tySpec->category()) {
-        case Fortran::common::TypeCategory::Integer:
-          ty =
-              genFIRType<Fortran::common::TypeCategory::Integer>(context, kind);
-          break;
-        case Fortran::common::TypeCategory::Real:
-          ty = genFIRType<Fortran::common::TypeCategory::Real>(context, kind);
-          break;
-        case Fortran::common::TypeCategory::Complex:
-          ty =
-              genFIRType<Fortran::common::TypeCategory::Complex>(context, kind);
-          break;
-        case Fortran::common::TypeCategory::Character:
-          ty = genFIRType<Fortran::common::TypeCategory::Character>(context,
-                                                                    kind);
-          break;
-        case Fortran::common::TypeCategory::Logical:
-          ty =
-              genFIRType<Fortran::common::TypeCategory::Logical>(context, kind);
-          break;
-        default:
-          emitError("symbol has unknown intrinsic type");
-          return {};
-        }
-      } else if (auto *tySpec = type->AsDerived()) {
-        std::vector<std::pair<std::string, mlir::Type>> ps;
-        std::vector<std::pair<std::string, mlir::Type>> cs;
-        auto &symbol = tySpec->typeSymbol();
-        // FIXME: don't want to recurse forever here, but this won't happen
-        // since we don't know the components at this time
-        auto rec = fir::RecordType::get(context, toStringRef(symbol.name()));
-        auto &details = symbol.get<Fortran::semantics::DerivedTypeDetails>();
-        for (auto &param : details.paramDecls()) {
-          auto &p{*param};
-          ps.push_back(std::pair{p.name().ToString(), gen(p)});
-        }
-        emitError("the front-end returns symbols of derived type that have "
-                  "components that are simple names and not symbols, so cannot "
-                  "construct the type '" +
-                  toStringRef(symbol.name()) + "'");
-        rec.finalize(ps, cs);
-        ty = rec;
-      } else {
-        emitError("symbol's type must have a type spec");
-        return {};
-      }
-    } else {
-      emitError("symbol must have a type");
-      return {};
-    }
-    if (symbol.IsObjectArray()) {
-      if (symbol.GetType()->category() ==
-          Fortran::semantics::DeclTypeSpec::Character) {
-        auto charLen = fir::SequenceType::getUnknownExtent();
-        const auto &lenParam = symbol.GetType()->characterTypeSpec().length();
-        if (auto expr = lenParam.GetExplicit()) {
-          auto len = Fortran::evaluate::AsGenericExpr(std::move(*expr));
-          auto asInt = Fortran::evaluate::ToInt64(len);
-          if (asInt)
-            charLen = *asInt;
-        }
-        return fir::SequenceType::get(genSeqShape(symbol, charLen), ty);
-      }
-      return fir::SequenceType::get(genSeqShape(symbol), ty);
-    }
-    if (isPtr || Fortran::semantics::IsPointer(symbol))
-      ty = fir::PointerType::get(ty);
-    else if (isAlloc || Fortran::semantics::IsAllocatable(symbol))
-      ty = fir::HeapType::get(ty);
-    return ty;
-  }
-
   //===--------------------------------------------------------------------===//
   // Other helper functions
   //===--------------------------------------------------------------------===//
@@ -414,11 +394,6 @@ private:
   mlir::Type mkVoid() { return mlir::TupleType::get(context); }
   mlir::Type genTypelessPtr() { return fir::ReferenceType::get(mkVoid()); }
 
-  template <typename A>
-  mlir::Type genVariant(const A &variant) {
-    return std::visit([&](const auto &x) { return gen(x); }, variant.u);
-  }
-
   template <Fortran::common::TypeCategory TC>
   int defaultKind() {
     return defaultKind(TC);
@@ -465,50 +440,12 @@ private:
 
   //===--------------------------------------------------------------------===//
 
+  Fortran::lower::AbstractConverter &converter;
   mlir::MLIRContext *context;
 };
 
 } // namespace
 
-template <int KIND>
-int getIntegerBits() {
-  return Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
-                                 KIND>::Scalar::bits;
-}
-static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind) {
-  if (Fortran::evaluate::IsValidKindOfIntrinsicType(
-          Fortran::common::TypeCategory::Integer, kind)) {
-    switch (kind) {
-    case 1:
-      return mlir::IntegerType::get(context, getIntegerBits<1>());
-    case 2:
-      return mlir::IntegerType::get(context, getIntegerBits<2>());
-    case 4:
-      return mlir::IntegerType::get(context, getIntegerBits<4>());
-    case 8:
-      return mlir::IntegerType::get(context, getIntegerBits<8>());
-    case 16:
-      return mlir::IntegerType::get(context, getIntegerBits<16>());
-    }
-  }
-  llvm_unreachable("INTEGER kind not translated");
-}
-
-static mlir::Type genFIRType(mlir::MLIRContext *context,
-                             Fortran::common::TypeCategory tc, int kind) {
-  switch (tc) {
-  case Fortran::common::TypeCategory::Integer:
-    return genIntegerType(context, kind);
-  case Fortran::common::TypeCategory::Real:
-  case Fortran::common::TypeCategory::Complex:
-  case Fortran::common::TypeCategory::Logical:
-  case Fortran::common::TypeCategory::Character:
-  default:
-    break;
-  }
-  llvm_unreachable("unhandled type category");
-}
-
 mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context,
                                       Fortran::common::TypeCategory tc,
                                       int kind) {
@@ -534,7 +471,7 @@ mlir::Type Fortran::lower::translateSomeExprToFIRType(
 
 mlir::Type Fortran::lower::translateSymbolToFIRType(
     Fortran::lower::AbstractConverter &converter, const SymbolRef symbol) {
-  return TypeBuilder{converter}.gen(symbol);
+  return TypeBuilder{converter}.genSymbolType(symbol);
 }
 
 mlir::Type Fortran::lower::translateVariableToFIRType(