[flang] Lower addresses inside global initializers in HLFIR

[jeanPerier]

Summary

Move the code to lower an expression to address or a box in HLFIR from
Bridge.cpp to ConvertExpr.cpp so that it can be used inside
ConvertVariable.cpp (that needs to use a different symbol map that the
one held in the bridge).

Lower NULL to hlfir.null.

This allows lowering derived type constant structure constructors with
pointer components into fir.global.

Depends on D141136

[jeanPerier]

Format file correctly after git conflict resolution.

[PeteSteinfeld]

All builds and tests correctly and looks good.

[clementval]

LGTM

flang/include/flang/Lower/ConvertExprToHLFIR.h

 ///
 /// Implements the conversion from Fortran::evaluate::Expr trees to HLFIR.
 ///
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_LOWER_CONVERTEXPRTOHLFIR_H
 #define FORTRAN_LOWER_CONVERTEXPRTOHLFIR_H
 
+#include "flang/Lower/StatementContext.h"
 #include "flang/Lower/Support/Utils.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/HLFIRTools.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 
 namespace mlir {
 class Location;
 } // namespace mlir
 
 namespace Fortran::lower {
 
 class AbstractConverter;
-class StatementContext;
 class SymMap;
 
 hlfir::EntityWithAttributes
 convertExprToHLFIR(mlir::Location loc, Fortran::lower::AbstractConverter &,
                    const Fortran::lower::SomeExpr &, Fortran::lower::SymMap &,
                    Fortran::lower::StatementContext &);
+
+inline fir::ExtendedValue
+translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
+                         hlfir::EntityWithAttributes entity,
+                         Fortran::lower::StatementContext &context) {
+  auto [exv, exvCleanup] =
+      hlfir::translateToExtendedValue(loc, builder, entity);
+  if (exvCleanup)
+    context.attachCleanup(*exvCleanup);
+  return exv;
+}
+
+fir::BoxValue convertExprToBox(mlir::Location loc,
+                               Fortran::lower::AbstractConverter &,
+                               const Fortran::lower::SomeExpr &,
+                               Fortran::lower::SymMap &,
+                               Fortran::lower::StatementContext &);
+
+// Probably not what you think.
+fir::ExtendedValue convertExprToAddress(mlir::Location loc,
+                                        Fortran::lower::AbstractConverter &,
+                                        const Fortran::lower::SomeExpr &,
+                                        Fortran::lower::SymMap &,
+                                        Fortran::lower::StatementContext &);
 } // namespace Fortran::lower
 
 #endif // FORTRAN_LOWER_CONVERTEXPRTOHLFIR_H

flang/include/flang/Lower/StatementContext.h

 //===-- StatementContext.h --------------------------------------*- C++ -*-===//
 //
 // 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/
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_LOWER_STATEMENTCONTEXT_H
 #define FORTRAN_LOWER_STATEMENTCONTEXT_H
 
+#include "llvm/ADT/STLExtras.h"
 #include "llvm/ADT/SmallVector.h"
 #include <functional>
 #include <optional>
 
 namespace Fortran::lower {
 
 /// When lowering a statement, temporaries for intermediate results may be
 /// allocated on the heap.  A StatementContext enables their deallocation

flang/lib/Lower/Bridge.cpp

Fortran::lower::pft::FunctionLikeUnit &owningProc =
         *getEval().getOwningProcedure();
     auto iter = owningProc.labelEvaluationMap.find(label);
     if (iter == owningProc.labelEvaluationMap.end())
       return nullptr;
     return iter->second;
   }
 
   fir::ExtendedValue
