[flang-commits] [flang] 32e7e17 - [flang] Add hlfir.declare operation

Jean Perier via flang-commits flang-commits at lists.llvm.org
Mon Nov 14 01:28:27 PST 2022


Author: Jean Perier
Date: 2022-11-14T10:27:12+01:00
New Revision: 32e7e17d860b17731bc9347ab0488ea072356f50

URL: https://github.com/llvm/llvm-project/commit/32e7e17d860b17731bc9347ab0488ea072356f50
DIFF: https://github.com/llvm/llvm-project/commit/32e7e17d860b17731bc9347ab0488ea072356f50.diff

LOG: [flang] Add hlfir.declare operation

This operation will be used to declare named variables in HLFIR.
See the added description in HLFIROpBase.td for more info about it.

The motivation behind this operation is described in https://reviews.llvm.org/D137634.

The FortranVariableInterface verifier is changed a bit. It used to
operate using the result type to verify the provided shape and length
parameters. This is a bit incorrect because what matters to verify the
information is the input address (This worked OK with fir.declare where
the input memref type is the same as the output result). Also, not all
operation defining variables will have an input memref with the same
meaning (hlfir.designate and hlfir.associate for instance).
Hence, this verifier is now optional and must be provided a memref to
operate.

Differential Revision: https://reviews.llvm.org/D137781

Added: 
    flang/include/flang/Optimizer/HLFIR/HLFIROps.h
    flang/include/flang/Optimizer/HLFIR/HLFIROps.td
    flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
    flang/test/HLFIR/declare.fir
    flang/test/HLFIR/invalid.fir

Modified: 
    flang/include/flang/Optimizer/Dialect/FIROps.td
    flang/include/flang/Optimizer/Dialect/FIRType.h
    flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td
    flang/include/flang/Optimizer/HLFIR/CMakeLists.txt
    flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
    flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td
    flang/lib/Optimizer/Dialect/FIROps.cpp
    flang/lib/Optimizer/Dialect/FortranVariableInterface.cpp
    flang/lib/Optimizer/HLFIR/IR/CMakeLists.txt
    flang/lib/Optimizer/HLFIR/IR/HLFIRDialect.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td
index 1669ac1e60cf4..005fad8362428 100644
--- a/flang/include/flang/Optimizer/Dialect/FIROps.td
+++ b/flang/include/flang/Optimizer/Dialect/FIROps.td
@@ -2931,6 +2931,8 @@ def fir_DeclareOp : fir_Op<"declare", [AttrSizedOperandSegments,
     $memref (`(` $shape^ `)`)? (`typeparams` $typeparams^)?
      attr-dict `:` functional-type(operands, results)
   }];
+
+  let hasVerifier = 1;
 }
 
 #endif

diff  --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h
index da22fce81a598..b261cb92f4ee4 100644
--- a/flang/include/flang/Optimizer/Dialect/FIRType.h
+++ b/flang/include/flang/Optimizer/Dialect/FIRType.h
@@ -335,6 +335,16 @@ inline mlir::Type wrapInClassOrBoxType(mlir::Type eleTy,
   return fir::BoxType::get(eleTy);
 }
 
+/// Is `t` an address to fir.box or class type?
+inline bool isBoxAddress(mlir::Type t) {
+  return fir::isa_ref_type(t) && fir::unwrapRefType(t).isa<fir::BaseBoxType>();
+}
+
+/// Is `t` a fir.box or class address or value type?
+inline bool isBoxAddressOrValue(mlir::Type t) {
+  return fir::unwrapRefType(t).isa<fir::BaseBoxType>();
+}
+
 } // namespace fir
 
 #endif // FORTRAN_OPTIMIZER_DIALECT_FIRTYPE_H

diff  --git a/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td b/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td
index 5911f39fa4a4b..1cd1abb1bf59f 100644
--- a/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td
+++ b/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td
@@ -74,7 +74,10 @@ def fir_FortranVariableOpInterface : OpInterface<"FortranVariableOpInterface"> {
     /// Get the sequence type or scalar value type corresponding to this
     /// variable.
     mlir::Type getElementOrSequenceType() {
-      return fir::unwrapPassByRefType(fir::unwrapRefType(getBase().getType()));
+      mlir::Type type = fir::unwrapPassByRefType(fir::unwrapRefType(getBase().getType()));
+      if (auto boxCharType = type.dyn_cast<fir::BoxCharType>())
+        return boxCharType.getEleTy();
+      return type;
     }
 
     /// Get the scalar value type corresponding to this variable.
@@ -135,27 +138,22 @@ def fir_FortranVariableOpInterface : OpInterface<"FortranVariableOpInterface"> {
 
     /// Is this variable represented as a fir.box or fir.class address ?
     bool isBoxAddress() {
-      mlir::Type type = getBase().getType();
-      return fir::isa_ref_type(type) &&
-         fir::unwrapRefType(type).isa<fir::BaseBoxType>();
+      return fir::isBoxAddress(getBase().getType());
     }
 
     /// Is this variable represented as the value or address of a fir.box or
     /// fir.class ?
     bool isBox() {
-      return fir::unwrapRefType(getBase().getType()).isa<fir::BaseBoxType>();
+      return fir::isBoxAddressOrValue(getBase().getType());
     }
 
-    /// Interface verifier imlementation.
-    mlir::LogicalResult verifyImpl();
+    /// Interface verifier imlementation for declare operations
+    mlir::LogicalResult verifyDeclareLikeOpImpl(mlir::Value memRef);
 
   }];
 
   let cppNamespace = "fir";
 
