[flang] lower intrinsic constants to HLFIR

[jeanPerier]

Summary

Use the utility to lower Constant<T> that was split from current lowering
in https://reviews.llvm.org/D136955.

The difference in HLFIR is the addition of a fir.declare on constant
outlined in memory so that all the information about them is available.

Lowering to HLFIR is enabled in Brideg::genExprValue to allow testing
of scalar constant lowering.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Optimizer/Builder/HLFIRTools.h

 translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
                          FortranEntity entity);
 
 /// Function to translate FortranVariableOpInterface to fir::ExtendedValue.
 /// It does not generate any IR, and is a simple packaging operation.
 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

flang/lib/Lower/Bridge.cpp

return Fortran::lower::createSomeExtendedAddress(loc, *this, expr,
                                                      localSymbols, context);
   }
 
   fir::ExtendedValue
   genExprValue(const Fortran::lower::SomeExpr &expr,
                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);
   }
 
   fir::ExtendedValue
   genExprBox(mlir::Location loc, const Fortran::lower::SomeExpr &expr,
              Fortran::lower::StatementContext &stmtCtx) override final {
     if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) {

flang/lib/Lower/ConvertExprToHLFIR.cpp

 //===-- ConvertExprToHLFIR.cpp --------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #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"
 
 namespace {
 
 /// Lower Designators to HLFIR.
 class HlfirDesignatorBuilder {
private:
 
   template <typename T>
   hlfir::FortranEntity gen(const Fortran::evaluate::FunctionRef<T> &expr) {
     TODO(getLoc(), "lowering funcRef to HLFIR");
   }
 
   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>
   hlfir::FortranEntity gen(const Fortran::evaluate::ArrayConstructor<T> &expr) {
     TODO(getLoc(), "lowering ArrayCtor to HLFIR");
   }
 
   template <Fortran::common::TypeCategory TC1, int KIND,

flang/lib/Optimizer/Builder/HLFIRTools.cpp

if (variable.isArray())
           getExplicitExtents(variable), getExplicitLbounds(variable));
     return fir::CharBoxValue(variable.getBase(), variable.getExplicitCharLen());
   }
   if (variable.isArray())
     return fir::ArrayBoxValue(variable.getBase(), getExplicitExtents(variable),
                               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());
+}

flang/test/Lower/HLFIR/constant.f90

+! 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

flang/test/Lower/HLFIR/expr-value.f90

 ! 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