fir::ExtendedValue
translateToExtendedValue(fir::FortranVariableOpInterface fortranVariable);
+/// Generate declaration for a fir::ExtendedValue in memory.
+FortranEntity genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
+ const fir::ExtendedValue &exv, llvm::StringRef name,
+ fir::FortranVariableFlagsAttr flags);
+
} // namespace hlfir
#endif // FORTRAN_OPTIMIZER_BUILDER_HLFIRTOOLS_H
Fortran::lower::StatementContext &context,
mlir::Location *locPtr = nullptr) override final {
mlir::Location loc = locPtr ? *locPtr : toLocation();
- if (bridge.getLoweringOptions().getLowerToHighLevelFIR())
- TODO(loc, "lower expr to HLFIR value");
+ if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) {
+ hlfir::FortranEntity loweredExpr = Fortran::lower::convertExprToHLFIR(
+ loc, *this, expr, localSymbols, context);
+ fir::ExtendedValue exv =
+ translateToExtendedValue(loc, loweredExpr, context);
+ // Load scalar references to integer, logical, real, or complex value
+ // to an mlir value, dereference allocatable and pointers, and get rid
+ // of fir.box that are no needed or create a copy into contiguous memory.
+ return exv.match(
+ [&](const fir::UnboxedValue &box) -> fir::ExtendedValue {
+ if (mlir::Type elementType = fir::dyn_cast_ptrEleTy(box.getType()))
+ if (fir::isa_trivial(elementType))
+ return getFirOpBuilder().create<fir::LoadOp>(loc, box);
+ return box;
+ },
+ [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
+ return box;
+ },
+ [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
+ return box;
+ },
+ [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {
+ return box;
+ },
+ [&](const auto &) -> fir::ExtendedValue {
+ TODO(loc, "lower descriptor designator to HLFIR value");
+ });
+ }
return Fortran::lower::createSomeExtendedExpression(loc, *this, expr,
localSymbols, context);
}
#include "flang/Lower/ConvertExprToHLFIR.h"
#include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/ConvertConstant.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/SymbolMap.h"
#include "flang/Optimizer/Builder/Todo.h"
template <typename T>
hlfir::FortranEntity gen(const Fortran::evaluate::Constant<T> &expr) {
- TODO(getLoc(), "lowering constant to HLFIR");
+ mlir::Location loc = getLoc();
+ if constexpr (std::is_same_v<T, Fortran::evaluate::SomeDerived>) {
+ TODO(loc, "lowering derived type constant to HLFIR");
+ } else {
+ fir::FirOpBuilder &builder = getBuilder();
+ fir::ExtendedValue exv =
+ Fortran::lower::IntrinsicConstantBuilder<T::category, T::kind>::gen(
+ builder, loc, expr, /*outlineBigConstantInReadOnlyMemory=*/true);
+ if (const auto *scalarBox = exv.getUnboxed())
+ if (fir::isa_trivial(scalarBox->getType()))
+ return hlfir::FortranEntity(*scalarBox);
+ if (auto addressOf = fir::getBase(exv).getDefiningOp<fir::AddrOfOp>()) {
+ auto flags = fir::FortranVariableFlagsAttr::get(
+ builder.getContext(), fir::FortranVariableFlagsEnum::parameter);
+ return hlfir::genDeclare(
+ loc, builder, exv,
+ addressOf.getSymbol().getRootReference().getValue(), flags);
+ }
+ fir::emitFatalError(loc, "Constant<T> was lowered to unexpected format");
+ }
}
template <typename T>
getExplicitLbounds(variable));
return variable.getBase();
}
+
+hlfir::FortranEntity hlfir::genDeclare(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ const fir::ExtendedValue &exv,
+ llvm::StringRef name,
+ fir::FortranVariableFlagsAttr flags) {
+
+ mlir::Value base = fir::getBase(exv);
+ assert(fir::isa_passbyref_type(base.getType()) &&
+ "entity being declared must be in memory");
+ mlir::Value shapeOrShift;
+ llvm::SmallVector<mlir::Value> lenParams;
+ exv.match(
+ [&](const fir::CharBoxValue &box) {
+ lenParams.emplace_back(box.getLen());
+ },
+ [&](const fir::ArrayBoxValue &) {
+ shapeOrShift = builder.createShape(loc, exv);
+ },
+ [&](const fir::CharArrayBoxValue &box) {
+ shapeOrShift = builder.createShape(loc, exv);
+ lenParams.emplace_back(box.getLen());
+ },
+ [&](const fir::BoxValue &box) {
+ if (!box.getLBounds().empty())
+ shapeOrShift = builder.createShape(loc, exv);
+ lenParams.append(box.getExplicitParameters().begin(),
+ box.getExplicitParameters().end());
+ },
+ [&](const fir::MutableBoxValue &box) {
+ lenParams.append(box.nonDeferredLenParams().begin(),
+ box.nonDeferredLenParams().end());
+ },
+ [](const auto &) {});
+ auto nameAttr = mlir::StringAttr::get(builder.getContext(), name);
+ auto declareOp = builder.create<fir::DeclareOp>(
+ loc, base.getType(), base, shapeOrShift, lenParams, nameAttr, flags);
+ return mlir::cast<fir::FortranVariableOpInterface>(declareOp.getOperation());
+}
--- /dev/null
+! Test lowering of Constant<T>.
+! RUN: bbc -hlfir -emit-fir -o - %s 2>&1 | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPtest_constant_scalar()
+subroutine test_constant_scalar()
+ print *, (10., 20.)
+ ! CHECK-DAG: %[[VAL_0:.*]] = arith.constant 2.000000e+01 : f32
+ ! CHECK-DAG: %[[VAL_1:.*]] = arith.constant 1.000000e+01 : f32
+ ! CHECK: %[[VAL_7:.*]] = fir.undefined !fir.complex<4>
+ ! CHECK: %[[VAL_8:.*]] = fir.insert_value %[[VAL_7]], %[[VAL_1]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
+ ! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_8]], %[[VAL_0]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4>
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_constant_scalar_char()
+subroutine test_constant_scalar_char()
+ print *, "hello"
+! CHECK: %[[VAL_5:.*]] = fir.address_of(@[[name:.*]]) : !fir.ref<!fir.char<1,5>>
+! CHECK: %[[VAL_6:.*]] = arith.constant 5 : index
+! CHECK: fir.declare %[[VAL_5]] typeparams %[[VAL_6]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "[[name]]"} : (!fir.ref<!fir.char<1,5>>, index) -> !fir.ref<!fir.char<1,5>>
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_constant_array()
+subroutine test_constant_array()
+ print *, [1., 2., 3.]
+! CHECK: %[[VAL_5:.*]] = fir.address_of(@[[name:.*]]) : !fir.ref<!fir.array<3xf32>>
+! CHECK: %[[VAL_6:.*]] = arith.constant 3 : index
+! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1>
+! CHECK: fir.declare %[[VAL_5]](%[[VAL_7]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "[[name]]"} : (!fir.ref<!fir.array<3xf32>>, !fir.shape<1>) -> !fir.ref<!fir.array<3xf32>>
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_constant_array_char()
+subroutine test_constant_array_char()
+ print *, ["abc", "cde"]
+! CHECK: %[[VAL_5:.*]] = fir.address_of(@[[name:.*]]) : !fir.ref<!fir.array<2x!fir.char<1,3>>>
+! CHECK: %[[VAL_6:.*]] = arith.constant 2 : index
+! CHECK: %[[VAL_7:.*]] = arith.constant 3 : index
+! CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1>
+! CHECK: fir.declare %[[VAL_5]](%[[VAL_8]]) typeparams %[[VAL_7]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "[[name]]"} : (!fir.ref<!fir.array<2x!fir.char<1,3>>>, !fir.shape<1>, index) -> !fir.ref<!fir.array<2x!fir.char<1,3>>>
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_constant_with_lower_bounds()
+subroutine test_constant_with_lower_bounds()
+ integer, parameter :: i(-1:0, -1:0) = reshape([1,2,3,4], shape=[2,2])
+ print *, i
+! CHECK: %[[VAL_12:.*]] = fir.address_of(@_QQro[[name:.*]]) : !fir.ref<!fir.array<2x2xi32>>
+! CHECK: %[[VAL_13:.*]] = arith.constant 2 : index
+! CHECK: %[[VAL_14:.*]] = arith.constant 2 : index
+! CHECK: %[[VAL_15:.*]] = arith.constant -1 : index
+! CHECK: %[[VAL_16:.*]] = arith.constant -1 : index
+! CHECK: %[[VAL_17:.*]] = fir.shape_shift %[[VAL_15]], %[[VAL_13]], %[[VAL_16]], %[[VAL_14]] : (index, index, index, index) -> !fir.shapeshift<2>
+! CHECK: fir.declare %[[VAL_12]](%[[VAL_17]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro[[name]]"} : (!fir.ref<!fir.array<2x2xi32>>, !fir.shapeshift<2>) -> !fir.ref<!fir.array<2x2xi32>>
+end subroutine
! Test lowering of of expressions as values
-! RUN: %not_todo_cmd bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
+! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
+! CHECK-LABEL: func.func @_QPfoo()
subroutine foo()
- ! CHECK: not yet implemented: lower expr to HLFIR value
- print *, 42
+ print *, 42
+ ! CHECK: %[[c42:.*]] = arith.constant 42 : i32
+ ! CHECK: fir.call @_FortranAioOutputInteger32(%{{.*}}, %[[c42]]) : (!fir.ref<i8>, i32) -> i1
+end subroutine
+
+! CHECK-LABEL: func.func @_QPfoo_designator(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<i32>
+subroutine foo_designator(n)
+ !CHECK: %[[n:.*]] = fir.declare %[[arg0]] {uniq_name = "_QFfoo_designatorEn"} : (!fir.ref<i32>) -> !fir.ref<i32>
+ print *, n
+ ! CHECK: %[[nval:.*]] = fir.load %[[n]] : !fir.ref<i32>
+ ! CHECK: fir.call @_FortranAioOutputInteger32(%{{.*}}, %[[nval]]) : (!fir.ref<i8>, i32) -> i1
end subroutine