[flang] Support codegen of procedure pointer component

[peixin]

Summary

This supports the codegen for procedure pointer component in
BoxedProcedure pass. Also fix the FIR in ProcedurePointer.md so that
all the cases can be run using tco to generate the LLVM IR.

[jeanPerier]

flang/lib/Optimizer/CodeGen/TypeConverter.h

63 ↗

(On Diff #471141)

This TODO is quite old. The fir.boxproc type is actually being rewritten in lib/Optimizer/CodeGen/BoxedProcedure.cpp, and I think it may be better to also do the same for fir.ref<fir.boxproc<T>> to be consistent with the choice regarding what a fir.boxproc should be.

[peixin]

flang/lib/Optimizer/CodeGen/TypeConverter.h

63 ↗

(On Diff #471141)

I guess this is added either for the unimplemented codegen of fir.emboxproc, fir.boxproc_host, fir.unboxproc, or for the conversion of BOXPROCType in procedure component. If BoxedProcedurePass is mature. All these unimplemented codegen may can be removed.

I think it may be better to also do the same for fir.ref<fir.boxproc<T>> to be consistent with the choice regarding what a fir.boxproc should be.

I don't get it. fir.ref<fir.boxproc<T>> is converted to mlir::LLVM::LLVMPointerType::get(convertType(ty.getEleTy())), which is expected.

[jeanPerier]

flang/lib/Optimizer/CodeGen/TypeConverter.h

63 ↗

(On Diff #471141)

What I am saying is that right now, the place that dictates how a fir.boxproc<T> is translated is lib/Optimizer/CodeGen/BoxedProcedure.cpp (here https://github.com/llvm/llvm-project/blob/67d0d7ac0acb0665d6a09f61278fbcf51f0114c2/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp#L95), so I do not really understand why a conversion needs to be defined again here. From a single point of truth perspective, I would prefer BoxedProcedure.cpp to be the only place dealing with fir.boxproc<T>.

[peixin]

From a single point of truth perspective, I would prefer BoxedProcedure.cpp to be the only place dealing with fir.boxproc<T>.

Let me try this.

[peixin]

Support codegen of procedure pointer component by support type conversion for boxproc in derived type.

[jeanPerier]

flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp

136

Are you sure it is allowed to update the data of an MLIR type on the flight like this ?

It is not quite clear to me at which scale the type instances are shared, and if we could ever run in weird bug due to multithreaded passes while updating the storage of an mlir type instance like this.

[peixin]

Are you sure it is allowed to update the data of an MLIR type on the flight like this ?
It is not quite clear to me at which scale the type instances are shared, and if we could ever run in weird bug due to multithreaded passes while updating the storage of an mlir type> instance like this.

I didn't know these passes can be run in parallel. Thanks for letting me know. Then, one new record type can be created with one mangled name. For performance consideration, only convert the record type once.

[jeanPerier]

I am not very found that a new record type with a new name has to be created, but I do not really see another nice solution. The only alternative I can think of would be to add an integer "version" flag in the recordType that could be increased every time some pass updates derived type, so that we do not touch the mangled name, but an extra string also makes some sense, although we will probably want to make them "offical" in the RecordType definition and add a way to find back the to the original name.

flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp

129

Does this work OK with the codegen code that is later using the mangled derived type names to find the derived type descriptor global ?

140

You should probably assert that the original type had no length parameters/add a TODO so that we do not forget about propagating those here.

[peixin]

In D136842#3940520, @jeanPerier wrote:

I am not very found that a new record type with a new name has to be created, but I do not really see another nice solution. The only alternative I can think of would be to add an integer "version" flag in the recordType that could be increased every time some pass updates derived type, so that we do not touch the mangled name, but an extra string also makes some sense, although we will probably want to make them "offical" in the RecordType definition and add a way to find back the to the original name.

Yes, I agree. Usually, adding one flag should be avoided if there is no other way. The record type name _QFtestTmatrix is actually already mangled before codegen. I also checked interoperability with C (Fortran 2018 18.3.3(3) Note 3), and there is no need to keep its original type name. So, there is no real need to keep this type name. What do you think?

flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp

129

I don't think out any case which will fail with this change. The test case in flang/test/Fir/boxproc-2.fir can be run using tco to generate LLVM IR. Here is the output with this patch:

; ModuleID = 'FIRModule'
source_filename = "FIRModule"
target triple = "aarch64-unknown-linux-gnu"

%_QFtestTmatrixUnboxProc = type { [2 x [2 x float]], ptr }

declare ptr @malloc(i64)

declare void @free(ptr)

declare void @foo1(ptr)

declare void @foo2(ptr)

define void @proc_pointer_component(ptr %0, ptr %1) {
  %3 = alloca %_QFtestTmatrixUnboxProc, i64 1, align 8
  %4 = getelementptr %_QFtestTmatrixUnboxProc, ptr %3, i32 0, i32 1
  store ptr %0, ptr %4, align 8
  %5 = load ptr, ptr %4, align 8
  %6 = call float %5(ptr %1)
  ret void
}

!llvm.module.flags = !{!0}

!0 = !{i32 2, !"Debug Info Version", i32 3}

140

I don't get it. Why does it need one assert or TODO if there is no length parameter? In addition, will there be special handling here if there is length parameter? Will rec.finalize(ps, cs) not work?

[clementval]

In D136842#3942950, @peixin wrote:

In D136842#3940520, @jeanPerier wrote:

I am not very found that a new record type with a new name has to be created, but I do not really see another nice solution. The only alternative I can think of would be to add an integer "version" flag in the recordType that could be increased every time some pass updates derived type, so that we do not touch the mangled name, but an extra string also makes some sense, although we will probably want to make them "offical" in the RecordType definition and add a way to find back the to the original name.

Yes, I agree. Usually, adding one flag should be avoided if there is no other way. The record type name _QFtestTmatrix is actually already mangled before codegen. I also checked interoperability with C (Fortran 2018 18.3.3(3) Note 3), and there is no need to keep its original type name. So, there is no real need to keep this type name. What do you think?

The type name is important for polymorphic entities. It is used to find the type descriptor and the binding tables. So we at least need a way to find back the original type name so we can use the functions in flang/include/flang/Optimizer/Support/InternalNames.h like getTypeDescriptorName and getTypeDescriptorBindingTableName that takes the mangled type name as input.

[peixin]

In D136842#3943069, @clementval wrote:

In D136842#3942950, @peixin wrote:

In D136842#3940520, @jeanPerier wrote:

I am not very found that a new record type with a new name has to be created, but I do not really see another nice solution. The only alternative I can think of would be to add an integer "version" flag in the recordType that could be increased every time some pass updates derived type, so that we do not touch the mangled name, but an extra string also makes some sense, although we will probably want to make them "offical" in the RecordType definition and add a way to find back the to the original name.

Yes, I agree. Usually, adding one flag should be avoided if there is no other way. The record type name _QFtestTmatrix is actually already mangled before codegen. I also checked interoperability with C (Fortran 2018 18.3.3(3) Note 3), and there is no need to keep its original type name. So, there is no real need to keep this type name. What do you think?

The type name is important for polymorphic entities. It is used to find the type descriptor and the binding tables. So we at least need a way to find back the original type name so we can use the functions in flang/include/flang/Optimizer/Support/InternalNames.h like getTypeDescriptorName and getTypeDescriptorBindingTableName that takes the mangled type name as input.

@clementval Thanks for the notice. I took a look at the case of polymorphic entities. The typeDesc and typeDescBindingTable do not have the boxproc component, and they won't be converted, so the only problem is how to handle the function getDerivedTypeObjectName. The simple method is unwrap the mangledTypeName by removing the suffix string UnboxProc before calling fir::NameUniquer::deconstruct(mangledTypeName). Is that OK with you?

[clementval]

In D136842#3945925, @peixin wrote:

@clementval Thanks for the notice. I took a look at the case of polymorphic entities. The typeDesc and typeDescBindingTable do not have the boxproc component, and they won't be converted, so the only problem is how to handle the function getDerivedTypeObjectName. The simple method is unwrap the mangledTypeName by removing the suffix string UnboxProc before calling fir::NameUniquer::deconstruct(mangledTypeName). Is that OK with you?

Yeah that should be fine. Can you define the suffix in InternalName.h so it is centralized?

Like this or smth similar.

static constexpr llvm::StringRef boxprocSuffix = "UnboxProc";

[peixin]

In D136842#3945996, @clementval wrote:

In D136842#3945925, @peixin wrote:

@clementval Thanks for the notice. I took a look at the case of polymorphic entities. The typeDesc and typeDescBindingTable do not have the boxproc component, and they won't be converted, so the only problem is how to handle the function getDerivedTypeObjectName. The simple method is unwrap the mangledTypeName by removing the suffix string UnboxProc before calling fir::NameUniquer::deconstruct(mangledTypeName). Is that OK with you?

Yeah that should be fine. Can you define the suffix in InternalName.h so it is centralized?

Like this or smth similar.

static constexpr llvm::StringRef boxprocSuffix = "UnboxProc";

Good point. Will do it. Thanks a lot.

[jeanPerier]

flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp

129

This test case does not exercise an operation that will require retrieving the type descriptor in codegen. Embox would expose that need:

func.func private @bar(!fir.box<!fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>>) -> ()

func.func @proc_pointer_component() {
  %0 = fir.alloca !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>
  %1 = fir.embox %0 : (!fir.ref<!fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>>) -> !fir.box<!fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>>
  call @bar(%1) : (!fir.box<!fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>>) -> ()
  return
}

140

Sorry, I look too quickly, you are indeed copying them, no need to add a TODO.

[jeanPerier]

In D136842#3945996, @clementval wrote:

In D136842#3945925, @peixin wrote:

@clementval Thanks for the notice. I took a look at the case of polymorphic entities. The typeDesc and typeDescBindingTable do not have the boxproc component, and they won't be converted, so the only problem is how to handle the function getDerivedTypeObjectName. The simple method is unwrap the mangledTypeName by removing the suffix string UnboxProc before calling fir::NameUniquer::deconstruct(mangledTypeName). Is that OK with you?

Yeah that should be fine. Can you define the suffix in InternalName.h so it is centralized?

Like this or smth similar.

static constexpr llvm::StringRef boxprocSuffix = "UnboxProc";

+1

[peixin]

flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp

129

This case has the same problem as the polymorphic entities. This will be handled later. Thanks for this case.

BTW, I hit one error for the following case:

func.func private @bar(!fir.box<!fir.type<_QFtestTmatrix2{element:!fir.array<2x2xf32>}>>) -> ()

func.func @proc_pointer_component2() {
  %0 = fir.alloca !fir.type<_QFtestTmatrix2{element:!fir.array<2x2xf32>}>
  %1 = fir.embox %0 : (!fir.ref<!fir.type<_QFtestTmatrix2{element:!fir.array<2x2xf32>}>>) -> !fir.box<!fir.type<_QFtestTmatrix2{element:!fir.array<2x2xf32>}>>
  call @bar(%1) : (!fir.box<!fir.type<_QFtestTmatrix2{element:!fir.array<2x2xf32>}>>) -> ()
  return
}

$ tco case01.fir 
loc("case01.fir":87:8): error: runtime derived type info descriptor was not generated

@clementval Is this one bug or TODO or invalid input?

[clementval]

flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp

129

Input is invalid since it does not contains the fir.global that represent the type descriptor.

[peixin]

Address the comments from @jeanPerier and @clementval .

[peixin]

ping @clementval @jeanPerier

[jeanPerier]

LGTM, thanks

flang/docs/ProcedurePointer.md

subroutine foo2(q)
     end interface
     procedure(func), pointer :: q
   end subroutine foo2
 end subroutine proc_pointer_dummy_argument
 ```
 
 **FIR for case 1**
 ```
-func.func private @foo1(!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>)
-func.func private @foo2(!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>)
+func.func private @foo1(!fir.boxproc<(!fir.ref<i32>) -> f32>)
+func.func private @foo2(!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>)
 
-func.func @proc_pointer_dummy_argument(%0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>) {
-  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  fir.call @foo1(%1) : ((!fir.ref<i32>) -> !fir.ref<f32>) -> ()
-  fir.call @foo2(%0) : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>) -> ()
+func.func @proc_pointer_dummy_argument(%0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>) {
+  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  fir.call @foo1(%1) : (!fir.boxproc<(!fir.ref<i32>) -> f32>) -> ()
+  fir.call @foo2(%0) : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>) -> ()
   return
 }
 ```
 
 **Fortran case 2**
 ```fortran
 subroutine proc_pointer_global()
   interface
subroutine foo2(q)
     end interface
     procedure(func), pointer :: q
   end subroutine foo2
 end subroutine proc_pointer_global
 ```
 
 **FIR for case 2**
 ```
-func.func private @foo1(!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>)
-func.func private @foo2(!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>)
+func.func private @foo1(!fir.boxproc<(!fir.ref<i32>) -> f32>)
+func.func private @foo2(!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>)
 
-fir.global internal @ProcedurePointer : !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>> {
-  %0 = fir.zero_bits (!fir.ref<i32>) -> !fir.ref<f32>
-  %1 = fir.emboxproc %0 : ((!fir.ref<i32>) -> !fir.ref<f32>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  fir.has_value %1 : !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
+fir.global internal @ProcedurePointer : !fir.boxproc<(!fir.ref<i32>) -> f32> {
+  %0 = fir.zero_bits (!fir.ref<i32>) -> f32
+  %1 = fir.emboxproc %0 : ((!fir.ref<i32>) -> f32) -> !fir.boxproc<(!fir.ref<i32>) -> f32>
+  fir.has_value %1 : !fir.boxproc<(!fir.ref<i32>) -> f32>
 }
 
 func.func @proc_pointer_global() {
-  %0 = fir.address_of(@ProcedurePointer) : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  fir.call @foo1(%1) : (!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>) -> ()
-  fir.call @foo2(%0) : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>) -> ()
+  %0 = fir.address_of(@ProcedurePointer) : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  fir.call @foo1(%1) : (!fir.boxproc<(!fir.ref<i32>) -> f32>) -> ()
+  fir.call @foo2(%0) : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>) -> ()
   return
 }
 ```
 
 **Fortran case 3**
 ```fortran
 subroutine proc_pointer_local()
   interface
subroutine foo2(q)
     end interface
     procedure(func), pointer :: q
   end subroutine foo2
 end subroutine proc_pointer_local
 ```
 
 **FIR for case 3**
 ```
-func.func private @foo1(!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>)
-func.func private @foo2(!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>)
+func.func private @foo1(!fir.boxproc<(!fir.ref<i32>) -> f32>)
+func.func private @foo2(!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>)
 
 func.func @proc_pointer_local() {
-  %0 = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  %2 = fir.box_addr %1 : (!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>) -> ((!fir.ref<i32>) -> !fir.ref<f32>)
-  %3 = fir.zero_bits (!fir.ref<i32>) -> !fir.ref<f32>
-  fir.store %3 to %2 : !fir.ref<(!fir.ref<i32>) -> !fir.ref<f32>>
-  %4 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  fir.call @foo1(%4) : (!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>) -> ()
-  fir.call @foo2(%0) : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>) -> ()
+  %0 = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> f32>
+  %1 = fir.zero_bits (!fir.ref<i32>) -> f32
+  %2 = fir.emboxproc %1 : ((!fir.ref<i32>) -> f32) -> !fir.boxproc<(!fir.ref<i32>) -> f32>
+  fir.store %2 to %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  %4 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  fir.call @foo1(%4) : (!fir.boxproc<(!fir.ref<i32>) -> f32>) -> ()
+  fir.call @foo2(%0) : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>) -> ()
   return
 }
 ```
 
 It is possible to pass procedure pointers to a C function. If the C function has
 an explicit interface in fortran code, and the dummy argument is a procedure
 pointer, the code passes a pointer to the procedure as the actual argument
 (see Case 5); Otherwise, the code passes the procedure pointer target as the

 function proc(x) bind(C, name="Procedure")
   integer :: x
   proc = real(x)
 end
 ```
 
 **FIR**
 ```
-func.func @Procedure(%arg0 : !fir.ref<i32>) -> !fir.ref<f32> {
+func.func @Procedure(%arg0 : !fir.ref<i32>) -> f32 {
+  %0 = fir.alloca f32 {bindc_name = "res", uniq_name = "_QFfuncEres"}
   %1 = fir.load %arg0 : !fir.ref<i32>
   %2 = fir.convert %1 : (i32) -> f32
-  return %2 : f32
+  fir.store %2 to %0 : !fir.ref<f32>
+  %3 = fir.load %0 : !fir.ref<f32>
+  return %3 : f32
 }
 
-func.func @Reference2Function() -> !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>> {
-  %0 = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  return %1 : !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
+func.func @Reference2Function() -> !fir.boxproc<(!fir.ref<i32>) -> f32> {
+  %0 = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> f32>
+  %1 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  return %1 : !fir.boxproc<(!fir.ref<i32>) -> f32>
 }
 
-func.func @proc_pointer_assignment(%arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>, %arg1 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>) {
-  %0 = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>> {bindc_name = ".result"}
+func.func @proc_pointer_assignment(%arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>, %arg1 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>) {
+  %0 = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> f32> {bindc_name = ".result"}
   // case 1: assignment from external procedure
-  %1 = fir.address_of(@Procedure) : (!fir.ref<i32>) -> !fir.ref<f32>
-  %2 = fir.emboxproc %1 : ((!fir.ref<i32>) -> !fir.ref<f32>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  fir.store %2 to %arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
+  %1 = fir.address_of(@Procedure) : (!fir.ref<i32>) -> f32
+  %2 = fir.emboxproc %1 : ((!fir.ref<i32>) -> f32) -> !fir.boxproc<(!fir.ref<i32>) -> f32>
+  fir.store %2 to %arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
   // case2: assignment from procdure pointer
-  %3 = fir.load %arg1 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  fir.store %3 to %arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
+  %3 = fir.load %arg1 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  fir.store %3 to %arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
   // case3: assignment from a reference to a function whose result is a procedure pointer
-  %4 = fir.call @Reference2Function() : () -> !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  fir.store %4 to %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  %5 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
-  fir.store %5 to %arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>>
+  %4 = fir.call @Reference2Function() : () -> !fir.boxproc<(!fir.ref<i32>) -> f32>
+  fir.store %4 to %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  %5 = fir.load %0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
+  fir.store %5 to %arg0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> f32>>
   return
 }
 ```
 
 ### Procedure pointer components
 
 Having procedure pointers in derived types permits `methods` to be dynamically
 bound to objects. Such procedure pointer components will have the type
subroutine proc_pointer_component(a, i, f)
   type(matrix) :: a
   a%solve=>f
   r = a%solve(i)
 end subroutine proc_pointer_component
 ```
 
 **FIR**
 ```
-func.func @proc_pointer_component(%arg0 : (!fir.ref<i32>) -> !fir.ref<f32>, %arg1: !fir.ref<i32>) {
+func.func @proc_pointer_component(%arg0 : !fir.boxproc<(!fir.ref<i32>) -> f32>, %arg1: !fir.ref<i32>) {
   %0 = fir.alloca !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>
   %1 = fir.field_index solve, !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>
   %2 = fir.coordinate_of %0, %1 : (!fir.ref<!fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>>, !fir.field) -> !fir.ref<!fir.boxproc<() -> ()>>
-  %3 = fir.emboxproc %arg0 : ((!fir.ref<i32>) -> !fir.ref<f32>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  %4 = fir.convert %3 : (!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>) ->  !fir.boxproc<() -> ()>
-  fir.store %4 to %2 : !fir.ref<!fir.boxproc<() -> ()>>
+  %3 = fir.convert %arg0 : (!fir.boxproc<(!fir.ref<i32>) -> f32>) ->  !fir.boxproc<() -> ()>
+  fir.store %3 to %2 : !fir.ref<!fir.boxproc<() -> ()>>
   %4 = fir.field_index solve, !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>
   %5 = fir.coordinate_of %0, %4 : (!fir.ref<!fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>>, !fir.field) -> !fir.ref<!fir.boxproc<() -> ()>>
   %6 = fir.load %5 : !fir.ref<!fir.boxproc<() -> ()>>
-  %7 = fir.convert %6 : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>
-  %8 = fir.box_addr %7 : (!fir.boxproc<(!fir.ref<i32>) -> !fir.ref<f32>>) -> ((!fir.ref<i32>) -> !fir.ref<f32>)
-  %9 = fir.call %8(%arg1) : (!fir.ref<i32>) -> !fir.ref<f32>
+  %7 = fir.convert %6 : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<i32>) -> f32>
+  %8 = fir.box_addr %7 : (!fir.boxproc<(!fir.ref<i32>) -> f32>) -> ((!fir.ref<i32>) -> f32)
+  %9 = fir.call %8(%arg1) : (!fir.ref<i32>) -> f32
   return
 }
 ```
 
 ---
 
 # Testing
 

 - `flang/lib/Lower/ConvertVariable.cpp:1459`: not yet implemented: procedure pointers
 - `flang/lib/Lower/HostAssociations.cpp:162`: not yet implemented: capture procedure pointer in internal procedure
 - lowering of procedure pointers in ASSOCIATED, NULL, and C_F_PROCPOINTER
 
 Current list of TODOs in code generation:
 
 NOTE: There are any number of possible implementations.
 
-- `flang/lib/Optimizer/CodeGen/TypeConverter.h:64` TODO: BoxProcType type conversion
-- `flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp:136` not yet implemented: record type with a boxproc type
 - fir.global for procedure pointers
 
 or
 
+- `flang/lib/Optimizer/CodeGen/TypeConverter.h:64` TODO: BoxProcType type conversion
 - `flang/lib/Optimizer/CodeGen/CodeGen.cpp:2080` not yet implemented: fir.emboxproc codegen
 - `flang/lib/Optimizer/CodeGen/CodeGen.cpp:629` not yet implemented: fir.boxproc_host codegen
 - `flang/lib/Optimizer/CodeGen/CodeGen.cpp:1078` not yet implemented: fir.len_param_index codegen
 - `flang/lib/Optimizer/CodeGen/CodeGen.cpp:3166` not yet implemented: fir.unboxproc codegen
 
 ---
 
 Resources:
 - [1] Fortran standard

flang/include/flang/Optimizer/Dialect/FIRTypes.td

let extraClassDeclaration = [{
     mlir::Type getType(unsigned index) {
       assert(index < getNumFields());
       return getTypeList()[index].second;
     }
     unsigned getNumFields() { return getTypeList().size(); }
     unsigned getNumLenParams() { return getLenParamList().size(); }
     bool isDependentType() { return getNumLenParams(); }
 
+    bool isFinalized() const;
     void finalize(llvm::ArrayRef<TypePair> lenPList,
                   llvm::ArrayRef<TypePair> typeList);
 
     detail::RecordTypeStorage const *uniqueKey() const;
   }];
 }
 
 def fir_ReferenceType : FIR_Type<"Reference", "ref"> {

flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp

addConversion(
         [&](BoxType ty) { return BoxType::get(convertType(ty.getEleTy())); });
     addConversion([&](SequenceType ty) {
       // TODO: add ty.getLayoutMap() as needed.
       return SequenceType::get(ty.getShape(), convertType(ty.getEleTy()));
     });
     addConversion([&](RecordType ty) -> mlir::Type {
       if (!needsConversion(ty))
         return ty;
-      // FIR record types can have recursive references, so conversion is a bit
-      // more complex than the other types. This conversion is not needed
-      // presently, so just emit a TODO message. Need to consider the uniqued
-      // name of the record, etc. Also, fir::RecordType::get returns the
-      // existing type being translated. So finalize() will not change it, and
-      // the translation would not do anything. So the type needs to be mutated,
-      // and this might require special care to comply with MLIR infrastructure.
-
-      // TODO: this will be needed to support derived type containing procedure
-      // pointer components.
-      fir::emitFatalError(
-          loc, "not yet implemented: record type with a boxproc type");
-      return RecordType::get(ty.getContext(), "*fixme*");
+      auto rec =
+          RecordType::get(ty.getContext(), ty.getName().str() + "UnboxProc");
+      if (rec.isFinalized())
+        return rec;
+      std::vector<RecordType::TypePair> ps = ty.getLenParamList();
+      std::vector<RecordType::TypePair> cs;
+      for (auto t : ty.getTypeList()) {
+        if (needsConversion(t.second))
+          cs.emplace_back(t.first, convertType(t.second));
+        else
+          cs.emplace_back(t.first, t.second);
+      }
+      rec.finalize(ps, cs);
+      return rec;
     });
     addArgumentMaterialization(materializeProcedure);
     addSourceMaterialization(materializeProcedure);
     addTargetMaterialization(materializeProcedure);
   }
 
   static mlir::Value materializeProcedure(mlir::OpBuilder &builder,
                                           BoxProcType type,

flang/lib/Optimizer/Dialect/FIRType.cpp

 
 /// Is `ty` a standard or FIR integer type?
 static bool isaIntegerType(mlir::Type ty) {
   // TODO: why aren't we using isa_integer? investigatation required.
   return ty.isa<mlir::IntegerType>() || ty.isa<fir::IntegerType>();
 }
 
 bool verifyRecordMemberType(mlir::Type ty) {
-  return !(ty.isa<BoxCharType>() || ty.isa<BoxProcType>() ||
-           ty.isa<ShapeType>() || ty.isa<ShapeShiftType>() ||
-           ty.isa<ShiftType>() || ty.isa<SliceType>() || ty.isa<FieldType>() ||
-           ty.isa<LenType>() || ty.isa<ReferenceType>() ||
-           ty.isa<TypeDescType>());
+  return !(ty.isa<BoxCharType>() || ty.isa<ShapeType>() ||
+           ty.isa<ShapeShiftType>() || ty.isa<ShiftType>() ||
+           ty.isa<SliceType>() || ty.isa<FieldType>() || ty.isa<LenType>() ||
+           ty.isa<ReferenceType>() || ty.isa<TypeDescType>());
 }
 
 bool verifySameLists(llvm::ArrayRef<RecordType::TypePair> a1,
                      llvm::ArrayRef<RecordType::TypePair> a2) {
   // FIXME: do we need to allow for any variance here?
   return a1 == a2;
 }
 
struct RecordTypeStorage : public mlir::TypeStorage {
   void setLenParamList(llvm::ArrayRef<RecordType::TypePair> list) {
     lens = list;
   }
   llvm::ArrayRef<RecordType::TypePair> getLenParamList() const { return lens; }
 
   void setTypeList(llvm::ArrayRef<RecordType::TypePair> list) { types = list; }
   llvm::ArrayRef<RecordType::TypePair> getTypeList() const { return types; }
 
+  bool isFinalized() const { return finalized; }
   void finalize(llvm::ArrayRef<RecordType::TypePair> lenParamList,
                 llvm::ArrayRef<RecordType::TypePair> typeList) {
     if (finalized)
       return;
     finalized = true;
     setLenParamList(lenParamList);
     setTypeList(typeList);
   }

 RecordType::TypeList fir::RecordType::getTypeList() const {
   return getImpl()->getTypeList();
 }
 
 RecordType::TypeList fir::RecordType::getLenParamList() const {
   return getImpl()->getLenParamList();
 }
 
+bool fir::RecordType::isFinalized() const { return getImpl()->isFinalized(); }
+
 detail::RecordTypeStorage const *fir::RecordType::uniqueKey() const {
   return getImpl();
 }
 
 mlir::LogicalResult fir::RecordType::verify(
     llvm::function_ref<mlir::InFlightDiagnostic()> emitError,
     llvm::StringRef name) {
   if (name.size() == 0)

flang/test/Fir/boxproc-2.fir

 // Test fir.boxproc type conversion in the boxed-procedure pass.
 // RUN: fir-opt --boxed-procedure %s | FileCheck %s
 
 //CHECK-LABEL:  func.func private @test1(!fir.type<a{x:i32,y:f64}>, () -> ()) -> none
 func.func private @test1(!fir.type<a{x:i32, y:f64}>, !fir.boxproc<() -> ()>) -> none
 
 //CHECK-LABEL:  func.func private @test2((!fir.type<a{x:i32,y:f64}>) -> ()) -> none
 func.func private @test2(!fir.boxproc<(!fir.type<a{x:i32, y:f64}>) -> ()>) -> none
 
 //CHECK-LABEL:  func.func private @test3(() -> !fir.type<a{x:i32,y:f64}>) -> none
 func.func private @test3(!fir.boxproc<() -> (!fir.type<a{x:i32, y:f64}>)>) -> none
 
 //CHECK-LABEL:  func.func private @test5(((i32) -> f32) -> ())
 func.func private @test5(!fir.boxproc<(!fir.boxproc<(i32) -> (f32)>) -> ()>)
+
+// CHECK-LABEL:   func.func @proc_pointer_component(
+// CHECK-SAME:                                      %[[VAL_0:.*]]: (!fir.ref<i32>) -> f32,
+// CHECK-SAME:                                      %[[VAL_1:.*]]: !fir.ref<i32>) {
+
+func.func @proc_pointer_component(%arg0 : !fir.boxproc<(!fir.ref<i32>) -> f32>, %arg1: !fir.ref<i32>) {
+  %0 = fir.alloca !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>
+  %1 = fir.field_index solve, !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>
+  %2 = fir.coordinate_of %0, %1 : (!fir.ref<!fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>>, !fir.field) -> !fir.ref<!fir.boxproc<() -> ()>>
+  %3 = fir.convert %arg0 : (!fir.boxproc<(!fir.ref<i32>) -> f32>) ->  !fir.boxproc<() -> ()>
+  fir.store %3 to %2 : !fir.ref<!fir.boxproc<() -> ()>>
+  %4 = fir.field_index solve, !fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>
+  %5 = fir.coordinate_of %0, %4 : (!fir.ref<!fir.type<_QFtestTmatrix{element:!fir.array<2x2xf32>,solve:!fir.boxproc<() -> ()>}>>, !fir.field) -> !fir.ref<!fir.boxproc<() -> ()>>
+  %6 = fir.load %5 : !fir.ref<!fir.boxproc<() -> ()>>
+  %7 = fir.convert %6 : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<i32>) -> f32>
+  %8 = fir.box_addr %7 : (!fir.boxproc<(!fir.ref<i32>) -> f32>) -> ((!fir.ref<i32>) -> f32)
+  %9 = fir.call %8(%arg1) : (!fir.ref<i32>) -> f32
+  return
+
+// CHECK:           %[[VAL_2:.*]] = fir.alloca !fir.type<_QFtestTmatrixUnboxProc{element:!fir.array<2x2xf32>,solve:() -> ()}>
+// CHECK:           %[[VAL_3:.*]] = fir.field_index solve, !fir.type<_QFtestTmatrixUnboxProc{element:!fir.array<2x2xf32>,solve:() -> ()}>
+// CHECK:           %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<!fir.type<_QFtestTmatrixUnboxProc{element:!fir.array<2x2xf32>,solve:() -> ()}>>, !fir.field) -> !fir.ref<() -> ()>
+// CHECK:           %[[VAL_5:.*]] = fir.convert %[[VAL_0]] : ((!fir.ref<i32>) -> f32) -> (() -> ())
+// CHECK:           fir.store %[[VAL_5]] to %[[VAL_4]] : !fir.ref<() -> ()>
+// CHECK:           %[[VAL_6:.*]] = fir.field_index solve, !fir.type<_QFtestTmatrixUnboxProc{element:!fir.array<2x2xf32>,solve:() -> ()}>
+// CHECK:           %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_6]] : (!fir.ref<!fir.type<_QFtestTmatrixUnboxProc{element:!fir.array<2x2xf32>,solve:() -> ()}>>, !fir.field) -> !fir.ref<() -> ()>
+// CHECK:           %[[VAL_8:.*]] = fir.load %[[VAL_7]] : !fir.ref<() -> ()>
+// CHECK:           %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (() -> ()) -> ((!fir.ref<i32>) -> f32)
+// CHECK:           %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : ((!fir.ref<i32>) -> f32) -> ((!fir.ref<i32>) -> f32)
+// CHECK:           %[[VAL_11:.*]] = fir.call %[[VAL_10]](%[[VAL_1]]) : (!fir.ref<i32>) -> f32
+
+}