-  let verify = [{
-    return ::mlir::cast<::fir::FortranVariableOpInterface>($_op).verifyImpl();
-  }];
 }
 
 #endif  // FORTRANVARIABLEINTERFACE

diff  --git a/flang/include/flang/Optimizer/HLFIR/CMakeLists.txt b/flang/include/flang/Optimizer/HLFIR/CMakeLists.txt
index 35fda6d1610ec..31ce88e84cb5b 100644
--- a/flang/include/flang/Optimizer/HLFIR/CMakeLists.txt
+++ b/flang/include/flang/Optimizer/HLFIR/CMakeLists.txt
@@ -5,4 +5,9 @@ mlir_tablegen(HLFIRDialect.h.inc -gen-dialect-decls -dialect=hlfir)
 mlir_tablegen(HLFIRDialect.cpp.inc -gen-dialect-defs -dialect=hlfir)
 mlir_tablegen(HLFIRAttributes.h.inc -gen-attrdef-decls -attrdefs-dialect=hlfir)
 mlir_tablegen(HLFIRAttributes.cpp.inc -gen-attrdef-defs -attrdefs-dialect=hlfir)
+
+set(LLVM_TARGET_DEFINITIONS HLFIROps.td)
+mlir_tablegen(HLFIROps.h.inc -gen-op-decls)
+mlir_tablegen(HLFIROps.cpp.inc -gen-op-defs)
+
 add_public_tablegen_target(HLFIROpsIncGen)

diff  --git a/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h b/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
index 2e7f615065abd..dd7708bad195d 100644
--- a/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
+++ b/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
@@ -16,6 +16,11 @@
 
 #include "mlir/IR/Dialect.h"
 
+namespace hlfir {
+/// Is this a type that can be used for an HLFIR variable ?
+bool isFortranVariableType(mlir::Type);
+} // namespace hlfir
+
 #include "flang/Optimizer/HLFIR/HLFIRDialect.h.inc"
 
 #define GET_TYPEDEF_CLASSES

diff  --git a/flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td b/flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td
index 9b3578c406847..ffb33c0870607 100644
--- a/flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td
+++ b/flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td
@@ -70,4 +70,9 @@ def hlfir_ExprType : TypeDef<hlfir_Dialect, "Expr"> {
 
 }
 
+def IsFortranVariablePred
+        : CPred<"::hlfir::isFortranVariableType($_self)">;
+
+def AnyFortranVariableLike : Type<IsFortranVariablePred, "any HLFIR variable type">;
+
 #endif // FORTRAN_DIALECT_HLFIR_OP_BASE

diff  --git a/flang/include/flang/Optimizer/HLFIR/HLFIROps.h b/flang/include/flang/Optimizer/HLFIR/HLFIROps.h
new file mode 100644
index 0000000000000..8e4d5a9d7f496
--- /dev/null
+++ b/flang/include/flang/Optimizer/HLFIR/HLFIROps.h
@@ -0,0 +1,21 @@
+//===-- HLFIROps.h - FIR operations -----------------------------*- 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_OPTIMIZER_HLFIR_HLFIROPS_H
+#define FORTRAN_OPTIMIZER_HLFIR_HLFIROPS_H
+
+#include "flang/Optimizer/Dialect/FIRAttr.h"
+#include "flang/Optimizer/Dialect/FIRType.h"
+#include "flang/Optimizer/Dialect/FortranVariableInterface.h"
+#include "flang/Optimizer/HLFIR/HLFIRDialect.h"
+#include "mlir/Interfaces/SideEffectInterfaces.h"
+
+#define GET_OP_CLASSES
+#include "flang/Optimizer/HLFIR/HLFIROps.h.inc"
+
+#endif // FORTRAN_OPTIMIZER_HLFIR_HLFIROPS_H

