[flang] Add fir.box_typecode operation

[clementval]

Summary

fir.box_typecode operation allows to retrieve the type code
from a boxed value. This will be used in the fir.select_type conversion
to if-then-else ladder for type guard statement with intrinsic type spec
instead of using a runtime call.

[jeanPerier]

Looks good

flang/include/flang/Optimizer/Dialect/FIROps.td

let description = [{
     must box an array of REAL values (with dynamic rank and extent).
   }];
 
   let arguments = (ins fir_BoxType:$val);
 
   let results = (outs AnyIntegerLike);
 }
 
+def fir_BoxTypeCodeOp : fir_SimpleOneResultOp<"box_typecode", [NoMemoryEffect]>
+{
+  let summary = "return the type code the boxed value";
+
+  let description = [{
+    Returns the descriptor type code of an entity of `box` type.
+
+    ```mlir
+      %1 = fir.box_type %0 : (!fir.box<T>) -> i32
+    ```
+  }];
+
+  let arguments = (ins BoxOrClassType:$box);
+
+  let results = (outs AnyIntegerLike);
+}
+
 def fir_BoxIsAllocOp : fir_SimpleOp<"box_isalloc", [NoMemoryEffect]> {
   let summary = "is the boxed value an ALLOCATABLE?";
 
   let description = [{
     Determine if the boxed value was from an ALLOCATABLE entity. This will
     return true if the originating box value was from a `fir.embox` op
     with a mem-ref value that had the type !fir.heap<T>.
 

flang/lib/Optimizer/CodeGen/CodeGen.cpp

matchAndRewrite(fir::BoxTypeDescOp boxtypedesc, OpAdaptor adaptor,
     mlir::Value box = adaptor.getOperands()[0];
     auto typeDescAddr = loadTypeDescAddress(
         boxtypedesc.getLoc(), boxtypedesc.getBox().getType(), box, rewriter);
     rewriter.replaceOp(boxtypedesc, typeDescAddr);
     return mlir::success();
   }
 };
 
+/// Lower `fir.box_typecode` to a sequence of operations to extract the type
+/// code in the boxed value.
+struct BoxTypeCodeOpConversion : public FIROpConversion<fir::BoxTypeCodeOp> {
+  using FIROpConversion::FIROpConversion;
+
+  mlir::LogicalResult
+  matchAndRewrite(fir::BoxTypeCodeOp op, OpAdaptor adaptor,
+                  mlir::ConversionPatternRewriter &rewriter) const override {
+    mlir::Value box = adaptor.getOperands()[0];
+    auto loc = box.getLoc();
+    auto ty = convertType(op.getType());
+    auto typeCode = getValueFromBox(loc, box, ty, rewriter, kTypePosInBox);
+    rewriter.replaceOp(op, typeCode);
+    return mlir::success();
+  }
+};
+
 /// Lower `fir.string_lit` to LLVM IR dialect operation.
 struct StringLitOpConversion : public FIROpConversion<fir::StringLitOp> {
   using FIROpConversion::FIROpConversion;
 
   mlir::LogicalResult
   matchAndRewrite(fir::StringLitOp constop, OpAdaptor adaptor,
                   mlir::ConversionPatternRewriter &rewriter) const override {
     auto ty = convertType(constop.getType());
void runOnOperation() override final {
     auto *context = getModule().getContext();
     fir::LLVMTypeConverter typeConverter{getModule()};
     mlir::RewritePatternSet pattern(context);
     pattern.insert<
         AbsentOpConversion, AddcOpConversion, AddrOfOpConversion,
         AllocaOpConversion, AllocMemOpConversion, BoxAddrOpConversion,
         BoxCharLenOpConversion, BoxDimsOpConversion, BoxEleSizeOpConversion,
         BoxIsAllocOpConversion, BoxIsArrayOpConversion, BoxIsPtrOpConversion,
-        BoxProcHostOpConversion, BoxRankOpConversion, BoxTypeDescOpConversion,
-        CallOpConversion, CmpcOpConversion, ConstcOpConversion,
-        ConvertOpConversion, CoordinateOpConversion, DispatchOpConversion,
-        DispatchTableOpConversion, DTEntryOpConversion, DivcOpConversion,
-        EmboxOpConversion, EmboxCharOpConversion, EmboxProcOpConversion,
-        ExtractValueOpConversion, FieldIndexOpConversion, FirEndOpConversion,
-        FreeMemOpConversion, GenTypeDescOpConversion, GlobalLenOpConversion,
-        GlobalOpConversion, HasValueOpConversion, InsertOnRangeOpConversion,
-        InsertValueOpConversion, IsPresentOpConversion,
-        LenParamIndexOpConversion, LoadOpConversion, MulcOpConversion,
-        NegcOpConversion, NoReassocOpConversion, SelectCaseOpConversion,
-        SelectOpConversion, SelectRankOpConversion, SelectTypeOpConversion,
-        ShapeOpConversion, ShapeShiftOpConversion, ShiftOpConversion,
-        SliceOpConversion, StoreOpConversion, StringLitOpConversion,
-        SubcOpConversion, UnboxCharOpConversion, UnboxProcOpConversion,
-        UndefOpConversion, UnreachableOpConversion, XArrayCoorOpConversion,
-        XEmboxOpConversion, XReboxOpConversion, ZeroOpConversion>(
-        typeConverter, options, bindingTables);
+        BoxProcHostOpConversion, BoxRankOpConversion, BoxTypeCodeOpConversion,
+        BoxTypeDescOpConversion, CallOpConversion, CmpcOpConversion,
+        ConstcOpConversion, ConvertOpConversion, CoordinateOpConversion,
+        DispatchOpConversion, DispatchTableOpConversion, DTEntryOpConversion,
+        DivcOpConversion, EmboxOpConversion, EmboxCharOpConversion,
+        EmboxProcOpConversion, ExtractValueOpConversion, FieldIndexOpConversion,
+        FirEndOpConversion, FreeMemOpConversion, GenTypeDescOpConversion,
+        GlobalLenOpConversion, GlobalOpConversion, HasValueOpConversion,
+        InsertOnRangeOpConversion, InsertValueOpConversion,
+        IsPresentOpConversion, LenParamIndexOpConversion, LoadOpConversion,
+        MulcOpConversion, NegcOpConversion, NoReassocOpConversion,
+        SelectCaseOpConversion, SelectOpConversion, SelectRankOpConversion,
+        SelectTypeOpConversion, ShapeOpConversion, ShapeShiftOpConversion,
+        ShiftOpConversion, SliceOpConversion, StoreOpConversion,
+        StringLitOpConversion, SubcOpConversion, UnboxCharOpConversion,
+        UnboxProcOpConversion, UndefOpConversion, UnreachableOpConversion,
+        XArrayCoorOpConversion, XEmboxOpConversion, XReboxOpConversion,
+        ZeroOpConversion>(typeConverter, options, bindingTables);
     mlir::populateFuncToLLVMConversionPatterns(typeConverter, pattern);
     mlir::populateOpenMPToLLVMConversionPatterns(typeConverter, pattern);
     mlir::arith::populateArithToLLVMConversionPatterns(typeConverter, pattern);
     mlir::cf::populateControlFlowToLLVMConversionPatterns(typeConverter,
                                                           pattern);
     // Convert math-like dialect operations, which can be produced
     // when late math lowering mode is used, into llvm dialect.
     mlir::populateMathToLLVMConversionPatterns(typeConverter, pattern);

flang/test/Fir/box-typecode.fir

+// RUN: tco %s | FileCheck %s
+
+func.func @test_box_typecode(%a: !fir.class<none>) -> i32 {
+  %0 = fir.box_typecode %a : (!fir.class<none>) -> i32
+  return %0 : i32
+}
+
+// CHECK-LABEL: @test_box_typecode(
+// CHECK-SAME: ptr %[[BOX:.*]]) 
+// CHECK: %[[GEP:.*]] = getelementptr { ptr, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}} }, ptr %[[BOX]], i32 0, i32 4
+// CHECK: %[[TYPE_CODE:.*]] = load i32, ptr %[[GEP]]
+// CHECK: ret i32 %[[TYPE_CODE]]

flang/test/Fir/fir-ops.fir

func.func @test_fortran_var_attrs() {
   // CHECK: fir.alloca f32 {fortran_attrs = #fir.var_attrs<optional>}
   // CHECK: fir.alloca f32 {fortran_attrs = #fir.var_attrs<parameter>}
   // CHECK: fir.alloca !fir.ptr<f32> {fortran_attrs = #fir.var_attrs<pointer>}
   // CHECK: fir.alloca f32 {fortran_attrs = #fir.var_attrs<target>}
   // CHECK: fir.alloca f32 {fortran_attrs = #fir.var_attrs<value>}
   // CHECK: fir.alloca f32 {fortran_attrs = #fir.var_attrs<volatile>}
   // CHECK: fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {fortran_attrs = #fir.var_attrs<contiguous, pointer, volatile>}
 }
+
+func.func @test_box_typecode(%a: !fir.class<none>) {
+  %0 = fir.box_typecode %a : (!fir.class<none>) -> i32
+  return
+}
+
+// CHECK-LABEL: func.func @test_box_typecode(
+// CHECK-SAME: %[[A:.*]]: !fir.class<none>)
+// CHECK: %{{.*}} = fir.box_typecode %[[A]] : (!fir.class<none>) -> i32