diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h --- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h +++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h @@ -85,6 +85,11 @@ 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 diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -452,8 +452,34 @@ 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(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); } diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -12,6 +12,7 @@ #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" @@ -125,7 +126,26 @@ template hlfir::FortranEntity gen(const Fortran::evaluate::Constant &expr) { - TODO(getLoc(), "lowering constant to HLFIR"); + mlir::Location loc = getLoc(); + if constexpr (std::is_same_v) { + TODO(loc, "lowering derived type constant to HLFIR"); + } else { + fir::FirOpBuilder &builder = getBuilder(); + fir::ExtendedValue exv = + Fortran::lower::IntrinsicConstantBuilder::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()) { + 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 was lowered to unexpected format"); + } } template diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp --- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp +++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp @@ -97,3 +97,42 @@ 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 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( + loc, base.getType(), base, shapeOrShift, lenParams, nameAttr, flags); + return mlir::cast(declareOp.getOperation()); +} diff --git a/flang/test/Lower/HLFIR/constant.f90 b/flang/test/Lower/HLFIR/constant.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/HLFIR/constant.f90 @@ -0,0 +1,52 @@ +! Test lowering of Constant. +! 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> +! CHECK: %[[VAL_6:.*]] = arith.constant 5 : index +! CHECK: fir.declare %[[VAL_5]] typeparams %[[VAL_6]] {fortran_attrs = #fir.var_attrs, uniq_name = "[[name]]"} : (!fir.ref>, index) -> !fir.ref> +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> +! 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, uniq_name = "[[name]]"} : (!fir.ref>, !fir.shape<1>) -> !fir.ref> +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>> +! 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, uniq_name = "[[name]]"} : (!fir.ref>>, !fir.shape<1>, index) -> !fir.ref>> +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> +! 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, uniq_name = "_QQro[[name]]"} : (!fir.ref>, !fir.shapeshift<2>) -> !fir.ref> +end subroutine diff --git a/flang/test/Lower/HLFIR/expr-value.f90 b/flang/test/Lower/HLFIR/expr-value.f90 --- a/flang/test/Lower/HLFIR/expr-value.f90 +++ b/flang/test/Lower/HLFIR/expr-value.f90 @@ -1,7 +1,18 @@ ! 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, i32) -> i1 +end subroutine + +! CHECK-LABEL: func.func @_QPfoo_designator( +! CHECK-SAME: %[[arg0:.*]]: !fir.ref +subroutine foo_designator(n) + !CHECK: %[[n:.*]] = fir.declare %[[arg0]] {uniq_name = "_QFfoo_designatorEn"} : (!fir.ref) -> !fir.ref + print *, n + ! CHECK: %[[nval:.*]] = fir.load %[[n]] : !fir.ref + ! CHECK: fir.call @_FortranAioOutputInteger32(%{{.*}}, %[[nval]]) : (!fir.ref, i32) -> i1 end subroutine