-  translateToExtendedValue(mlir::Location loc,
-                           hlfir::EntityWithAttributes entity,
-                           Fortran::lower::StatementContext &context) {
-    auto [exv, exvCleanup] =
-        hlfir::translateToExtendedValue(loc, getFirOpBuilder(), entity);
-    if (exvCleanup)
-      context.attachCleanup(*exvCleanup);
-    return exv;
-  }
-
-  fir::ExtendedValue
   genExprAddr(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()) {
-      hlfir::EntityWithAttributes loweredExpr =
-          Fortran::lower::convertExprToHLFIR(loc, *this, expr, localSymbols,
-                                             context);
-      if (expr.Rank() > 0 &&
-          !Fortran::evaluate::IsSimplyContiguous(expr, getFoldingContext()))
-        TODO(loc, "genExprAddr of non contiguous variables in HLFIR");
-      fir::ExtendedValue exv =
-          translateToExtendedValue(loc, loweredExpr, context);
-      if (fir::isa_trivial(fir::getBase(exv).getType()))
-        TODO(loc, "place trivial in memory");
-      if (const auto *mutableBox = exv.getBoxOf<fir::MutableBoxValue>())
-        exv = fir::factory::genMutableBoxRead(*builder, loc, *mutableBox);
-      return exv;
-    }
+    if (bridge.getLoweringOptions().getLowerToHighLevelFIR())
+      return Fortran::lower::convertExprToAddress(loc, *this, expr,
+                                                  localSymbols, context);
     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()) {
       hlfir::EntityWithAttributes loweredExpr =
           Fortran::lower::convertExprToHLFIR(loc, *this, expr, localSymbols,
                                              context);
-      fir::ExtendedValue exv =
-          translateToExtendedValue(loc, loweredExpr, context);
+      fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue(
+          loc, getFirOpBuilder(), 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);
genExprValue(const Fortran::lower::SomeExpr &expr,
     }
     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()) {
-      hlfir::EntityWithAttributes loweredExpr =
-          Fortran::lower::convertExprToHLFIR(loc, *this, expr, localSymbols,
+    if (bridge.getLoweringOptions().getLowerToHighLevelFIR())
+      return Fortran::lower::convertExprToBox(loc, *this, expr, localSymbols,
                                               stmtCtx);
-      auto exv = translateToExtendedValue(loc, loweredExpr, stmtCtx);
-      if (fir::isa_trivial(fir::getBase(exv).getType()))
-        TODO(loc, "place trivial in memory");
-      return fir::factory::createBoxValue(getFirOpBuilder(), loc, exv);
-    }
     return Fortran::lower::createBoxValue(loc, *this, expr, localSymbols,
                                           stmtCtx);
   }
 
   Fortran::evaluate::FoldingContext &getFoldingContext() override final {
     return foldingContext;
   }
 

flang/lib/Lower/ConvertExprToHLFIR.cpp

 #include "flang/Lower/CallInterface.h"
 #include "flang/Lower/ConvertCall.h"
 #include "flang/Lower/ConvertConstant.h"
 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/IntrinsicCall.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Optimizer/Builder/Complex.h"
+#include "flang/Optimizer/Builder/MutableBox.h"
 #include "flang/Optimizer/Builder/Runtime/Character.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/HLFIR/HLFIROps.h"
 #include "llvm/ADT/TypeSwitch.h"
 #include <optional>
 
 namespace {
 
hlfir::EntityWithAttributes gen(const Fortran::evaluate::Expr<T> &expr) {
     return std::visit([&](const auto &x) { return gen(x); }, expr.u);
   }
 
 private:
   hlfir::EntityWithAttributes
   gen(const Fortran::evaluate::BOZLiteralConstant &expr) {
     fir::emitFatalError(loc, "BOZ literal must be replaced by semantics");
   }
+
   hlfir::EntityWithAttributes gen(const Fortran::evaluate::NullPointer &expr) {
-    TODO(getLoc(), "lowering NullPointer to HLFIR");
+    auto nullop = getBuilder().create<hlfir::NullOp>(getLoc());
+    return mlir::cast<fir::FortranVariableOpInterface>(nullop.getOperation());
   }
+
   hlfir::EntityWithAttributes
   gen(const Fortran::evaluate::ProcedureDesignator &expr) {
     TODO(getLoc(), "lowering ProcDes to HLFIR");
   }
   hlfir::EntityWithAttributes gen(const Fortran::evaluate::ProcedureRef &expr) {
     TODO(getLoc(), "lowering ProcRef to HLFIR");
   }
 

 } // namespace
 
 hlfir::EntityWithAttributes Fortran::lower::convertExprToHLFIR(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
     Fortran::lower::StatementContext &stmtCtx) {
   return HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
 }