diff  --git a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td
new file mode 100644
index 0000000000000..60430ded39736
--- /dev/null
+++ b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td
@@ -0,0 +1,119 @@
+//===-- HLFIROps.td - HLFIR operation definitions ----------*- tablegen -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+///
+/// \file
+/// Definition of the HLFIR dialect operations
+///
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_DIALECT_HLFIR_OPS
+#define FORTRAN_DIALECT_HLFIR_OPS
+
+include "flang/Optimizer/HLFIR/HLFIROpBase.td"
+include "flang/Optimizer/Dialect/FIRTypes.td"
+include "flang/Optimizer/Dialect/FIRAttr.td"
+include "flang/Optimizer/Dialect/FortranVariableInterface.td"
+include "mlir/IR/BuiltinAttributes.td"
+
+// Base class for FIR operations.
+// All operations automatically get a prefix of "hlfir.".
+class hlfir_Op<string mnemonic, list<Trait> traits>
+  : Op<hlfir_Dialect, mnemonic, traits>;
+
+
+
+def hlfir_DeclareOp : hlfir_Op<"declare", [AttrSizedOperandSegments,
+    DeclareOpInterfaceMethods<fir_FortranVariableOpInterface>]> {
+  let summary = "declare a variable and produce an SSA value that can be used as a variable in HLFIR operations";
+
+  let description = [{
+    Tie the properties of a Fortran variable to an address. The properties
+    include bounds, length parameters, and Fortran attributes.
+
+    The arguments are the same as for fir.declare.
+
+    The main 
diff erence with fir.declare is that hlfir.declare returns two
+    values:
+      - the first one is an SSA value that allows retrieving the variable
+        address, bounds, and type parameters at any point without requiring
+        access to the defining operation. This may be:
+        - for scalar numerical, logical, or derived type without length
+          parameters: a fir.ref<T> (e.g. fir.ref<i32>)
+        - for scalar characters: a fir.boxchar<kind> or fir.ref<fir.char<kind,
+          cst_len>>
+        - for arrays of types without length parameters, without lower bounds,
+          that are not polymorphic and with a constant shape:
+          fir.ref<fir.array<cst_shapexT>>
+        - for all non pointer/non allocatable entities: fir.box<T>, and
+          fir.class<T> for polymorphic entities.
+        - for all pointers/allocatables:
+          fir.ref<fir.box<fir.ptr<T>>>/fir.ref<fir.box<fir.heap<T>>>
+      - the second value has the same type as the input memref, and is the
+        same. If it is a fir.box or fir.class, it may not contain accurate
+        local lower bound values. It is intended to be used when generating FIR
+        from HLFIR in order to avoid descriptor creation for simple entities.
+
+    Example:
+
+    CHARACTER(n) :: c(10:n, 20:n)
+
+    Can be represented as:
+    ```
+    func.func @foo(%arg0: !fir.ref<!fir.array<?x?x!fir.char<1,?>>>, %arg1: !fir.ref<i64>) {
+      %c10 = arith.constant 10 : index
+      %c20 = arith.constant 20 : index
+      %1 = fir.load %ag1 : fir.ref<i64>
+      %2 = fir.shape_shift %c10, %1, %c20, %1 : (index, index, index, index) -> !fir.shapeshift<2>
+      %3 = hfir.declare %arg0(%2) typeparams %1 {uniq_name = "c"} (fir.ref<!fir.array<?x?x!fir.char<1,?>>>, fir.shapeshift<2>, index) -> (fir.box<!fir.array<?x?x!fir.char<1,?>>>, fir.ref<!fir.array<?x?x!fir.char<1,?>>>)
+      // ... uses %3#0 as "c"
+    }
+   ```
+  }];
+
+  let arguments = (ins
+    AnyRefOrBox:$memref,
+    Optional<AnyShapeOrShiftType>:$shape,
+    Variadic<AnyIntegerType>:$typeparams,
+    Builtin_StringAttr:$uniq_name,
+    OptionalAttr<fir_FortranVariableFlagsAttr>:$fortran_attrs
+  );
+
+  let results = (outs AnyFortranVariableLike, AnyRefOrBoxLike);
+
+  let assemblyFormat = [{
+    $memref (`(` $shape^ `)`)? (`typeparams` $typeparams^)?
+     attr-dict `:` functional-type(operands, results)
+  }];
+
+  let builders = [
+    OpBuilder<(ins "mlir::Value":$memref, "llvm::StringRef":$uniq_name,
+      CArg<"mlir::Value", "{}">:$shape, CArg<"mlir::ValueRange", "{}">:$typeparams,
+      CArg<"fir::FortranVariableFlagsAttr", "{}">:$fortran_attrs)>];
+
+  let extraClassDeclaration = [{
+    /// Get the variable original base (same as input). It lacks
+    /// any explicit lower bounds and the extents might not be retrievable
+    /// from it. This matches what is used as a "base" in FIR.
+    mlir::Value getOriginalBase() {
+      return getResult(1);
+    }
+
+    /// Override FortranVariableInterface default implementation
+    mlir::Value getBase() {
+      return getResult(0);
+    }
+
+    /// Given a FIR memory type, and information about non default lower
+    /// bounds, get the related HLFIR variable type.
+    static mlir::Type getHLFIRVariableType(mlir::Type type, bool hasLowerBounds);
+  }];
+
+  let hasVerifier = 1;
+}
+
+#endif // FORTRAN_DIALECT_HLFIR_OPS

