[flang-commits] [flang] 0fc42b3 - [flang][hlfir] Emit hlfir.declare inside internal procedures
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Tue Feb 7 06:30:56 PST 2023
Author: Jean Perier
Date: 2023-02-07T15:29:49+01:00
New Revision: 0fc42b38a2d907d76098cf8a30ebc5f444ea586a
URL: https://github.com/llvm/llvm-project/commit/0fc42b38a2d907d76098cf8a30ebc5f444ea586a
DIFF: https://github.com/llvm/llvm-project/commit/0fc42b38a2d907d76098cf8a30ebc5f444ea586a.diff
LOG: [flang][hlfir] Emit hlfir.declare inside internal procedures
Captured variables inside internal procedure do not go though
Fortran::lower::instantiateVar because the specification expressions
should no be lowered again, and instead, all the information must be
taken from the host link argument.
There is nothing very special to do for HLFIR, but the hlfir.declare
should be emitted for the instantiated captured variable and mapped
to the symbol.
Differential Revision: https://reviews.llvm.org/D143481
Added:
flang/test/Lower/HLFIR/internal-procedures.f90
Modified:
flang/lib/Lower/HostAssociations.cpp
Removed:
################################################################################
diff --git a/flang/lib/Lower/HostAssociations.cpp b/flang/lib/Lower/HostAssociations.cpp
index bfbdfbb37039..b6c8ee00a4d2 100644
--- a/flang/lib/Lower/HostAssociations.cpp
+++ b/flang/lib/Lower/HostAssociations.cpp
@@ -59,6 +59,30 @@
// should be added to handle it, and `walkCaptureCategories` should be updated
// to dispatch this new kind of variable to this new class.
+/// Is \p sym a derived type entity with length parameters ?
+static bool isDerivedWithLenParameters(const Fortran::semantics::Symbol &sym) {
+ if (const auto *declTy = sym.GetType())
+ if (const auto *derived = declTy->AsDerived())
+ return Fortran::semantics::CountLenParameters(*derived) != 0;
+ return false;
+}
+
+/// Map the extracted fir::ExtendedValue for a host associated variable inside
+/// and internal procedure to its symbol. Generates an hlfir.declare in HLFIR.
+static void bindCapturedSymbol(const Fortran::semantics::Symbol &sym,
+ fir::ExtendedValue val,
+ Fortran::lower::AbstractConverter &converter,
+ Fortran::lower::SymMap &symMap) {
+ if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
+ // TODO: add an indication that this is a host variable in the declare to
+ // allow alias analysis to detect this case.
+ Fortran::lower::genDeclareSymbol(converter, symMap, sym, val);
+ } else {
+ symMap.addSymbol(sym, val);
+ }
+}
+
+namespace {
/// Struct to be used as argument in walkCaptureCategories when building the
/// tuple element type for a host associated variable.
struct GetTypeInTuple {
@@ -146,10 +170,10 @@ class CapturedSimpleScalars : public CapturedSymbols<CapturedSimpleScalars> {
}
static void getFromTuple(const GetFromTuple &args,
- Fortran::lower::AbstractConverter &,
+ Fortran::lower::AbstractConverter &converter,
const Fortran::semantics::Symbol &sym,
const Fortran::lower::BoxAnalyzer &) {
- args.symMap.addSymbol(sym, args.valueInTuple);
+ bindCapturedSymbol(sym, args.valueInTuple, converter, args.symMap);
}
};
@@ -177,10 +201,10 @@ class CapturedProcedure : public CapturedSymbols<CapturedProcedure> {
}
static void getFromTuple(const GetFromTuple &args,
- Fortran::lower::AbstractConverter &,
+ Fortran::lower::AbstractConverter &converter,
const Fortran::semantics::Symbol &sym,
const Fortran::lower::BoxAnalyzer &) {
- args.symMap.addSymbol(sym, args.valueInTuple);
+ bindCapturedSymbol(sym, args.valueInTuple, converter, args.symMap);
}
};
@@ -223,14 +247,6 @@ class CapturedCharacterScalars
}
};
-/// Is \p sym a derived type entity with length parameters ?
-static bool isDerivedWithLenParameters(const Fortran::semantics::Symbol &sym) {
- if (const auto *declTy = sym.GetType())
- if (const auto *derived = declTy->AsDerived())
- return Fortran::semantics::CountLenParameters(*derived) != 0;
- return false;
-}
-
/// Class defining how polymorphic entities are captured in internal procedures.
/// Polymorphic entities are always boxed as a fir.class box.
class CapturedPolymorphic : public CapturedSymbols<CapturedPolymorphic> {
@@ -253,7 +269,7 @@ class CapturedPolymorphic : public CapturedSymbols<CapturedPolymorphic> {
Fortran::lower::AbstractConverter &converter,
const Fortran::semantics::Symbol &sym,
const Fortran::lower::BoxAnalyzer &ba) {
- args.symMap.addSymbol(sym, args.valueInTuple);
+ bindCapturedSymbol(sym, args.valueInTuple, converter, args.symMap);
}
};
@@ -306,8 +322,9 @@ class CapturedAllocatableAndPointer
TODO(loc, "host associated derived type allocatable or pointer with "
"length parameters");
}
- args.symMap.addSymbol(
- sym, fir::MutableBoxValue(args.valueInTuple, nonDeferredLenParams, {}));
+ bindCapturedSymbol(
+ sym, fir::MutableBoxValue(args.valueInTuple, nonDeferredLenParams, {}),
+ converter, args.symMap);
}
};
@@ -389,8 +406,9 @@ class CapturedArrays : public CapturedSymbols<CapturedArrays> {
if (canReadCapturedBoxValue(converter, sym)) {
fir::BoxValue boxValue(box, lbounds, /*explicitParams=*/std::nullopt);
- args.symMap.addSymbol(sym,
- fir::factory::readBoxValue(builder, loc, boxValue));
+ bindCapturedSymbol(sym,
+ fir::factory::readBoxValue(builder, loc, boxValue),
+ converter, args.symMap);
} else {
// Keep variable as a fir.box.
// If this is an optional that is absent, the fir.box needs to be an
@@ -409,7 +427,7 @@ class CapturedArrays : public CapturedSymbols<CapturedArrays> {
absentBox);
}
fir::BoxValue boxValue(box, lbounds, /*explicitParams=*/std::nullopt);
- args.symMap.addSymbol(sym, boxValue);
+ bindCapturedSymbol(sym, boxValue, converter, args.symMap);
}
}
@@ -430,13 +448,14 @@ class CapturedArrays : public CapturedSymbols<CapturedArrays> {
!isDerivedWithLenParameters(sym);
}
};
+} // namespace
/// Dispatch \p visitor to the CapturedSymbols which is handling how host
/// association is implemented for this kind of symbols. This ensures the same
/// dispatch decision is taken when building the tuple type, when creating the
/// tuple, and when instantiating host associated variables from it.
template <typename T>
-typename T::Result
+static typename T::Result
walkCaptureCategories(T visitor, Fortran::lower::AbstractConverter &converter,
const Fortran::semantics::Symbol &sym) {
if (isDerivedWithLenParameters(sym))
diff --git a/flang/test/Lower/HLFIR/internal-procedures.f90 b/flang/test/Lower/HLFIR/internal-procedures.f90
new file mode 100644
index 000000000000..4ad272ed4900
--- /dev/null
+++ b/flang/test/Lower/HLFIR/internal-procedures.f90
@@ -0,0 +1,38 @@
+! Test captured variables instantiation inside internal procedures
+! when lowering to HLFIR.
+! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s
+subroutine test_explicit_shape_array(x, n)
+ integer(8) :: n
+ real :: x(n)
+contains
+subroutine internal
+ call takes_array(x)
+end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QFtest_explicit_shape_arrayPinternal(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<!fir.box<!fir.array<?xf32>>>> {fir.host_assoc}) attributes {fir.internal_proc} {
+! CHECK: %[[VAL_1:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>
+! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.box<!fir.array<?xf32>>>
+! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_5]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_6]]#1 : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_4]](%[[VAL_7]]) {uniq_name = "_QFtest_explicit_shape_arrayEx"} : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xf32>>, !fir.ref<!fir.array<?xf32>>)
+
+subroutine test_assumed_shape(x)
+ real :: x(:)
+contains
+subroutine internal
+ call takes_array(x)
+end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QFtest_assumed_shapePinternal(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<!fir.box<!fir.array<?xf32>>>> {fir.host_assoc}) attributes {fir.internal_proc} {
+! CHECK: %[[VAL_1:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.box<!fir.array<?xf32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<?xf32>>>
+! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.box<!fir.array<?xf32>>>
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_4]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_6:.*]] = fir.shift %[[VAL_5]]#0 : (index) -> !fir.shift<1>
+! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_6]]) {uniq_name = "_QFtest_assumed_shapeEx"} : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
More information about the flang-commits
mailing list