+
+fir::BoxValue Fortran::lower::convertExprToBox(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
+    Fortran::lower::StatementContext &stmtCtx) {
+  hlfir::EntityWithAttributes loweredExpr =
+      HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
+  auto exv = Fortran::lower::translateToExtendedValue(
+      loc, converter.getFirOpBuilder(), loweredExpr, stmtCtx);
+  if (fir::isa_trivial(fir::getBase(exv).getType()))
+    TODO(loc, "place trivial in memory");
+  return fir::factory::createBoxValue(converter.getFirOpBuilder(), loc, exv);
+}
+
+fir::ExtendedValue Fortran::lower::convertExprToAddress(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
+    Fortran::lower::StatementContext &stmtCtx) {
+  hlfir::EntityWithAttributes loweredExpr =
+      HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
+  if (expr.Rank() > 0 && !Fortran::evaluate::IsSimplyContiguous(
+                             expr, converter.getFoldingContext()))
+    TODO(loc, "genExprAddr of non contiguous variables in HLFIR");
+  fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue(
+      loc, converter.getFirOpBuilder(), loweredExpr, stmtCtx);
+  if (fir::isa_trivial(fir::getBase(exv).getType()))
+    TODO(loc, "place trivial in memory");
+  if (const auto *mutableBox = exv.getBoxOf<fir::MutableBoxValue>())
+    exv = fir::factory::genMutableBoxRead(converter.getFirOpBuilder(), loc,
+                                          *mutableBox);
+  return exv;
+}

flang/lib/Lower/ConvertVariable.cpp

if (const Fortran::semantics::DerivedTypeSpec *derived =
             declTy->AsDerived())
       return Fortran::semantics::CountLenParameters(*derived) > 0;
   return false;
 }
 
 fir::ExtendedValue Fortran::lower::genExtAddrInInitializer(
     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
     const Fortran::lower::SomeExpr &addr) {
-  if (converter.getLoweringOptions().getLowerToHighLevelFIR())
-    TODO(loc, "generate initializer address in HLFIR");
   Fortran::lower::SymMap globalOpSymMap;
   Fortran::lower::AggregateStoreMap storeMap;
   Fortran::lower::StatementContext stmtCtx;
   if (const Fortran::semantics::Symbol *sym =
           Fortran::evaluate::GetFirstSymbol(addr)) {
     // Length parameters processing will need care in global initializer
     // context.
     if (hasDerivedTypeWithLengthParameters(*sym))
       TODO(loc, "initial-data-target with derived type length parameters");
 
     auto var = Fortran::lower::pft::Variable(*sym, /*global=*/true);
     Fortran::lower::instantiateVariable(converter, var, globalOpSymMap,
                                         storeMap);
   }
+
+  if (converter.getLoweringOptions().getLowerToHighLevelFIR())
+    return Fortran::lower::convertExprToAddress(loc, converter, addr,
+                                                globalOpSymMap, stmtCtx);
   return Fortran::lower::createInitializerAddress(loc, converter, addr,
                                                   globalOpSymMap, stmtCtx);
 }
 
 /// create initial-data-target fir.box in a global initializer region.
 mlir::Value Fortran::lower::genInitialDataTarget(
     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
     mlir::Type boxType, const Fortran::lower::SomeExpr &initialTarget,
     bool couldBeInEquivalence) {
-  if (converter.getLoweringOptions().getLowerToHighLevelFIR())
-    TODO(loc, "initial data target in HLFIR");
   Fortran::lower::SymMap globalOpSymMap;
   Fortran::lower::AggregateStoreMap storeMap;
   Fortran::lower::StatementContext stmtCtx;
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
           initialTarget))
     return fir::factory::createUnallocatedBox(
         builder, loc, boxType,
if (intrinsic && intrinsic->name == "null") {
       mlir::Value box =
           fir::factory::createUnallocatedBox(builder, loc, boxType, {});
       return box;
     }
   }
 
   mlir::Value targetBox;
   mlir::Value targetShift;