diff  --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp
index 08c041127bda6..a64edcc147580 100644
--- a/flang/lib/Optimizer/Dialect/FIROps.cpp
+++ b/flang/lib/Optimizer/Dialect/FIROps.cpp
@@ -3577,6 +3577,12 @@ mlir::Type fir::applyPathToType(mlir::Type eleTy, mlir::ValueRange path) {
   return eleTy;
 }
 
+mlir::LogicalResult fir::DeclareOp::verify() {
+  auto fortranVar =
+      mlir::cast<fir::FortranVariableOpInterface>(this->getOperation());
+  return fortranVar.verifyDeclareLikeOpImpl(getMemref());
+}
+
 // Tablegen operators
 
 #define GET_OP_CLASSES

diff  --git a/flang/lib/Optimizer/Dialect/FortranVariableInterface.cpp b/flang/lib/Optimizer/Dialect/FortranVariableInterface.cpp
index b0f7fab215c7d..b12904bc4713a 100644
--- a/flang/lib/Optimizer/Dialect/FortranVariableInterface.cpp
+++ b/flang/lib/Optimizer/Dialect/FortranVariableInterface.cpp
@@ -14,18 +14,23 @@
 
 #include "flang/Optimizer/Dialect/FortranVariableInterface.cpp.inc"
 
