[flang-commits] [flang] ad40cc1 - [flang] Lower basic function with scalar integer/logical return value
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Mon Feb 14 12:32:35 PST 2022
Author: Valentin Clement
Date: 2022-02-14T21:32:24+01:00
New Revision: ad40cc14a8b728dedc20c9397489bda50185b176
URL: https://github.com/llvm/llvm-project/commit/ad40cc14a8b728dedc20c9397489bda50185b176
DIFF: https://github.com/llvm/llvm-project/commit/ad40cc14a8b728dedc20c9397489bda50185b176.diff
LOG: [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 at nvidia.com>
Added:
flang/test/Lower/basic-function.f90
Modified:
flang/include/flang/Lower/CallInterface.h
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertType.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
index dc61b0250bbea..a8f08ac4528d2 100644
--- a/flang/include/flang/Lower/CallInterface.h
+++ b/flang/include/flang/Lower/CallInterface.h
@@ -102,9 +102,31 @@ class CallInterface {
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.
@@ -113,9 +135,14 @@ class CallInterface {
/// 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;
};
//===----------------------------------------------------------------------===//
@@ -132,9 +159,11 @@ class CalleeInterface : public CallInterface<CalleeInterface> {
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.
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 59f31b5ed2459..6e7f56c50ada5 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -99,9 +99,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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 "
@@ -247,8 +246,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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.
@@ -335,6 +337,36 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
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
diff erent 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) {
@@ -345,7 +377,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
builder->setInsertionPoint(finalBlock, finalBlock->end());
}
if (Fortran::semantics::IsFunction(symbol)) {
- TODO(toLocation(), "Function lowering");
+ genReturnSymbol(symbol);
} else {
genExitRoutine();
}
@@ -719,10 +751,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
TODO(toLocation(), "EndDoStmt lowering");
}
- void genFIR(const Fortran::parser::EndFunctionStmt &) {
- TODO(toLocation(), "EndFunctionStmt lowering");
- }
-
void genFIR(const Fortran::parser::EndIfStmt &) {
TODO(toLocation(), "EndIfStmt lowering");
}
@@ -736,6 +764,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
// 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 &) {
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 63c65cddcb113..175aee73481c6 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -12,6 +12,7 @@
#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"
@@ -33,6 +34,11 @@ static std::string getMangledName(const Fortran::semantics::Symbol &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();
@@ -52,6 +58,21 @@ mlir::Location Fortran::lower::CalleeInterface::getCalleeLocation() const {
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.
@@ -81,6 +102,13 @@ static void addSymbolAttribute(mlir::FuncOp func,
/// 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.
@@ -98,9 +126,90 @@ void Fortran::lower::CallInterface<T>::declare() {
}
}
+//===----------------------------------------------------------------------===//
+// 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>;
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 8900ce3d58df4..ca3494704e32a 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) {
@@ -120,38 +167,6 @@ genFIRType<Fortran::common::TypeCategory::Real>(mlir::MLIRContext *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,
@@ -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
diff er. 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 @@ class TypeBuilder {
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 @@ class TypeBuilder {
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 @@ class TypeBuilder {
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 @@ class TypeBuilder {
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 ¶m : 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 @@ class TypeBuilder {
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 @@ class TypeBuilder {
//===--------------------------------------------------------------------===//
+ 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(
diff --git a/flang/test/Lower/basic-function.f90 b/flang/test/Lower/basic-function.f90
new file mode 100644
index 0000000000000..e95ed88774455
--- /dev/null
+++ b/flang/test/Lower/basic-function.f90
@@ -0,0 +1,69 @@
+! 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>
More information about the flang-commits
mailing list