+  if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
+    auto target = Fortran::lower::convertExprToBox(
+        loc, converter, initialTarget, globalOpSymMap, stmtCtx);
+    targetBox = fir::getBase(target);
+    targetShift = builder.createShape(loc, target);
+  } else {
     if (initialTarget.Rank() > 0) {
       auto target = Fortran::lower::createSomeArrayBox(converter, initialTarget,
                                                        globalOpSymMap, stmtCtx);
       targetBox = fir::getBase(target);
       targetShift = builder.createShape(loc, target);
     } else {
       fir::ExtendedValue addr = Fortran::lower::createInitializerAddress(
           loc, converter, initialTarget, globalOpSymMap, stmtCtx);
       targetBox = builder.createBox(loc, addr);
       // Nothing to do for targetShift, the target is a scalar.
     }
+  }
   // The targetBox is a fir.box<T>, not a fir.box<fir.ptr<T>> as it should for
   // pointers (this matters to get the POINTER attribute correctly inside the
   // initial value of the descriptor).
   // Create a fir.rebox to set the attribute correctly, and use targetShift
   // to preserve the target lower bounds if any.
   return builder.create<fir::ReboxOp>(loc, boxType, targetBox, targetShift,
                                       /*slice=*/mlir::Value{});
 }

flang/test/Lower/HLFIR/constant-derived.f90

 ! Test lowering of Constant<SomeDerived>.
-! TODO: remove "-I nowhere" once derived type descriptor can be lowered.
 ! RUN: bbc -hlfir -emit-fir -o - -I nowhere %s 2>&1 | FileCheck %s
 
 subroutine test_constant_scalar()
   type myderived
     integer :: i
     integer :: j = 42
     real :: x(2)
     character(10) :: c
   end type
   print *, myderived(i=1, x=[2.,3.], c="hello")
 ! CHECK-LABEL: func.func @_QPtest_constant_scalar() {
 ! CHECK:  fir.address_of(@[[CST:_QQro._QFtest_constant_scalarTmyderived..*]])
 end subroutine
 
+subroutine test_constant_scalar_ptr_component()
+  type myderived
+    real, pointer :: x
+    real, pointer :: y(:)
+  end type
+  real, target, save :: targ(100)
+  call test(myderived(NULL(), targ(1:50:5)))
+! CHECK-LABEL: func.func @_QPtest_constant_scalar_ptr_component() {
+! CHECK:  fir.address_of(@[[CST_TARGET:_QQro._QFtest_constant_scalar_ptr_componentTmyderived..*]])
+end subroutine
+
 ! CHECK: fir.global internal @[[CST]] constant : !fir.type<[[DERIVED:_QFtest_constant_scalarTmyderived{i:i32,j:i32,x:!fir.array<2xf32>,c:!fir.char<1,10>}]]> {
 ! CHECK:   %[[VAL_0:.*]] = fir.undefined !fir.type<[[DERIVED]]>
 ! CHECK:   %[[VAL_1:.*]] = fir.field_index i, !fir.type<[[DERIVED]]>
 ! CHECK:   %[[VAL_2:.*]] = arith.constant 1 : i32
 ! CHECK:   %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_2]], ["i", !fir.type<[[DERIVED]]>] : (!fir.type<[[DERIVED]]>, i32) -> !fir.type<[[DERIVED]]>
 ! CHECK:   %[[VAL_4:.*]] = fir.field_index j, !fir.type<[[DERIVED]]>
 ! CHECK:   %[[VAL_5:.*]] = arith.constant 42 : i32
 ! CHECK:   %[[VAL_6:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_5]], ["j", !fir.type<[[DERIVED]]>] : (!fir.type<[[DERIVED]]>, i32) -> !fir.type<[[DERIVED]]>
 ! CHECK:   %[[VAL_7:.*]] = fir.field_index x, !fir.type<[[DERIVED]]>
 ! CHECK:   %[[VAL_8:.*]] = fir.undefined !fir.array<2xf32>
 ! CHECK:   %[[VAL_9:.*]] = arith.constant 2.000000e+00 : f32
 ! CHECK:   %[[VAL_10:.*]] = fir.insert_value %[[VAL_8]], %[[VAL_9]], [0 : index] : (!fir.array<2xf32>, f32) -> !fir.array<2xf32>
 ! CHECK:   %[[VAL_11:.*]] = arith.constant 3.000000e+00 : f32
 ! CHECK:   %[[VAL_12:.*]] = fir.insert_value %[[VAL_10]], %[[VAL_11]], [1 : index] : (!fir.array<2xf32>, f32) -> !fir.array<2xf32>
 ! CHECK:   %[[VAL_13:.*]] = arith.constant 2 : index
 ! CHECK:   %[[VAL_14:.*]] = fir.insert_value %[[VAL_6]], %[[VAL_12]], ["x", !fir.type<[[DERIVED]]>] : (!fir.type<[[DERIVED]]>, !fir.array<2xf32>) -> !fir.type<[[DERIVED]]>
 ! CHECK:   %[[VAL_15:.*]] = fir.field_index c, !fir.type<[[DERIVED]]>
 ! CHECK:   %[[VAL_16:.*]] = fir.string_lit "hello     "(10) : !fir.char<1,10>
 ! CHECK:   %[[VAL_17:.*]] = arith.constant 10 : index
 ! CHECK:   %[[VAL_18:.*]] = fir.insert_value %[[VAL_14]], %[[VAL_16]], ["c", !fir.type<[[DERIVED]]>] : (!fir.type<[[DERIVED]]>, !fir.char<1,10>) -> !fir.type<[[DERIVED]]>
 ! CHECK:   fir.has_value %[[VAL_18]] : !fir.type<[[DERIVED]]>
 ! CHECK: }