-mlir::LogicalResult fir::FortranVariableOpInterface::verifyImpl() {
+mlir::LogicalResult
+fir::FortranVariableOpInterface::verifyDeclareLikeOpImpl(mlir::Value memref) {
   const unsigned numExplicitTypeParams = getExplicitTypeParams().size();
+  mlir::Type memType = memref.getType();
+  const bool sourceIsBoxValue = memType.isa<fir::BaseBoxType>();
+  const bool sourceIsBoxAddress = fir::isBoxAddress(memType);
+  const bool sourceIsBox = sourceIsBoxValue || sourceIsBoxAddress;
   if (isCharacter()) {
     if (numExplicitTypeParams > 1)
       return emitOpError(
           "of character entity must have at most one length parameter");
-    if (numExplicitTypeParams == 0 && !isBox())
+    if (numExplicitTypeParams == 0 && !sourceIsBox)
       return emitOpError("must be provided exactly one type parameter when its "
                          "base is a character that is not a box");
 
   } else if (auto recordType = getElementType().dyn_cast<fir::RecordType>()) {
-    if (numExplicitTypeParams < recordType.getNumLenParams() && !isBox())
+    if (numExplicitTypeParams < recordType.getNumLenParams() && !sourceIsBox)
       return emitOpError("must be provided all the derived type length "
                          "parameters when the base is not a box");
     if (numExplicitTypeParams > recordType.getNumLenParams())
@@ -37,7 +42,7 @@ mlir::LogicalResult fir::FortranVariableOpInterface::verifyImpl() {
 
   if (isArray()) {
     if (mlir::Value shape = getShape()) {
-      if (isBoxAddress())
+      if (sourceIsBoxAddress)
         return emitOpError("for box address must not have a shape operand");
       unsigned shapeRank = 0;
       if (auto shapeType = shape.getType().dyn_cast<fir::ShapeType>()) {
@@ -46,7 +51,7 @@ mlir::LogicalResult fir::FortranVariableOpInterface::verifyImpl() {
                      shape.getType().dyn_cast<fir::ShapeShiftType>()) {
         shapeRank = shapeShiftType.getRank();
       } else {
-        if (!isBoxValue())
+        if (!sourceIsBoxValue)
           emitOpError("of array entity with a raw address base must have a "
                       "shape operand that is a shape or shapeshift");
         shapeRank = shape.getType().cast<fir::ShiftType>().getRank();
@@ -55,7 +60,7 @@ mlir::LogicalResult fir::FortranVariableOpInterface::verifyImpl() {
       llvm::Optional<unsigned> rank = getRank();
       if (!rank || *rank != shapeRank)
         return emitOpError("has conflicting shape and base operand ranks");
-    } else if (!isBox()) {
+    } else if (!sourceIsBox) {
       emitOpError("of array entity with a raw address base must have a shape "
                   "operand that is a shape or shapeshift");
     }

diff  --git a/flang/lib/Optimizer/HLFIR/IR/CMakeLists.txt b/flang/lib/Optimizer/HLFIR/IR/CMakeLists.txt
index 890bc52cc8453..dc9e080b0f8be 100644
--- a/flang/lib/Optimizer/HLFIR/IR/CMakeLists.txt
+++ b/flang/lib/Optimizer/HLFIR/IR/CMakeLists.txt
@@ -2,6 +2,7 @@ get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 
 add_flang_library(HLFIRDialect
   HLFIRDialect.cpp
+  HLFIROps.cpp
 
   DEPENDS
   FIRDialect

diff  --git a/flang/lib/Optimizer/HLFIR/IR/HLFIRDialect.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIRDialect.cpp
index a6406992948ab..79f2d527d00fc 100644
--- a/flang/lib/Optimizer/HLFIR/IR/HLFIRDialect.cpp
+++ b/flang/lib/Optimizer/HLFIR/IR/HLFIRDialect.cpp
@@ -11,6 +11,7 @@
 //===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/HLFIR/HLFIRDialect.h"
+#include "flang/Optimizer/HLFIR/HLFIROps.h"
 #include "mlir/IR/Builders.h"
 #include "mlir/IR/BuiltinTypes.h"
 #include "mlir/IR/DialectImplementation.h"
@@ -31,6 +32,10 @@ void hlfir::hlfirDialect::initialize() {
 #define GET_TYPEDEF_LIST
 #include "flang/Optimizer/HLFIR/HLFIRTypes.cpp.inc"
       >();
+  addOperations<
+#define GET_OP_LIST
+#include "flang/Optimizer/HLFIR/HLFIROps.cpp.inc"
+      >();
 }
 
 // `expr` `<` `*` | bounds (`x` bounds)* `:` type [`?`] `>`
@@ -70,3 +75,13 @@ void hlfir::ExprType::print(mlir::AsmPrinter &printer) const {
     printer << '?';
   printer << '>';
 }
+
+bool hlfir::isFortranVariableType(mlir::Type type) {
+  return llvm::TypeSwitch<mlir::Type, bool>(type)
+      .Case<fir::ReferenceType, fir::PointerType, fir::HeapType>([](auto p) {
+        mlir::Type eleType = p.getEleTy();
+        return eleType.isa<fir::BaseBoxType>() || !fir::hasDynamicSize(eleType);
+      })
+      .Case<fir::BaseBoxType, fir::BoxCharType>([](auto) { return true; })
+      .Default([](mlir::Type) { return false; });
+}

diff  --git a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
new file mode 100644
index 0000000000000..1b723d73bc1ce
--- /dev/null
+++ b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
@@ -0,0 +1,83 @@
+//===-- HLFIROps.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/Optimizer/HLFIR/HLFIROps.h"
+#include "mlir/IR/Builders.h"
+#include "mlir/IR/BuiltinTypes.h"
+#include "mlir/IR/DialectImplementation.h"
+#include "mlir/IR/Matchers.h"
+#include "mlir/IR/OpImplementation.h"
+#include "llvm/ADT/TypeSwitch.h"
+#include <tuple>
+
+//===----------------------------------------------------------------------===//
+// DeclareOp
+//===----------------------------------------------------------------------===//
+
+/// Given a FIR memory type, and information about non default lower bounds, get
+/// the related HLFIR variable type.
+mlir::Type hlfir::DeclareOp::getHLFIRVariableType(mlir::Type inputType,
+                                                  bool hasExplicitLowerBounds) {
+  mlir::Type type = fir::unwrapRefType(inputType);
+  if (type.isa<fir::BaseBoxType>())
+    return inputType;
+  if (auto charType = type.dyn_cast<fir::CharacterType>())
+    if (charType.hasDynamicLen())
+      return fir::BoxCharType::get(charType.getContext(), charType.getFKind());
+
+  auto seqType = type.dyn_cast<fir::SequenceType>();
+  bool hasDynamicExtents =
+      seqType && fir::sequenceWithNonConstantShape(seqType);
+  mlir::Type eleType = seqType ? seqType.getEleTy() : type;
+  bool hasDynamicLengthParams = fir::characterWithDynamicLen(eleType) ||
+                                fir::isRecordWithTypeParameters(eleType);
+  if (hasExplicitLowerBounds || hasDynamicExtents || hasDynamicLengthParams)
+    return fir::BoxType::get(type);
+  return inputType;
+}
+
+static bool hasExplicitLowerBounds(mlir::Value shape) {
+  return shape && shape.getType().isa<fir::ShapeShiftType, fir::ShiftType>();
+}
+
+void hlfir::DeclareOp::build(mlir::OpBuilder &builder,
+                             mlir::OperationState &result, mlir::Value memref,
+                             llvm::StringRef uniq_name, mlir::Value shape,
+                             mlir::ValueRange typeparams,
+                             fir::FortranVariableFlagsAttr fortran_attrs) {
+  auto nameAttr = builder.getStringAttr(uniq_name);
+  mlir::Type inputType = memref.getType();
+  bool hasExplicitLbs = hasExplicitLowerBounds(shape);
+  mlir::Type hlfirVariableType =
+      getHLFIRVariableType(inputType, hasExplicitLbs);
+  build(builder, result, {hlfirVariableType, inputType}, memref, shape,
+        typeparams, nameAttr, fortran_attrs);
+}
+
+mlir::LogicalResult hlfir::DeclareOp::verify() {
+  if (getMemref().getType() != getResult(1).getType())
+    return emitOpError("second result type must match input memref type");
+  mlir::Type hlfirVariableType = getHLFIRVariableType(
+      getMemref().getType(), hasExplicitLowerBounds(getShape()));
+  if (hlfirVariableType != getResult(0).getType())
+    return emitOpError("first result type is inconsistent with variable "
+                       "properties: expected ")
+           << hlfirVariableType;
+  // The rest of the argument verification is done by the
+  // FortranVariableInterface verifier.
+  auto fortranVar =
+      mlir::cast<fir::FortranVariableOpInterface>(this->getOperation());
+  return fortranVar.verifyDeclareLikeOpImpl(getMemref());
+}
+
+#define GET_OP_CLASSES
+#include "flang/Optimizer/HLFIR/HLFIROps.cpp.inc"

diff  --git a/flang/test/HLFIR/declare.fir b/flang/test/HLFIR/declare.fir
new file mode 100644
index 0000000000000..3da3c19534667
--- /dev/null
+++ b/flang/test/HLFIR/declare.fir
@@ -0,0 +1,163 @@
+// Test hlfir.declare operation parse, verify (no errors), and unparse.
+
+// RUN: fir-opt %s | fir-opt | FileCheck %s
+
+func.func @numeric_declare(%arg0: !fir.ref<f32>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+  return
+}
+// CHECK-LABEL:   func.func @numeric_declare(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<f32>) {
+// CHECK:  %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] {uniq_name = "x"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+
+
+func.func @char_declare(%arg0: !fir.boxchar<1> ) {
+  %0:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+  %1:2 = hlfir.declare %0#0 typeparams %0#1 {uniq_name = "c"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+  return
+}
+// CHECK-LABEL:   func.func @char_declare(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxchar<1>) {
+// CHECK:  %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+// CHECK:  %[[VAL_2:.*]] = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 {uniq_name = "c"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+
+
+func.func @derived_declare(%arg0: !fir.ref<!fir.type<t{field:i32}>>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<!fir.type<t{field:i32}>>) -> (!fir.ref<!fir.type<t{field:i32}>>, !fir.ref<!fir.type<t{field:i32}>>)
+  return
+}
+// CHECK-LABEL:   func.func @derived_declare(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.type<t{field:i32}>>) {
+// CHECK:  %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] {uniq_name = "x"} : (!fir.ref<!fir.type<t{field:i32}>>) -> (!fir.ref<!fir.type<t{field:i32}>>, !fir.ref<!fir.type<t{field:i32}>>)
+
+
+func.func @pdt_declare(%arg0: !fir.ref<!fir.type<pdt(param:i32){field:i32}>>) {
+  %c1 = arith.constant 1 : index
+  %0:2 = hlfir.declare %arg0 typeparams %c1 {uniq_name = "x"} : (!fir.ref<!fir.type<pdt(param:i32){field:i32}>>, index) -> (!fir.box<!fir.type<pdt(param:i32){field:i32}>>, !fir.ref<!fir.type<pdt(param:i32){field:i32}>>)
+  return
+}
+// CHECK-LABEL:   func.func @pdt_declare(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.type<pdt(param:i32){field:i32}>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = hlfir.declare %[[VAL_0]] typeparams %[[VAL_1]] {uniq_name = "x"} : (!fir.ref<!fir.type<pdt(param:i32){field:i32}>>, index) -> (!fir.box<!fir.type<pdt(param:i32){field:i32}>>, !fir.ref<!fir.type<pdt(param:i32){field:i32}>>)
+
+
+func.func @array_declare(%arg0: !fir.ref<!fir.array<?x?xf32>>) {
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %shape = fir.shape %c1, %c2 : (index, index) -> !fir.shape<2>
+  %0:2 = hlfir.declare %arg0(%shape) {uniq_name = "x"} : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.ref<!fir.array<?x?xf32>>)
+  return
+}
+// CHECK-LABEL:   func.func @array_declare(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.array<?x?xf32>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = arith.constant 2 : index
+// CHECK:  %[[VAL_3:.*]] = fir.shape %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shape<2>
+// CHECK:  %[[VAL_4:.*]] = hlfir.declare %[[VAL_0]](%[[VAL_3]]) {uniq_name = "x"} : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.ref<!fir.array<?x?xf32>>)
+
+
+func.func @array_declare_2(%arg0: !fir.ref<!fir.array<?x?xf32>>) {
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %c3 = arith.constant 3 : index
+  %c4 = arith.constant 4 : index
+  %shape = fir.shape_shift %c1, %c2, %c3, %c4 : (index, index, index, index) -> !fir.shapeshift<2>
+  %0:2 = hlfir.declare %arg0(%shape) {uniq_name = "x"} : (!fir.ref<!fir.array<?x?xf32>>, !fir.shapeshift<2>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.ref<!fir.array<?x?xf32>>)
+  return
+}
+// CHECK-LABEL:   func.func @array_declare_2(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.array<?x?xf32>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = arith.constant 2 : index
+// CHECK:  %[[VAL_3:.*]] = arith.constant 3 : index
+// CHECK:  %[[VAL_4:.*]] = arith.constant 4 : index
+// CHECK:  %[[VAL_5:.*]] = fir.shape_shift %[[VAL_1]], %[[VAL_2]], %[[VAL_3]], %[[VAL_4]] : (index, index, index, index) -> !fir.shapeshift<2>
+// CHECK:  %[[VAL_6:.*]] = hlfir.declare %[[VAL_0]](%[[VAL_5]]) {uniq_name = "x"} : (!fir.ref<!fir.array<?x?xf32>>, !fir.shapeshift<2>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.ref<!fir.array<?x?xf32>>)
+
+func.func @array_declare_constant_extents_with_lower_bounds(%arg0: !fir.ref<!fir.array<2x4xf32>>) {
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %c3 = arith.constant 3 : index
+  %c4 = arith.constant 4 : index
+  %shape = fir.shape_shift %c1, %c2, %c3, %c4 : (index, index, index, index) -> !fir.shapeshift<2>
+  %0:2 = hlfir.declare %arg0(%shape) {uniq_name = "x"} : (!fir.ref<!fir.array<2x4xf32>>, !fir.shapeshift<2>) -> (!fir.box<!fir.array<2x4xf32>>, !fir.ref<!fir.array<2x4xf32>>)
+  return
+}
+// CHECK-LABEL:   func.func @array_declare_constant_extents_with_lower_bounds(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.array<2x4xf32>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = arith.constant 2 : index
+// CHECK:  %[[VAL_3:.*]] = arith.constant 3 : index
+// CHECK:  %[[VAL_4:.*]] = arith.constant 4 : index
+// CHECK:  %[[VAL_5:.*]] = fir.shape_shift %[[VAL_1]], %[[VAL_2]], %[[VAL_3]], %[[VAL_4]] : (index, index, index, index) -> !fir.shapeshift<2>
+// CHECK:  %[[VAL_6:.*]] = hlfir.declare %[[VAL_0]](%[[VAL_5]]) {uniq_name = "x"} : (!fir.ref<!fir.array<2x4xf32>>, !fir.shapeshift<2>) -> (!fir.box<!fir.array<2x4xf32>>, !fir.ref<!fir.array<2x4xf32>>)
+
+
+func.func @array_declare_box(%arg0: !fir.box<!fir.array<?x?xf32>>) {
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %shape = fir.shift %c1, %c2 : (index, index) -> !fir.shift<2>
+  %0:2 = hlfir.declare %arg0(%shape) {uniq_name = "x"} : (!fir.box<!fir.array<?x?xf32>>, !fir.shift<2>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.box<!fir.array<?x?xf32>>)
+  return
+}
+// CHECK-LABEL:   func.func @array_declare_box(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?x?xf32>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = arith.constant 2 : index
+// CHECK:  %[[VAL_3:.*]] = fir.shift %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shift<2>
+// CHECK:  %[[VAL_4:.*]] = hlfir.declare %[[VAL_0]](%[[VAL_3]]) {uniq_name = "x"} : (!fir.box<!fir.array<?x?xf32>>, !fir.shift<2>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.box<!fir.array<?x?xf32>>)
+
+
+func.func @array_declare_char_box(%arg0: !fir.box<!fir.array<?x?x!fir.char<1,?>>>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>) -> (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.box<!fir.array<?x?x!fir.char<1,?>>>)
+  return
+}
+// CHECK-LABEL:   func.func @array_declare_char_box(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?x?x!fir.char<1,?>>>) {
+// CHECK:  %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] {uniq_name = "x"} : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>) -> (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.box<!fir.array<?x?x!fir.char<1,?>>>)
+
+
+func.func @array_declare_char_box_2(%arg0: !fir.box<!fir.array<?x?x!fir.char<1,?>>>) {
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %c3 = arith.constant 3 : index
+  %shape = fir.shift %c1, %c2 : (index, index) -> !fir.shift<2>
+  %0:2 = hlfir.declare %arg0(%shape) typeparams %c3 {uniq_name = "x"} : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.shift<2>, index) -> (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.box<!fir.array<?x?x!fir.char<1,?>>>)
+  return
+}
+// CHECK-LABEL:   func.func @array_declare_char_box_2(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?x?x!fir.char<1,?>>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = arith.constant 2 : index
+// CHECK:  %[[VAL_3:.*]] = arith.constant 3 : index
+// CHECK:  %[[VAL_4:.*]] = fir.shift %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shift<2>
+// CHECK:  %[[VAL_5:.*]] = hlfir.declare %[[VAL_0]](%[[VAL_4]]) typeparams %[[VAL_3]] {uniq_name = "x"} : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.shift<2>, index) -> (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.box<!fir.array<?x?x!fir.char<1,?>>>)
+
+
+func.func @array_declare_char_boxaddr(%arg0: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>)
+  return
+}
+// CHECK-LABEL: func.func @array_declare_char_boxaddr(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>) {
+// CHECK:  %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] {uniq_name = "x"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>)
+
+
+func.func @array_declare_char_boxaddr_2(%arg0: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>) {
+  %c3 = arith.constant 3 : index
+  %0:2 = hlfir.declare %arg0 typeparams %c3 {uniq_name = "x"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>, index) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>)
+  return
+}
+// CHECK-LABEL: func.func @array_declare_char_boxaddr_2(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 3 : index
+// CHECK:  %[[VAL_2:.*]] = hlfir.declare %[[VAL_0]] typeparams %[[VAL_1]] {uniq_name = "x"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>, index) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>)
+
+func.func @array_declare_unlimited_polymorphic_boxaddr(%arg0: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>) -> (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>, !fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>)
+  return
+}
+// CHECK-LABEL: func.func @array_declare_unlimited_polymorphic_boxaddr(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>) {
+// CHECK:  %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] {uniq_name = "x"} : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>) -> (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>, !fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>)

diff  --git a/flang/test/HLFIR/invalid.fir b/flang/test/HLFIR/invalid.fir
new file mode 100644
index 0000000000000..1ed753fed7f26
--- /dev/null
+++ b/flang/test/HLFIR/invalid.fir
@@ -0,0 +1,37 @@
+// HLFIR ops diagnotic tests
+
+// RUN: fir-opt -split-input-file -verify-diagnostics %s
+
+func.func @bad_declare(%arg0: !fir.ref<f32>) {
+  // expected-error at +1 {{'hlfir.declare' op first result type is inconsistent with variable properties: expected '!fir.ref<f32>'}}
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<f32>) -> (!fir.box<f32>, !fir.ref<f32>)
+  return
+}
+
+// -----
+func.func @bad_declare_lower_bounds(%arg0: !fir.ref<!fir.array<2x4xf32>>) {
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %c3 = arith.constant 3 : index
+  %c4 = arith.constant 4 : index
+  %shape = fir.shape_shift %c1, %c2, %c3, %c4 : (index, index, index, index) -> !fir.shapeshift<2>
+  // expected-error at +1 {{'hlfir.declare' op first result type is inconsistent with variable properties: expected '!fir.box<!fir.array<2x4xf32>>'}}
+  %0:2 = hlfir.declare %arg0(%shape) {uniq_name = "x"} : (!fir.ref<!fir.array<2x4xf32>>, !fir.shapeshift<2>) -> (!fir.ref<!fir.array<2x4xf32>>, !fir.ref<!fir.array<2x4xf32>>)
+  return
+}
+
+// -----
+func.func @bad_declare(%arg0: !fir.ref<f32>) {
+  // expected-error at +1 {{'hlfir.declare' op second result type must match input memref type}}
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<f32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+  return
+}
+
+// -----
+
+// Test that FortranVariableInterface verifier is kicking in. This verifier itself is already tested with fir.declare.
+func.func @bad_array_declare(%arg0: !fir.ref<!fir.array<?x?xf32>>) {
+  // expected-error at +1 {{'hlfir.declare' op of array entity with a raw address base must have a shape operand that is a shape or shapeshift}}
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<!fir.array<?x?xf32>>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.ref<!fir.array<?x?xf32>>)
+  return
+}


        


More information about the flang-commits mailing list