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

[clementval]

Summary

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.

Co-authored-by: Jean Perier <[e-mail]>

[clementval]

Add logical

[PeteSteinfeld]

Aside from one nit, all builds and tests correctly and looks good.

flang/lib/Lower/ConvertType.cpp

220–221

Are these lines supposed to be here?

[clementval]

flang/lib/Lower/ConvertType.cpp

220–221

Nope. They will be part of a future patch. I'll remove them thanks.

[kiranchandramohan]

Can you add a test,
-> where result is specified with the result keyword.
-> where there is some control flow in the function.

flang/include/flang/Lower/CallInterface.h

113

Nit: closing ')'. I think this is for input arguments only?

flang/lib/Lower/Bridge.cpp

246

Where is this used?

360–364

Nit: Can this be a TODO for now?

[clementval]

Address review comments

[clementval]

flang/include/flang/Lower/CallInterface.h

113

-1 is passed for the result position. Of course it is mostly used later for the args.

flang/lib/Lower/Bridge.cpp

246

Not used right now. Removed from this patch.

flang/include/flang/Lower/CallInterface.h

enum class Property {
     Box,
     MutableBox,
     Value
   };
 
   using FortranEntity = typename PassedEntityTypes<T>::FortranEntity;
   using FirValue = typename PassedEntityTypes<T>::FirValue;
 
+  /// FirPlaceHolder are place holders for the mlir inputs and outputs that are
+  /// created during the first pass before the mlir::FuncOp is created.
+  struct FirPlaceHolder {
+    FirPlaceHolder(mlir::Type t, int passedPosition, Property p)
+        : type{t}, passedEntityPosition{passedPosition}, property{p} {}
+    /// Type for this input/output
+    mlir::Type type;
+    /// Position of related passedEntity in passedArguments.
+    /// (passedEntity is the passedResult this value is resultEntityPosition).
+    int passedEntityPosition;
+    static constexpr int resultEntityPosition = -1;
+    /// Indicate property of the entity passedEntityPosition that must be passed
+    /// through this argument.
+    Property property;
+  };
+
   /// Returns the mlir function type
   mlir::FunctionType genFunctionType();
 
+  /// determineInterface is the entry point of the first pass that defines the
+  /// interface and is required to get the mlir::FuncOp.
+  void
+  determineInterface(bool isImplicit,
+                     const Fortran::evaluate::characteristics::Procedure &);
+
 protected:
   CallInterface(Fortran::lower::AbstractConverter &c) : converter{c} {}
   /// CRTP handle.
   T &side() { return *static_cast<T *>(this); }
   /// Entry point to be called by child ctor to analyze the signature and
   /// create/find the mlir::FuncOp. Child needs to be initialized first.
   void declare();
 
+  llvm::SmallVector<FirPlaceHolder> outputs;
   mlir::FuncOp func;
 
   Fortran::lower::AbstractConverter &converter;