+
+! CHECK: fir.global internal @[[CST_TARGET]] constant :
+! CHECK-SAME: !fir.type<[[DERIVED_2:_QFtest_constant_scalar_ptr_componentTmyderived{x:!fir.box<!fir.ptr<f32>>,y:!fir.box<!fir.ptr<!fir.array<\?xf32>>>}]]> {
+! CHECK:   %[[VAL_0:.*]] = fir.undefined !fir.type<[[DERIVED_2]]>
+! CHECK:   %[[VAL_1:.*]] = fir.field_index x, !fir.type<[[DERIVED_2]]>
+! CHECK:   %[[VAL_2:.*]] = fir.zero_bits !fir.ptr<f32>
+! CHECK:   %[[VAL_3:.*]] = fir.embox %[[VAL_2]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
+! CHECK:   %[[VAL_4:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_3]], ["x", !fir.type<[[DERIVED_2]]>] : (!fir.type<[[DERIVED_2]]>, !fir.box<!fir.ptr<f32>>) -> !fir.type<[[DERIVED_2]]>
+! CHECK:   %[[VAL_5:.*]] = fir.field_index y, !fir.type<[[DERIVED_2]]>
+! CHECK:   %[[VAL_6:.*]] = fir.address_of(@_QFtest_constant_scalar_ptr_componentEtarg) : !fir.ref<!fir.array<100xf32>>
+! CHECK:   %[[VAL_7:.*]] = arith.constant 100 : index
+! CHECK:   %[[VAL_8:.*]] = fir.shape %[[VAL_7]] : (index) -> !fir.shape<1>
+! CHECK:   %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_6]](%[[VAL_8]])
+! CHECK:   %[[VAL_11:.*]] = arith.constant 1 : index
+! CHECK:   %[[VAL_13:.*]] = arith.constant 50 : index
+! CHECK:   %[[VAL_15:.*]] = arith.constant 5 : index
+! CHECK:   %[[VAL_16:.*]] = arith.constant 10 : index
+! CHECK:   %[[VAL_17:.*]] = fir.shape %[[VAL_16]] : (index) -> !fir.shape<1>
+! CHECK:   %[[VAL_18:.*]] = hlfir.designate %[[VAL_9]]#0 (%[[VAL_11]]:%[[VAL_13]]:%[[VAL_15]])  shape %[[VAL_17]] : (!fir.ref<!fir.array<100xf32>>, index, index, index, !fir.shape<1>) -> !fir.box<!fir.array<10xf32>>
+! CHECK:   %[[VAL_19:.*]] = fir.rebox %[[VAL_18]] : (!fir.box<!fir.array<10xf32>>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK:   %[[VAL_20:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_19]], ["y", !fir.type<[[DERIVED_2]]>] : (!fir.type<[[DERIVED_2]]>, !fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.type<[[DERIVED_2]]>
+! CHECK:   fir.has_value %[[VAL_20]] : !fir.type<[[DERIVED_2]]>
+! CHECK: }