[flang] represent ABSTRACT in fir.type_info

[jeanPerier]

This patch keeps information about ABSTRACT derived types and DEFERRED type bound procedures inside fir.type_info dispatch tables.

This is part of the effort to delay generation of runtime type info global by keeping the type information in a more condense fashion inside fir.type_info (which is also easier to use for any potential optimizations).

[llvmbot]

@llvm/pr-subscribers-flang-fir-hlfir

Author: None (jeanPerier)

Changes

This patch keeps information about ABSTRACT derived types and DEFERRED type bound procedures inside fir.type_info dispatch tables.

This is part of the effort to delay generation of runtime type info global by keeping the type information in a more condense fashion inside fir.type_info (which is also easier to use for any potential optimizations).

---

Full diff: https://github.com/llvm/llvm-project/pull/170109.diff

5 Files Affected:

• (modified) flang/include/flang/Optimizer/Dialect/FIROps.td (+26-9)
• (modified) flang/lib/Lower/Bridge.cpp (+10-2)
• (modified) flang/lib/Optimizer/Dialect/FIROps.cpp (+8)
• (modified) flang/test/Fir/fir-ops.fir (+7)
• (added) flang/test/Lower/dispatch-table-abstract.f90 (+21)

diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td index 5d16b9816e318..cfce9fca504ec 100644 --- a/flang/include/flang/Optimizer/Dialect/FIROps.td +++ b/flang/include/flang/Optimizer/Dialect/FIROps.td @@ -3107,9 +3107,12 @@ def fir_TypeInfoOp : fir_Op<"type_info", between method identifiers and corresponding `FuncOp` symbols. The ordering of associations in the map is determined by the front end. - The "no_init" flag indicates that this type has no components requiring default - initialization (including setting allocatable component to a clean deallocated - state). + The "abstract" flag indicates that this type is an ABSTRACT derived type and + that it cannot be instantiated. + + The "no_init" flag indicates that this type has no components requiring + default initialization (including setting allocatable component to a clean + deallocated state). The "no_destroy" flag indicates that there are no allocatable components that require deallocation. @@ -3118,7 +3121,8 @@ def fir_TypeInfoOp : fir_Op<"type_info", for its parents ,or for components. ``` - fir.type_info @_QMquuzTfoo noinit nofinal : !fir.type<_QMquuzTfoo{i:i32}> dispatch_table { + fir.type_info @_QMquuzTfoo abstract noinit nofinal + : !fir.type<_QMquuzTfoo{i:i32}> dispatch_table { fir.dt_entry method1, @_QFNMquuzTfooPmethod1AfooR fir.dt_entry method2, @_QFNMquuzTfooPmethod2AfooII } @@ -3129,6 +3133,7 @@ def fir_TypeInfoOp : fir_Op<"type_info", SymbolNameAttr:$sym_name, TypeAttr:$type, OptionalAttr<TypeAttr>:$parent_type, + UnitAttr:$abstract, UnitAttr:$no_init, UnitAttr:$no_destroy, UnitAttr:$no_final @@ -3147,8 +3152,9 @@ def fir_TypeInfoOp : fir_Op<"type_info", ]; let assemblyFormat = [{ - $sym_name (`noinit` $no_init^)? (`nodestroy` $no_destroy^)? - (`nofinal` $no_final^)? (`extends` $parent_type^)? attr-dict `:` $type + $sym_name (`abstract` $abstract^)? (`noinit` $no_init^)? + (`nodestroy` $no_destroy^)? (`nofinal` $no_final^)? + (`extends` $parent_type^)? attr-dict `:` $type (`dispatch_table` $dispatch_table^)? (`component_info` $component_info^)? }]; @@ -3174,23 +3180,34 @@ def fir_DTEntryOp : fir_Op<"dt_entry", [HasParent<"TypeInfoOp">]> { let summary = "map entry in a dispatch table"; let description = [{ - An entry in a dispatch table. Allows a function symbol to be bound - to a specifier method identifier. A dispatch operation uses the dynamic + An entry in a dispatch table. Allows a function symbol to be bound + to a specifier method identifier. A dispatch operation uses the dynamic type of a distinguished argument to determine an exact dispatch table and uses the method identifier to select the type-bound procedure to be called. + The optional "deferred" flag indicates that the binding is a DEFERRED + type-bound procedure (declared but without an implementation at this + type level). + ``` + // Non-deferred binding fir.dt_entry method_name, @uniquedProcedure + + // Deferred binding + fir.dt_entry method_name, @uniquedProcedure deferred ``` }]; - let arguments = (ins StrAttr:$method, SymbolRefAttr:$proc); + let arguments = (ins StrAttr:$method, SymbolRefAttr:$proc, UnitAttr:$deferred); let hasCustomAssemblyFormat = 1; let extraClassDeclaration = [{ static constexpr llvm::StringRef getProcAttrNameStr() { return "proc"; } + static constexpr llvm::StringRef getDeferredAttrNameStr() { + return "deferred"; + } }]; } diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 6f9dc32297272..ba13b8f098da8 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -307,7 +307,11 @@ class TypeInfoConverter { if (!insertPointIfCreated.isSet()) return; // fir.type_info was already built in a previous call. - // Set init, destroy, and nofinal attributes. + // Set abstract, init, destroy, and nofinal attributes. + const Fortran::semantics::Symbol &dtSymbol = info.typeSpec.typeSymbol(); + if (dtSymbol.attrs().test(Fortran::semantics::Attr::ABSTRACT)) + dt->setAttr(dt.getAbstractAttrName(), builder.getUnitAttr()); + if (!info.typeSpec.HasDefaultInitialization(/*ignoreAllocatable=*/false, /*ignorePointer=*/false)) dt->setAttr(dt.getNoInitAttrName(), builder.getUnitAttr()); @@ -331,10 +335,14 @@ class TypeInfoConverter { if (details.numPrivatesNotOverridden() > 0) tbpName += "."s + std::to_string(details.numPrivatesNotOverridden()); std::string bindingName = converter.mangleName(details.symbol()); - fir::DTEntryOp::create( + auto dtEntry = fir::DTEntryOp::create( builder, info.loc, mlir::StringAttr::get(builder.getContext(), tbpName), mlir::SymbolRefAttr::get(builder.getContext(), bindingName)); + // Propagate DEFERRED attribute on the binding to fir.dt_entry. + if (binding.get().attrs().test(Fortran::semantics::Attr::DEFERRED)) + dtEntry->setAttr(fir::DTEntryOp::getDeferredAttrNameStr(), + builder.getUnitAttr()); } fir::FirEndOp::create(builder, info.loc); } diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp index 97e544f30de3e..4e797d651cb7a 100644 --- a/flang/lib/Optimizer/Dialect/FIROps.cpp +++ b/flang/lib/Optimizer/Dialect/FIROps.cpp @@ -3230,11 +3230,19 @@ mlir::ParseResult fir::DTEntryOp::parse(mlir::OpAsmParser &parser, parser.parseAttribute(calleeAttr, fir::DTEntryOp::getProcAttrNameStr(), result.attributes)) return mlir::failure(); + + // Optional "deferred" keyword. + if (succeeded(parser.parseOptionalKeyword("deferred"))) { + result.addAttribute(fir::DTEntryOp::getDeferredAttrNameStr(), + parser.getBuilder().getUnitAttr()); + } return mlir::success(); } void fir::DTEntryOp::print(mlir::OpAsmPrinter &p) { p << ' ' << getMethodAttr() << ", " << getProcAttr(); + if ((*this)->getAttr(fir::DTEntryOp::getDeferredAttrNameStr())) + p << " deferred"; } //===----------------------------------------------------------------------===// diff --git a/flang/test/Fir/fir-ops.fir b/flang/test/Fir/fir-ops.fir index 0892eb9fa0de8..8336b6d89e721 100644 --- a/flang/test/Fir/fir-ops.fir +++ b/flang/test/Fir/fir-ops.fir @@ -467,6 +467,13 @@ fir.type_info @cpinfo : !fir.type<cpinfo{comp_i:!fir.array<10x20xi32>}> componen fir.dt_component "component_info" lbs [2, 3] } +// CHECK-LABEL: fir.type_info @abstract_dispatch_tbl abstract : !fir.type<abstract_dispatch_tbl{i:i32}> dispatch_table { +// CHECK: fir.dt_entry "deferred_method", @deferred_impl deferred +// CHECK: } +fir.type_info @abstract_dispatch_tbl abstract : !fir.type<abstract_dispatch_tbl{i:i32}> dispatch_table { + fir.dt_entry "deferred_method", @deferred_impl deferred +} + // CHECK-LABEL: func @compare_complex( // CHECK-SAME: [[VAL_151:%.*]]: complex<f128>, [[VAL_152:%.*]]: complex<f128>) { func.func @compare_complex(%a : complex<f128>, %b : complex<f128>) { diff --git a/flang/test/Lower/dispatch-table-abstract.f90 b/flang/test/Lower/dispatch-table-abstract.f90 new file mode 100644 index 0000000000000..cb4eb0cdeb52f --- /dev/null +++ b/flang/test/Lower/dispatch-table-abstract.f90 @@ -0,0 +1,21 @@ +! Test lowering of ASBTRACT type to fir.type_info +! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s + +module m_abstract_info + type, abstract :: abstract_type + contains + procedure(proc_iface), nopass, deferred :: proc + end type + interface + subroutine proc_iface() + end subroutine + end interface +end module + +subroutine test(x) + use m_abstract_info, only : abstract_type + class(abstract_type) :: x +end subroutine + +!CHECK-LABEL: fir.type_info @_QMm_abstract_infoTabstract_type abstract noinit nodestroy nofinal : !fir.type<_QMm_abstract_infoTabstract_type> dispatch_table { +!CHECK: fir.dt_entry "proc", @_QPproc_iface deferred 

[tblah]

LGTM, thanks!

[clementval]

LGTM