+  /// Store characteristic once created, it is required for further information
+  /// (e.g. getting the length of character result)
+  std::optional<Fortran::evaluate::characteristics::Procedure> characteristic =
+      std::nullopt;
 };
 
 //===----------------------------------------------------------------------===//
 // Callee side interface
 //===----------------------------------------------------------------------===//
 
 /// CalleeInterface only provides the helpers needed by CallInterface
 /// to abstract the specificities of the callee side.
 class CalleeInterface : public CallInterface<CalleeInterface> {
 public:
   CalleeInterface(Fortran::lower::pft::FunctionLikeUnit &f,
                   Fortran::lower::AbstractConverter &c)
       : CallInterface{c}, funit{f} {
     declare();
   }
 
+  bool hasAlternateReturns() const;
   std::string getMangledName() const;
   mlir::Location getCalleeLocation() const;
   Fortran::evaluate::characteristics::Procedure characterize() const;
+  bool isMainProgram() const;
 
   /// On the callee side it does not matter whether the procedure is
   /// called through pointers or not.
   bool isIndirectCall() const { return false; }
 
   /// Return the procedure symbol if this is a call to a user defined
   /// procedure.
   const Fortran::semantics::Symbol *getProcedureSymbol() const;

flang/lib/Lower/Bridge.cpp

public:
   mlir::Type genType(const Fortran::evaluate::DataRef &) override final {
     TODO_NOLOC("Not implemented genType DataRef. Needed for more complex "
                "expression lowering");
   }
   mlir::Type genType(const Fortran::lower::SomeExpr &) override final {
     TODO_NOLOC("Not implemented genType SomeExpr. Needed for more complex "
                "expression lowering");
   }
-  mlir::Type genType(Fortran::lower::SymbolRef) override final {
-    TODO_NOLOC("Not implemented genType SymbolRef. Needed for more complex "
-               "expression lowering");
+  mlir::Type genType(Fortran::lower::SymbolRef sym) override final {
+    return Fortran::lower::translateSymbolToFIRType(*this, sym);
   }
   mlir::Type genType(Fortran::common::TypeCategory tc) override final {
     TODO_NOLOC("Not implemented genType TypeCategory. Needed for more complex "
                "expression lowering");
   }
   mlir::Type genType(Fortran::common::TypeCategory tc,
                      int kind) override final {
     return Fortran::lower::getFIRType(&getMLIRContext(), tc, kind);
void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
     assert(!builder && "expected nullptr");
     Fortran::lower::CalleeInterface callee(funit, *this);
     mlir::FuncOp func = callee.addEntryBlockAndMapArguments();
     func.setVisibility(mlir::SymbolTable::Visibility::Public);
     builder = new fir::FirOpBuilder(func, bridge.getKindMap());
     assert(builder && "FirOpBuilder did not instantiate");
     builder->setInsertionPointToStart(&func.front());
 
     for (const Fortran::lower::pft::Variable &var :
          funit.getOrderedSymbolTable()) {
       const Fortran::semantics::Symbol &sym = var.getSymbol();
-      if (!sym.IsFuncResult() || !funit.primaryResult)
+      if (!sym.IsFuncResult() || !funit.primaryResult) {
+        instantiateVar(var);
+      } else if (&sym == funit.primaryResult) {
         instantiateVar(var);
       }
+    }
 
     // Create most function blocks in advance.
     createEmptyGlobalBlocks(funit.evaluationList);
 
     // Reinstate entry block as the current insertion point.
     builder->setInsertionPointToEnd(&func.front());
   }
 
private:
   ///
   /// Generate the cleanup block before the program exits
   void genExitRoutine() {
     if (blockIsUnterminated())
       builder->create<mlir::ReturnOp>(toLocation());
   }
   void genFIR(const Fortran::parser::EndProgramStmt &) { genExitRoutine(); }
 
+  /// END of procedure-like constructs
+  ///
+  /// Generate the cleanup block before the procedure exits
+  void genReturnSymbol(const Fortran::semantics::Symbol &functionSymbol) {
+    const Fortran::semantics::Symbol &resultSym =
+        functionSymbol.get<Fortran::semantics::SubprogramDetails>().result();
+    Fortran::lower::SymbolBox resultSymBox = lookupSymbol(resultSym);
+    mlir::Location loc = toLocation();
+    if (!resultSymBox) {
+      mlir::emitError(loc, "failed lowering function return");
+      return;
+    }
+    mlir::Value resultVal = resultSymBox.match(
+        [&](const fir::CharBoxValue &x) -> mlir::Value {
+          TODO(loc, "Function return CharBoxValue");
+        },
+        [&](const auto &) -> mlir::Value {
+          mlir::Value resultRef = resultSymBox.getAddr();
+          mlir::Type resultType = genType(resultSym);
+          mlir::Type resultRefType = builder->getRefType(resultType);
+          // A function with multiple entry points returning different types
+          // tags all result variables with one of the largest types to allow
+          // them to share the same storage.  Convert this to the actual type.
+          if (resultRef.getType() != resultRefType)
+            TODO(loc, "Convert to actual type");
+          return builder->create<fir::LoadOp>(loc, resultRef);
+        });
+    builder->create<mlir::ReturnOp>(loc, resultVal);
+  }
+
   void genFIRProcedureExit(Fortran::lower::pft::FunctionLikeUnit &funit,
                            const Fortran::semantics::Symbol &symbol) {
     if (mlir::Block *finalBlock = funit.finalBlock) {
       // The current block must end with a terminator.
       if (blockIsUnterminated())
         builder->create<mlir::cf::BranchOp>(toLocation(), finalBlock);
       // Set insertion point to final block.
       builder->setInsertionPoint(finalBlock, finalBlock->end());
     }
     if (Fortran::semantics::IsFunction(symbol)) {
-      TODO(toLocation(), "Function lowering");
+      genReturnSymbol(symbol);
     } else {
       genExitRoutine();
     }
   }
 
   void genFIR(const Fortran::parser::CallStmt &stmt) {
     TODO(toLocation(), "CallStmt lowering");
   }
private:
   void genFIR(const Fortran::parser::EndAssociateStmt &) {
     TODO(toLocation(), "EndAssociateStmt lowering");
   }
 
   void genFIR(const Fortran::parser::EndDoStmt &) {
     TODO(toLocation(), "EndDoStmt lowering");
   }
 
-  void genFIR(const Fortran::parser::EndFunctionStmt &) {
-    TODO(toLocation(), "EndFunctionStmt lowering");
-  }
-
   void genFIR(const Fortran::parser::EndIfStmt &) {
     TODO(toLocation(), "EndIfStmt lowering");
   }
 
   void genFIR(const Fortran::parser::EndMpSubprogramStmt &) {
     TODO(toLocation(), "EndMpSubprogramStmt lowering");
   }
 
   void genFIR(const Fortran::parser::EndSelectStmt &) {
     TODO(toLocation(), "EndSelectStmt lowering");
   }
 
   // Nop statements - No code, or code is generated at the construct level.
+  void genFIR(const Fortran::parser::EndFunctionStmt &) {}   // nop
   void genFIR(const Fortran::parser::EndSubroutineStmt &) {} // nop
 
   void genFIR(const Fortran::parser::EntryStmt &) {
     TODO(toLocation(), "EntryStmt lowering");
   }
 
   void genFIR(const Fortran::parser::IfStmt &) {
     TODO(toLocation(), "IfStmt lowering");

flang/lib/Lower/CallInterface.cpp

 //===-- CallInterface.cpp -- Procedure call interface ---------------------===//
 //
 // 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/CallInterface.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Lower/Bridge.h"
 #include "flang/Lower/Mangler.h"
 #include "flang/Lower/PFTBuilder.h"
 #include "flang/Lower/Support/Utils.h"
+#include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Optimizer/Support/InternalNames.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
 
 //===----------------------------------------------------------------------===//
 // BIND(C) mangling helpers
 //===----------------------------------------------------------------------===//
 
 // Return the binding label (from BIND(C...)) or the mangled name of a symbol.
 static std::string getMangledName(const Fortran::semantics::Symbol &symbol) {
   const std::string *bindName = symbol.GetBindName();
   return bindName ? *bindName : Fortran::lower::mangle::mangleName(symbol);
 }
 
 //===----------------------------------------------------------------------===//
 // Callee side interface implementation
 //===----------------------------------------------------------------------===//
 
+bool Fortran::lower::CalleeInterface::hasAlternateReturns() const {
+  return !funit.isMainProgram() &&
+         Fortran::semantics::HasAlternateReturns(funit.getSubprogramSymbol());
+}
+
 std::string Fortran::lower::CalleeInterface::getMangledName() const {
   if (funit.isMainProgram())
     return fir::NameUniquer::doProgramEntry().str();
   return ::getMangledName(funit.getSubprogramSymbol());
 }
 
 const Fortran::semantics::Symbol *
 Fortran::lower::CalleeInterface::getProcedureSymbol() const {
   if (funit.isMainProgram())
     return nullptr;
   return &funit.getSubprogramSymbol();
 }
 
 mlir::Location Fortran::lower::CalleeInterface::getCalleeLocation() const {
   // FIXME: do NOT use unknown for the anonymous PROGRAM case. We probably
   // should just stash the location in the funit regardless.
   return converter.genLocation(funit.getStartingSourceLoc());
 }
 
+Fortran::evaluate::characteristics::Procedure
+Fortran::lower::CalleeInterface::characterize() const {
+  Fortran::evaluate::FoldingContext &foldingContext =
+      converter.getFoldingContext();
+  std::optional<Fortran::evaluate::characteristics::Procedure> characteristic =
+      Fortran::evaluate::characteristics::Procedure::Characterize(
+          funit.getSubprogramSymbol(), foldingContext);
+  assert(characteristic && "Fail to get characteristic from symbol");
+  return *characteristic;
+}
+
+bool Fortran::lower::CalleeInterface::isMainProgram() const {
+  return funit.isMainProgram();
+}
+
 mlir::FuncOp Fortran::lower::CalleeInterface::addEntryBlockAndMapArguments() {
   // On the callee side, directly map the mlir::value argument of
   // the function block to the Fortran symbols.
   func.addEntryBlock();
   return func;
 }
 
 //===----------------------------------------------------------------------===//
static void addSymbolAttribute(mlir::FuncOp func,
   func->setAttr(fir::getSymbolAttrName(),
                 mlir::StringAttr::get(&mlirContext, name));
 }
 
 /// Declare drives the different actions to be performed while analyzing the
 /// signature and building/finding the mlir::FuncOp.
 template <typename T>
 void Fortran::lower::CallInterface<T>::declare() {
+  if (!side().isMainProgram()) {
+    characteristic.emplace(side().characterize());
+    bool isImplicit = characteristic->CanBeCalledViaImplicitInterface();
+    determineInterface(isImplicit, *characteristic);
+  }
+  // No input/output for main program
+
   // Create / get funcOp for direct calls. For indirect calls (only meaningful
   // on the caller side), no funcOp has to be created here. The mlir::Value
   // holding the indirection is used when creating the fir::CallOp.
   if (!side().isIndirectCall()) {
     std::string name = side().getMangledName();
     mlir::ModuleOp module = converter.getModuleOp();
     func = fir::FirOpBuilder::getNamedFunction(module, name);
     if (!func) {
       mlir::Location loc = side().getCalleeLocation();
       mlir::FunctionType ty = genFunctionType();
       func = fir::FirOpBuilder::createFunction(loc, module, name, ty);
       if (const Fortran::semantics::Symbol *sym = side().getProcedureSymbol())
         addSymbolAttribute(func, *sym, converter.getMLIRContext());
     }
   }
 }
 
+//===----------------------------------------------------------------------===//
+// CallInterface implementation: this part is common to both caller and caller
+// sides.
+//===----------------------------------------------------------------------===//
+
+/// This is the actual part that defines the FIR interface based on the
+/// characteristic. It directly mutates the CallInterface members.
+template <typename T>
+class Fortran::lower::CallInterfaceImpl {
+  using CallInterface = Fortran::lower::CallInterface<T>;
+  using FirPlaceHolder = typename CallInterface::FirPlaceHolder;
+  using Property = typename CallInterface::Property;
+  using TypeAndShape = Fortran::evaluate::characteristics::TypeAndShape;
+
+public:
+  CallInterfaceImpl(CallInterface &i)
+      : interface(i), mlirContext{i.converter.getMLIRContext()} {}
+
+  void buildImplicitInterface(
+      const Fortran::evaluate::characteristics::Procedure &procedure) {
+    // Handle result
+    if (const std::optional<Fortran::evaluate::characteristics::FunctionResult>
+            &result = procedure.functionResult)
+      handleImplicitResult(*result);
+    else if (interface.side().hasAlternateReturns())
+      addFirResult(mlir::IndexType::get(&mlirContext),
+                   FirPlaceHolder::resultEntityPosition, Property::Value);
+  }
+
+private:
+  void handleImplicitResult(
+      const Fortran::evaluate::characteristics::FunctionResult &result) {
+    if (result.IsProcedurePointer())
+      TODO(interface.converter.getCurrentLocation(),
+           "procedure pointer result not yet handled");
+    const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape =
+        result.GetTypeAndShape();
+    assert(typeAndShape && "expect type for non proc pointer result");
+    Fortran::evaluate::DynamicType dynamicType = typeAndShape->type();
+    if (dynamicType.category() == Fortran::common::TypeCategory::Character) {
+      TODO(interface.converter.getCurrentLocation(),
+           "implicit result character type");
+    } else if (dynamicType.category() ==
+               Fortran::common::TypeCategory::Derived) {
+      TODO(interface.converter.getCurrentLocation(),
+           "implicit result derived type");
+    } else {
+      // All result other than characters/derived are simply returned by value
+      // in implicit interfaces
+      mlir::Type mlirType =
+          getConverter().genType(dynamicType.category(), dynamicType.kind());
+      addFirResult(mlirType, FirPlaceHolder::resultEntityPosition,
+                   Property::Value);
+    }
+  }
+
+  void addFirResult(mlir::Type type, int entityPosition, Property p) {
+    interface.outputs.emplace_back(FirPlaceHolder{type, entityPosition, p});
+  }
+
+  Fortran::lower::AbstractConverter &getConverter() {
+    return interface.converter;
+  }
+  CallInterface &interface;
+  mlir::MLIRContext &mlirContext;
+};
+
+template <typename T>
+void Fortran::lower::CallInterface<T>::determineInterface(
+    bool isImplicit,
+    const Fortran::evaluate::characteristics::Procedure &procedure) {
+  CallInterfaceImpl<T> impl(*this);
+  if (isImplicit)
+    impl.buildImplicitInterface(procedure);
+  else
+    TODO_NOLOC("determineImplicitInterface");
+}
+
 template <typename T>
 mlir::FunctionType Fortran::lower::CallInterface<T>::genFunctionType() {
-  return mlir::FunctionType::get(&converter.getMLIRContext(), {}, {});
+  llvm::SmallVector<mlir::Type> returnTys;
+  for (const FirPlaceHolder &placeHolder : outputs)
+    returnTys.emplace_back(placeHolder.type);
+  return mlir::FunctionType::get(&converter.getMLIRContext(), {}, returnTys);
 }
 
 template class Fortran::lower::CallInterface<Fortran::lower::CalleeInterface>;

flang/lib/Lower/ConvertType.cpp

 //===-- ConvertType.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/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"
 #include "flang/Semantics/type.h"
 #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) {
   return Fortran::evaluate::IsConstantExpr(Fortran::lower::SomeExpr{e});
 }
 
 template <typename A>
 int64_t toConstant(const Fortran::evaluate::Expr<A> &e) {
case 16:
       return genFIRType<Fortran::common::TypeCategory::Real, 16>(context);
     }
   }
   llvm_unreachable("REAL type translation not implemented");
 }
 
 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(
           Fortran::common::TypeCategory::Character, KIND))
     return fir::CharacterType::get(context, KIND, 1);
   return {};
 }
 

 
 namespace {
 
 /// Discover the type of an Fortran::evaluate::Expr<T> and convert it to an
 /// mlir::Type. The type returned may be an MLIR standard or FIR type.
 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
   //===--------------------------------------------------------------------===//
 
   template <template <typename> typename A, Fortran::common::TypeCategory TC>
   mlir::Type gen(const A<Fortran::evaluate::SomeKind<TC>> &) {
     return genFIRType<TC>(context, defaultKind<TC>());
public:
   gen(const Fortran::evaluate::Expr<Fortran::evaluate::Type<TC, KIND>> &) {
     return genFIRType<TC, KIND>(context);
   }
 
   // breaks the conflict between A<SomeKind<TC>> and Expr<B> deduction
   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
   mlir::Type genFIRTy(Fortran::common::TypeCategory tc) {
     return genFIRTy(tc, defaultKind(tc));
   }
 
   // non-template, arguments are runtime values
private:
   }
 
   // some sequence of `n` bytes
   mlir::Type gen(const Fortran::evaluate::StaticDataObject::Pointer &ptr) {
     mlir::Type byteTy{mlir::IntegerType::get(context, 8)};
     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();
   }
   mlir::Type gen(const Fortran::evaluate::ProcedureRef &) {
     return genTypelessPtr();
   }
   mlir::Type gen(const Fortran::evaluate::ProcedureDesignator &) {
     return genTypelessPtr();
   }
   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) {
     assert(symbol->IsObjectArray() && "unexpected symbol type");
     fir::SequenceType::Shape bounds;
     return seqShapeHelper(symbol, bounds);
   }
 
   fir::SequenceType::Shape genSeqShape(Fortran::semantics::SymbolRef symbol,
                                        fir::SequenceType::Extent charLen) {
     assert(symbol->IsObjectArray() && "unexpected symbol type");
     fir::SequenceType::Shape bounds;
     bounds.push_back(charLen);
     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
   //===--------------------------------------------------------------------===//
 
   fir::SequenceType::Shape trivialShape(int size) {
     fir::SequenceType::Shape bounds;
     bounds.emplace_back(size);
     return bounds;
   }
 
   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);
   }
   int defaultKind(Fortran::common::TypeCategory TC) { return 0; }
 
   fir::SequenceType::Shape seqShapeHelper(Fortran::semantics::SymbolRef symbol,
                                           fir::SequenceType::Shape &bounds) {
private:
   }
 
   mlir::InFlightDiagnostic emitWarning(const llvm::Twine &message) {
     return mlir::emitWarning(mlir::UnknownLoc::get(context), message);
   }
 
   //===--------------------------------------------------------------------===//
 
+  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) {
   return genFIRType(context, tc, kind);
 }
 
 mlir::Type
 Fortran::lower::getFIRType(Fortran::lower::AbstractConverter &converter,

 
 mlir::Type Fortran::lower::translateSomeExprToFIRType(
     Fortran::lower::AbstractConverter &converter, const SomeExpr *expr) {
   return TypeBuilder{converter}.gen(*expr);
 }
 
 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(
     Fortran::lower::AbstractConverter &converter,
     const Fortran::lower::pft::Variable &var) {
   return TypeBuilder{converter}.genVariableType(var);
 }
 

flang/test/Lower/basic-function.f90

+! RUN: bbc %s -o "-" -emit-fir | FileCheck %s
+
+integer(1) function fct1()
+end
+! CHECK-LABEL: func @_QPfct1() -> i8
+! CHECK:         return %{{.*}} : i8
+
+integer(2) function fct2()
+end
+! CHECK-LABEL: func @_QPfct2() -> i16
+! CHECK:         return %{{.*}} : i16
+
+integer(4) function fct3()
+end
+! CHECK-LABEL: func @_QPfct3() -> i32
+! CHECK:         return %{{.*}} : i32
+
+integer(8) function fct4()
+end
+! CHECK-LABEL: func @_QPfct4() -> i64
+! CHECK:         return %{{.*}} : i64
+
+integer(16) function fct5()
+end
+! CHECK-LABEL: func @_QPfct5() -> i128
+! CHECK:         return %{{.*}} : i128
+
+function fct()
+  integer :: fct
+end
+! CHECK-LABEL: func @_QPfct() -> i32
+! CHECK:         return %{{.*}} : i32
+
+function fct_res() result(res)
+  integer :: res
+end
+! CHECK-LABEL: func @_QPfct_res() -> i32
+! CHECK:         return %{{.*}} : i32
+
+integer function fct_body()
+  goto 1
+  1 stop
+end
+
+! CHECK-LABEL: func @_QPfct_body() -> i32
+! CHECK:         cf.br ^bb1
+! CHECK:       ^bb1
+! CHECK:         %{{.*}} = fir.call @_FortranAStopStatement
+! CHECK:         fir.unreachable
+
+logical(1) function lfct1()
+end
+! CHECK-LABEL: func @_QPlfct1() -> !fir.logical<1>
+! CHECK:         return %{{.*}} : !fir.logical<1>
+
+logical(2) function lfct2()
+end
+! CHECK-LABEL: func @_QPlfct2() -> !fir.logical<2>
+! CHECK:         return %{{.*}} : !fir.logical<2>
+
+logical(4) function lfct3()
+end
+! CHECK-LABEL: func @_QPlfct3() -> !fir.logical<4>
+! CHECK:         return %{{.*}} : !fir.logical<4>
+
+logical(8) function lfct4()
+end
+! CHECK-LABEL: func @_QPlfct4() -> !fir.logical<8>
+! CHECK:         return %{{.*}} : !fir.logical<8>