Derived types can be parameterized with type parameters. A type parameter is either a kind type parameter or a length type parameter. Both kind and length type parameters are of integer type.
This document aims to give insights at the representation of PDTs in FIR and how PDTs related constructs and features are lowered to FIR.
Here is a list of the sections and constraints of the Fortran standard involved for parameterized derived types.
The constraints are implemented and tested in flang.
PDTs with kind type parameter are already implemented in flang. Since the kind type parameter shall be a constant expression, it can be determined at compile-time and is folded in the type itself. Kind type parameters also play a role in determining a specific type instance according to the Fortran standard.
Fortran
type t(k) integer, kind :: k end type type(t(1)) :: tk1 type(t(2)) :: tk2
In the example above, tk1
and tk2
have distinct types.
Lowering makes the distinction between the two types by giving them different names @_QFE.kp.t.1
and @_QFE.kp.t.2
. More information about the unique names can be found here: flang/docs/BijectiveInternalNameUniquing.md
Two PDTs with the same derived type and the same kind type parameters but different length type parameters are not distinct types. Unlike the kind type parameter, the length type parameters do not play a role in determining a specific type instance. PDTs with length type parameter can be seen as dependent types[1].
In the example below, tk1
and tk2
have the same type but may have different layout in memory. They have different value for the length type parameter l
. tk1
and tk2
are not convertible unlike CHARACTER
types. Assigning tk2
to tk1
is not a valid program.
Fortran
type t(k,l) integer, kind :: k integer, len :: l end type type(t(1, i+1)) :: tk1 type(t(1, i+2)) :: tk2 ! This is invalid tk2 = tk1
Components with length type parameters cannot be folded into the type at compile-time like the one with kind type parameters since their size is not known. There are multiple ways to implement length type parameters and here are two possibilities.
Directly encapsulate the components in the derived type. This will be referred as the “inlined” solution in the rest of the document. The size of the descriptor will not be fixed and be computed at runtime. Size, offset need to be computed at runtime as well.
Use a level of indirection for the components outside of the descriptor. This will be referred as the “outlined” solution in the rest of the document. The descriptor size will then remain the same.
These solutions have pros and cons and more details are given in the next few sections.
In case of len_type1
, the size, offset, etc. of fld1
and fld2
depend on the runtime values of i
and j
when the components are inlined into the derived type. At runtime, this information needs to be computed to be retrieved. While lowering the PDT, compiler generated functions can be created in order to compute this information.
Note: The type description tables generated by semantics and used throughout the runtime have component offsets as constants. Inlining component would require this representation to be extended.
Fortran
! PDT with one level of inlined components. type len_type1(i, j) integer, len :: i, j character(i+j) :: fld1 character(j-i+2) :: fld2 end type
A level of indirection can be used and fld1
and fld2
are then outlined as shown in len_type2
. compiler_allocatable is here only to show which components have an indirection.
Fortran
! PDT with one level of indirection. type len_type2(i, j) integer, len :: i, j ! The two following components are not directly stored in the type but ! allocatable components managed by the compiler. The ! `compiler_managed_allocatable` is not a proper keyword but just added here ! to have a better understanding. character(i+j), compiler_managed_allocatable :: fld1 character(j-i+2), compiler_managed_allocatable :: fld2 end type
This solution has performance drawback because of the added indirections. It also has to deal with compiler managed allocation/deallocation of the components pointed by the indirections.
These indirections are more problematic when we deal with array slice of derived types as it could require temporaries depending how the memory is allocated.
The outlined solution is also problematic for unformatted I/O as the indirections need to be followed correctly when reading or writing records.
PDTs can be nested. Here are some example used later in the document.
Fortran
! PDT with second level of inlined components. type len_type3(i, j) integer, len :: i, j character(2*j) :: name type(len_type1(i*2, j+4)) :: field end type ! PDT with second level of indirection type len_type4(i, j) integer, len :: i, j character(2*j), compiler_allocatable :: name type(len_type2(i-1, 2**j)), compiler_allocatable :: field end type
Let's take an example with an array slice to see the advantages and disadvantages of the two solutions.
For all derived types that do not have LEN type parameter (only have compile-time constants) a standard descriptor can be set with the correct offset and strides such that array%field%fld2
can be encoded in the descriptor, is not contiguous, and does not require a copy. This is what is implemented in flang.
Fortran
! Declare arrays of PDTs type(len_type3(exp1,exp2)) :: pdt_inlined_array(exp3) type(len_type4(exp1,exp2)) :: pdt_outlined_array(exp3) ! Passing/accessing a slice of PDTs array pdt_inlined_array%field%fld2
For a derived type with length type parameters inlined the expression pdt_inlined_array%field%fld2
can be encoded in the standard descriptor because the components of pdt_inlined_array
are inlined such that the array is laid out with all its subcomponents in a contiguous range of memory.
For the pdt_outlined_array
array, the implementation has to insert several level of indirections and therefore cannot be encoded in the standard descriptor. The different indirections levels break the property of the large contiguous block in memory if the allocation is done for each components. This would make the pdt_outlined_array
a ragged array. The memory can also be allocated for components with length type parameters while allocating the base object (in this case the pdt_outlined_array
).
For each non-allocatable/non-pointer leaf automatic component of a PDT base entity (pdt_outlined_array
here) or a base entity containing PDTs, the initialization will allocate a single block in memory for all the leaf components reachable in the base entity (pdt_outlined_array(i)%field%fld1
). The size of this block will be N * sizeof(leaf-component)
where N
is the multiplication of the size of each part-ref from the base entity to the leaf component. The descriptor for each leaf component can then point to the correct location in the block block[i*sizeof(leaf-component)]
.
Outlining the components has the advantage that the size of the PDTs are compile-time constant as each field is encoded as a descriptor pointing to the data. It has a disadvantage to require non-standard descriptors and comes with additional runtime cost.
With components inlining, the size of the PDTs are not compile-time constant. This solution has the advantage to not add a performance drawback with additional indirections but requires to compute the size of the descriptor at runtime. The size of the PDTs need to be computed at runtime. This is already the case for dynamic allocation sizes since it is possible for arrays to have dynamic shapes, etc.
Compiler | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
---|---|---|---|---|---|---|---|---|---|
gfortran | crash | ok | crash | ok | ok | ok | no | no | no |
nag | ok | ok | ok | crash | ok | ok | ok | no | no |
nvfortran | crash | ok | ok | ok | ok | ok | ok | ok | no |
xlf | ok | ok | ok | ok | wrong | ok | wrong | no | no |
ifort | ok | ok | ok | ok | ok | ok | ok | crash | crash |
Legends of results in the table
ok = compile + run + good result wrong = compile + run + wrong result crash = compiler crash or runtime crash no = doesn't compile with no crash
A PDT with length type parameters has a list of 1 or more type parameters that are runtime values. These length type parameter values can be present in specification of other type parameters, array bounds expressions, etc. All these expressions are integer specifications expressions and can be evaluated at any given point with the length type parameters value of the PDT instance. This is possible because constraints C750 and C754 from Fortran 2018 standard that restrict what can appear in the specification expression.
note: C750 and C754 are partially enforced in the semantic at the moment.
These expressions can be lowered into small simple functions. For example, the offset of fld1
in len_type1
could be 0; its size would be computed as sizeof(char) * (i+j)
. size
can be lowered into a compiler generated function.
FIR
// Example of compiler generated functions to compute offsets, size, etc. // This is just an example and actual implementation might have more functions. // name field offset. func.func @_len_type3.offset.name() -> index { %0 = arith.constant 0 : index return %0 : index } // size for `name`: sizeof(char) * (2 * i) + padding func.func @_len_type3.memsize.name(%i: index, %j: index) -> index { %0 = arith.constant 2 : index %1 = arith.constant 8 : index %2 = arith.muli %0, %i : index %3 = arith.muli %1, %2 : index // padding not added here return %3 : index } // `fld` field offset. func.func @_len_type3.offset.field(%i: index, %j: index) -> index { %0 = call @_len_type3.offset.name() : () -> index %1 = call @_len_type3.memsize.name(%i, %j) : (index, index) -> index %2 = arith.addi %0, %1 : index return %2 : index } // 1st type parameter used for field `fld`: i*2 func.func @_len_type3.field.typeparam.1(%i : index, %j : index) -> index { %0 = arith.constant 2 : index %1 = arith.muli %0, %i : index return %1 : index } // 2nd type parameter used for field `fld`: j+4 func.func @_len_type3.field.typeparam.2(%i : index, %j : index) -> index { %0 = arith.constant 4 : index %1 = arith.addi %j, %0 : index return %1 : index } // `fld1` offset in `len_type1`. func.func @_len_type1.offset.fld1() -> index { %0 = arith.constant 0 : index return %0 : index } // size for `fld1`. func.func @_len_type1.memsize.fld1(%i : index, %j : index) -> index { %0 = arith.constant 8 : index %1 = arith.addi %i, %j : index %2 = arith.muli %0, %1 : index return %2 : index } // `fld2` offset in `len_type1`. func.func @_len_type1.offset.fld2(%i : index, %j : index) -> index { %0 = call @_len_type1.offset.fld1() : () -> index %1 = call @_len_type1.memsize.fld1(%i, %j) : (index, index) -> index %2 = arith.addi %0, %1 : index return %2 : index }
Access a field
pdt_inlined_array(1)%field%fld2
Example of offset computation in the PDTs.
%0 = call @_len_type3.field.typeparam.1(%i, %j) : (index, index) -> index %1 = call @_len_type3.field.typeparam.2(%i, %j) : (index, index) -> index %2 = call @_len_type3.offset.fld(%i, %j) : (index, index) -> index %3 = call @_len_type1.offset.fld2(%0, %1) : (index, index) -> index %offset_of_1st_element = arith.addi %2, %3 : index // Use the value computed offset_of_1st_element
In the case where the length type parameters values (i,j)
are compile-time constants then function inlining and constant folding will transform these dependent types into statically defined types with no runtime cost.
Fortran
type t(l) integer, len :: l integer :: i(l) end type type(t(n)), target :: a(10) integer, pointer :: p(:) p => a(:)%i(5)
When making a new descriptor like for pointer association, the field_index
operation can take the length type parameters needed for size/offset computation.
FIR
%5 = fir.field_index i, !fir.type<_QMmod1Tt{l:i32,i:!fir.array<?xi32>}>(%n : i32)
The component of a PDT can be defined with expressions including the length type parameters.
Fortran
type t1(n, m) integer, len :: n = 2 integer, len :: m = 4 real :: data(n*m) end type
The idea would be to replace the expression with an extra length type parameter with a compiler generated name and a default value of n*m
. All instance of the expression would then reference the new name.
Fortran
type t1(n, m) integer, len :: n = 2 integer, len :: m = 4 integer, len :: _t1_n_m = 8 ! hidden extra length type parameter real :: data(_t1_n_m) end type
At any place where the a PDT is initialized, the lowering would make the evaluation and their values saved in the addendum and pointed to by the descriptor.
ALLOCATE
/DEALLOCATE
statementsThe allocation and deallocation of PDTs are delegated to the runtime.
The corresponding function can be found in flang/include/flang/Runtime/allocatable.h
and flang/include/flang/Runtime/pointer.h
for pointer allocation.
ALLOCATE
The ALLOCATE
statement is lowered to a sequence of function calls as shown in the example below.
Fortran
type t1(i) integer, len :: i = 4 character(i) :: c end type type(t1), allocatable :: t type(t1), pointer :: p allocate(t1(2)::t) allocate(t1(2)::p)
FIR
// For allocatable %5 = fir.call @_FortranAAllocatableInitDerived(%desc, %type) : (!fir.box<none>, ) -> () // The AllocatableSetDerivedLength functions is called for each length type parameters. %6 = fir.call @_FortranAAllocatableSetDerivedLength(%desc, %pos, %value) : (!fir.box<none>, i32, i64) -> () %7 = fir.call @_FortranAAllocatableAllocate(%3) : (!fir.box<none>) -> () // For pointer %5 = fir.call @_FortranAPointerNullifyDerived(%desc, %type) : (!fir.box<none>, ) -> () // The PointerSetDerivedLength functions is called for each length type parameters. %6 = fir.call @_FortranAPointerSetDerivedLength(%desc, %pos, %value) : (!fir.box<none>, i32, i64) -> () %7 = fir.call @_FortranAPointerAllocate(%3) : (!fir.box<none>) -> ()
DEALLOCATE
The DEALLOCATE
statement is lowered to a runtime call to AllocatableDeallocate
and PointerDeallocate
for pointers.
Fortran
deallocate(pdt1)
FIR
// For allocatable %8 = fir.call @_FortranAAllocatableDeallocate(%desc1) : (!fir.box<none>) -> (i32) // For pointer %8 = fir.call @_FortranAPointerDeallocate(%desc1) : (!fir.box<none>) -> (i32)
NULLIFY
The NULLIFY
statement is lowered to a call to the corresponding runtime function PointerNullifyDerived
in flang/include/flang/Runtime/pointer.h
.
Fortran
NULLIFY(p)
FIR
%0 = fir.call @_FortranAPointerNullifyDerived(%desc, %type) : (!fir.box<none>, !fir.tdesc) -> ()
The I/O runtime internals are described in this file: flang/docs/IORuntimeInternals.md
.
When an I/O statement with a derived-type is encountered in lowering, the derived-type is emboxed in a descriptor if it is not already and a call to the runtime library is issued with the descriptor (as shown in the example below). The function is _FortranAioOutputDescriptor
. The call make a call to FormattedDerivedTypeIO
in flang/runtime/descriptor-io.h
for derived-type. This function will need to be updated to support the chosen solution for PDTs.
Fortran
type t integer, len :: l integer :: i(l) = 42 end type ! ... subroutine print_pdt type(t(10)) :: x print*, x end subroutine
FIR
func.func @_QMpdtPprint_pdt() { %l = arith.constant = 10 %0 = fir.alloca !fir.type<_QMpdtTt{l:i32,i:!fir.array<?xi32>}> (%l : i32) {bindc_name = "x", uniq_name = "_QMpdt_initFlocalEx"} %1 = fir.embox %0 : (!fir.ref<!fir.type<_QMpdtTt{l:i32,i:!fir.array<?xi32>}>>) (typeparams %l : i32) -> !fir.box<!fir.type<_QMpdt_initTt{l:i32,i:!fir.array<2xi32>}>> %2 = fir.address_of(@_QQcl.2E2F6669725F7064745F6578616D706C652E66393000) : !fir.ref<!fir.char<1,22>> %c8_i32 = arith.constant 8 : i32 %3 = fir.convert %1 : (!fir.box<!fir.type<_QMpdtTt{l:i32,i:!fir.array<?xi32>}>>) -> !fir.box<none> %4 = fir.convert %2 : (!fir.ref<!fir.char<1,22>>) -> !fir.ref<i8> %5 = fir.call @_FortranAInitialize(%3, %4, %c8_i32) : (!fir.box<none>, !fir.ref<i8>, i32) -> none %c-1_i32 = arith.constant -1 : i32 %6 = fir.address_of(@_QQcl.2E2F6669725F7064745F6578616D706C652E66393000) : !fir.ref<!fir.char<1,22>> %7 = fir.convert %6 : (!fir.ref<!fir.char<1,22>>) -> !fir.ref<i8> %c10_i32 = arith.constant 10 : i32 %8 = fir.call @_FortranAioBeginExternalListOutput(%c-1_i32, %7, %c10_i32) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8> %9 = fir.embox %0 : (!fir.ref<!fir.type<_QMpdt_initTt{l:i32,i:!fir.array<?xi32>}>>) (typeparams %l : i32) -> !fir.box<!fir.type<_QMpdtTt{l:i32,i:!fir.array<?xi32>}>> %10 = fir.convert %9 : (!fir.box<!fir.type<_QMpdt_initTt{l:i32,i:!fir.array<?xi32>}>>) -> !fir.box<none> %11 = fir.call @_FortranAioOutputDescriptor(%8, %10) : (!fir.ref<i8>, !fir.box<none>) -> i1 %12 = fir.call @_FortranAioEndIoStatement(%8) : (!fir.ref<i8>) -> i32 return }
The entry point in the runtime for unformatted I/O is similar than the one for formatted I/O. A call to _FortranAioOutputDescriptor
with the correct descriptor is also issued by the lowering. For unformatted I/O, the runtime is calling UnformattedDescriptorIO
from flang/runtime/descriptor-io.h
. This function will need to be updated to support the chosen solution for PDTs.
Default initializers for components with length type parameters need to be processed as the derived type instance is created. The length parameters block must also be created and attached to the addendum. See New f18addendum section for more information.
As mentioned in 10.2.1.2 (8), for an assignment, each length type parameter of the variable shall have the same value as the corresponding type parameter unless the lhs is allocatable.
Fortran
type t(l) integer, len :: l integer :: i(l) end type ! ... type(t(10)) :: a, b type(t(20)) :: c type(t(:)), allocatable :: d a = b ! Legal assignment c = b ! Illegal assignment because `c` does not have the same length type ! parameter value than `b`. d = c ! Legal because `d` is allocatable
A simple intrinsic assignment without allocatable or pointer follows the same path than the traditional derived-type (addressing of component is different) since the length type parameter values are identical and do not need to be copied or reallocated. The length type parameters values are retrieved when copying the data.
Assignment of PDTs with allocatable or pointer components are done with the help of the runtime. A call to _FortranAAssign
is done with the lhs and rhs descriptors. The length type parameters are available in the descriptors.
For allocatable PDTs, if the rhs side has different length type parameters than the lhs, it is deallocated first and allocated with the rhs length type parameters information (F'2018 10.2.1.3(3)). There is code in the runtime to handle this already. It will need to be updated for the new f18addendum.
A final subroutine is called for a PDT if the subroutine has the same kind type parameters and rank as the entity to be finalized. The final subroutine is called with the entity as the actual argument. If there is an elemental final subroutine whose dummy argument has the same kind type parameters as the entity to be finalized, or a final subroutine whose dummy argument is assumed-rank with the same kind type parameters as the entity to be finalized, the subroutine is called with the entity as the actual argument. Otherwise, no subroutine is called.
Example from the F2018 standard
module m type t(k) integer, kind :: k real(k), pointer :: vector(:) => NULL() contains final :: finalize_t1s, finalize_t1v, finalize_t2e end type contains subroutine finalize_t1s(x) type(t(kind(0.0))) x if (associated(x%vector)) deallocate(x%vector) END subroutine subroutine finalize_t1v(x) type(t(kind(0.0))) x(:) do i = lbound(x,1), ubound(x,1) if (associated(x(i)%vector)) deallocate(x(i)%vector) end do end subroutine elemental subroutine finalize_t2e(x) type(t(kind(0.0d0))), intent(inout) :: x if (associated(x%vector)) deallocate(x%vector) end subroutine end module subroutine example(n) use m type(t(kind(0.0))) a, b(10), c(n,2) type(t(kind(0.0d0))) d(n,n) ... ! Returning from this subroutine will effectively do ! call finalize_t1s(a) ! call finalize_t1v(b) ! call finalize_t2e(d) ! No final subroutine will be called for variable C because the user ! omitted to define a suitable specific procedure for it. end subroutine
Type parameter inquiry is used to get the value of a type parameter in a PDT.
Fortran
module t type t1(i, j) integer, len :: i = 4 integer, len :: j = 2 character(i*j) :: c end type end program main use t type(t1(2, 2)) :: ti print*, ti%c%len print*, ti%i print*, ti%j end ! Should print: ! 4 ! 2 ! 2
These values are present in the f18Addendum
and can be retrieved from it with the correct index. If the length type parameter for a field is an expression, a compiler generated function is used to computed its value. The length type parameters are indexed in declaration order; i.e., 0 is the first length type parameter in the deepest base type.
In some cases with polymorphic entities, it is necessary to copy the length type parameters from a descriptor to another. With the current design this is not possible since the descriptor cannot be reallocated and the addendum is allocated with a fixed number of length type parameters.
Fortran
! The example below illustrates a case where the number of length type ! parameters are different and need to be copied to an existing descriptor ! addendum. module m1 type t1 integer :: i end type ! This type could be defined in another compilation unit. type, extends(t1) :: t2(l1, l2) integer, len :: l1, l2 end type contains subroutine reallocate(x) class(t1), allocatable :: x allocate(t2(l1=1, l2=2):: x) end subroutine end module program p use m1 class(t1), allocatable :: x call reallocate(x) ! The new length type parameters need to be propagated at this point. ! rest of code using `x` end program
The proposed solution is to add indirection in the f18Addendum
and store the length type parameters in a separate block instead of directly in the addendum. At the moment the storage for the length type parameters is allocated once as a std::int64_t
array.
New f18Addendum
{*derivedType_, *lenParamValues_}
Adding the indirection in the descriptor's addendum requires to manage the lifetime of the block holding the length type parameter values.
Here are some thoughts of how to manage it:
The addendum of an array sections/sub-objects would point to the same block than the base object.
In some special cases, a descriptor needs to be passed between the caller and the callee. This includes array of PDTs and derived-type with PDT components. The example describe one of the corner case where the length type parameter would be lost if the descriptor is not passed.
Because of the length type parameters store in the addendum, it is required in some case to pass the PDT with a descriptor to preserve the length type parameters information. The example below illustrates such a case.
Fortran
module m type t integer :: i end type type, extends(t) :: t2(l) integer, len :: l real :: x(l) end type type base type(t2(20)) :: pdt_component end type class(t), pointer :: p(:) contains subroutine foo(x, n) integer :: n type(base), target :: x(n) ! Without descriptor, the actual argument is a zero-sized array. The length ! type parameters of `x(n)%pdt_component` are not propagated from the caller. ! A descriptor local to this function is created to pass the array section ! in bar. call bar(x%pdt_component) end subroutine subroutine bar(x) type(t2(*)), target :: x(:) p => x end subroutine subroutine test() type(base), target :: x(100) call foo(x(1:-1:1), 0) select type (p) type is (t2(*)) ! This type parameters of x(1:60:3) in foo must still live here print *, p%l class default print *, "something else" end select end subroutine end module use m call test() end
Because of the use case described above, PDTs, array of PDTs or derived-type with PDT components will be passed by descriptor.
Couple of operations have length type parameters as operands already in their design. For some operations, length type parameters are likely needed with the two proposed solution. Some other operation like the array operations, the operands are not needed when dealing with a descriptor since the length type parameters are in it.
The operations will be updated if needed during the implementation of the chosen solution.
fir.alloca
This primitive operation is used to allocate an object on the stack. When allocating a PDT, the length type parameters are passed to the operation so its size can be computed accordingly.
FIR
%i = arith.constant 10 : i32 %0 = fir.alloca !fir.type<_QMmod1Tpdt{i:i32,data:!fir.array<?xf32>}> (%i : i32) // %i is the ssa value of the length type parameter
fir.allocmem
This operation is used to create a heap memory reference suitable for storing a value of the given type. When creating a PDT, the length type parameters are passed so the size can be computed accordingly.
FIR
%i = arith.constant 10 : i32 %0 = fir.alloca !fir.type<_QMmod1Tpdt{i:i32,data:!fir.array<?xf32>}> (%i : i32) // ... fir.freemem %0 : !fir.type<_QMmod1Tpdt{i:i32,data:!fir.array<?xf32>}>
fir.embox
The fir.embox
operation create a boxed reference value. In the case of PDTs the length type parameters can be passed as well to the operation.
Fortran
subroutine local() type(t(2)) :: x ! simple local PDT ! ... end subroutine
FIR
func.func @_QMpdt_initPlocal() { %c2_i32 = arith.constant 2 : i32 %0 = fir.alloca !fir.type<_QMpdt_initTt{l:i32,i:!fir.array<?xi32>}> (%c2 : i32) {bindc_name = "x", uniq_name = "_QMpdt_initFlocalEx"} // The fir.embox operation is responsible to place the provided length type // parameters in the descriptor addendum so they are available to the runtime // call later. %1 = fir.embox %0 : (!fir.ref<!fir.type<_QMpdt_initTt{l:i32,i:!fir.array<?xi32>}>>) (typeparams %c2 : i32) -> !fir.box<!fir.type<_QMpdt_initTt{l:i32,i:!fir.array<?xi32>}>> %2 = fir.address_of(@_QQcl.2E2F6669725F7064745F6578616D706C652E66393000) : !fir.ref<!fir.char<1,22>> %c8_i32 = arith.constant 8 : i32 %3 = fir.convert %1 : (!fir.box<!fir.type<_QMpdt_initTt{l:i32,i:!fir.array<?xi32>}>>) -> !fir.box<none> %4 = fir.convert %2 : (!fir.ref<!fir.char<1,22>>) -> !fir.ref<i8> %5 = fir.call @_FortranAInitialize(%3, %4, %c8_i32) : (!fir.box<none>, !fir.ref<i8>, i32) -> none return }
fir.field_index
The fir.field_index
operation is used to generate a field offset value from a field identifier in a derived-type. The operation takes length type parameter values with a PDT so it can compute a correct offset.
FIR
%l = arith.constant 10 : i32 %1 = fir.field_index i, !fir.type<_QMpdt_initTt{l:i32,i:i32}> (%l : i32) %2 = fir.coordinate_of %ref, %1 : (!fir.type<_QMpdt_initTt{l:i32,i:i32}>, !fir.field) -> !fir.ref<i32> %3 = fir.load %2 : !fir.ref<i32> return %3
fir.len_param_index
This operation is used to get the length type parameter offset in from a PDT.
FIR
func.func @_QPpdt_len_value(%arg0: !fir.box<!fir.type<t1{l:i32,!fir.array<?xi32>}>>) -> i32 { %0 = fir.len_param_index l, !fir.box<!fir.type<t1{l:i32,!fir.array<?xi32>}>> %1 = fir.coordinate_of %arg0, %0 : (!fir.box<!fir.type<t1{l:i32,!fir.array<?xi32>}>>, !fir.len) -> !fir.ref<i32> %2 = fir.load %1 : !fir.ref<i32> return %2 : i32 }
fir.save_result
Save the result of a function returning an array, box, or record type value into a memory location given the shape and LEN parameters of the result. Length type parameters is passed if the PDT is not boxed.
FIR
func.func @return_pdt(%buffer: !fir.ref<!fir.type<t2(l1:i32,l2:i32){x:f32}>>) { %l1 = arith.constant 3 : i32 %l2 = arith.constant 5 : i32 %res = fir.call @foo() : () -> !fir.type<t2(l1:i32,l2:i32){x:f32}> fir.save_result %res to %buffer typeparams %l1, %l2 : !fir.type<t2(l1:i32,l2:i32){x:f32}>, !fir.ref<!fir.type<t2(l1:i32,l2:i32){x:f32}>>, i32, i32 return }
fir.array_*
operationsThe current design of the different fir.array_*
operations include length type parameters operands. This is designed to use PDT without descriptor directly in FIR.
FIR
// Operation used with a boxed PDT does not need the length type parameters as // they are directly retrieved from the box. %0 = fir.array_coor %boxed_pdt, %i, %j (fir.box<fir.array<?x?xfir.type<!fir.type<_QMpdt_initTt{l:i32,i:!fir.array<?xi32>}>>>>, index, index) -> !fir.ref<fir.type<!fir.type<_QMpdt_initTt{l:i32,i:!fir.array<?xi32>}>>> // In case the PDT would not be boxed, the length type parameters are needed to // compute the correct addressing. %0 = fir.array_coor %pdt_base, %i, %j typeparams %l (fir.ref<fir.array<?x?xfir.type<!fir.type<_QMpdt_initTt{l:i32,i:!fir.array<?xi32>}>>>>, index, index, index) -> !fir.ref<fir.type<PDT>>
While both solutions have pros and cons, we want to implement the outlined solution.
Current list of TODOs in lowering:
flang/lib/Lower/Allocatable.cpp:461
not yet implement: derived type length parameters in allocateflang/lib/Lower/Allocatable.cpp:645
not yet implement: deferred length type parametersflang/lib/Lower/Bridge.cpp:454
not yet implemented: get length parameters from derived type BoxValueflang/lib/Lower/ConvertExpr.cpp:341
not yet implemented: copy derived type with length parametersflang/lib/Lower/ConvertExpr.cpp:993
not yet implemented: component with length parameters in structure constructorflang/lib/Lower/ConvertExpr.cpp:1063
not yet implemented: component with length parameters in structure constructorflang/lib/Lower/ConvertExpr.cpp:1146
not yet implemented: type parameter inquiryflang/lib/Lower/ConvertExpr.cpp:2424
not yet implemented: creating temporary for derived type with length parametersflang/lib/Lower/ConvertExpr.cpp:3742
not yet implemented: gather rhs LEN parameters in assignment to allocatableflang/lib/Lower/ConvertExpr.cpp:4725
not yet implemented: derived type array expression temp with LEN parametersflang/lib/Lower/ConvertExpr.cpp:6400
not yet implemented: PDT sizeflang/lib/Lower/ConvertExpr.cpp:6419
not yet implemented: PDT offsetflang/lib/Lower/ConvertExpr.cpp:6679
not yet implemented: array expr type parameter inquiryflang/lib/Lower/ConvertExpr.cpp:7135
not yet implemented: need to adjust type parameter(s) to reflect the final componentflang/lib/Lower/ConvertType.cpp:334
not yet implemented: parameterized derived typesflang/lib/Lower/ConvertType.cpp:370
not yet implemented: derived type length parametersflang/lib/Lower/ConvertVariable.cpp:169
not yet implemented: initial-data-target with derived type length parametersflang/lib/Lower/ConvertVariable.cpp:197
not yet implemented: initial-data-target with derived type length parametersflang/lib/Lower/VectorSubscripts.cpp:121
not yet implemented: threading length parameters in field index opflang/lib/Optimizer/Builder/BoxValue.cpp:60
not yet implemented: box value is missing type parametersflang/lib/Optimizer/Builder/BoxValue.cpp:67
not yet implemented: mutable box value is missing type parametersflang/lib/Optimizer/Builder/FIRBuilder.cpp:688
not yet implemented: read fir.box with length parametersflang/lib/Optimizer/Builder/FIRBuilder.cpp:746
not yet implemented: generate code to get LEN type parametersflang/lib/Optimizer/Builder/FIRBuilder.cpp:779
not yet implemented: derived type with type parametersflang/lib/Optimizer/Builder/FIRBuilder.cpp:905
not yet implemented: allocatable and pointer components non deferred length parametersflang/lib/Optimizer/Builder/FIRBuilder.cpp:917
not yet implemented: array component shape depending on length parametersflang/lib/Optimizer/Builder/FIRBuilder.cpp:924
not yet implemented: get character component length from length type parametersflang/lib/Optimizer/Builder/FIRBuilder.cpp:934
not yet implemented: lower component ref that is a derived type with length parameterflang/lib/Optimizer/Builder/FIRBuilder.cpp:956
not yet implemented: get length parameters from derived type BoxValueflang/lib/Optimizer/Builder/MutableBox.cpp:70
not yet implemented: updating mutablebox of derived type with length parametersflang/lib/Optimizer/Builder/MutableBox.cpp:168
not yet implemented: read allocatable or pointer derived type LEN parametersflang/lib/Optimizer/Builder/MutableBox.cpp:310
not yet implemented: update allocatable derived type length parametersflang/lib/Optimizer/Builder/MutableBox.cpp:505
not yet implemented: pointer assignment to derived with length parametersflang/lib/Optimizer/Builder/MutableBox.cpp:597
not yet implemented: pointer assignment to derived with length parametersflang/lib/Optimizer/Builder/MutableBox.cpp:740
not yet implemented: reallocation of derived type entities with length parametersCurrent list of TODOs in code generation:
flang/lib/Optimizer/CodeGen/CodeGen.cpp:1034
not yet implemented: fir.allocmem codegen of derived type with length parametersflang/lib/Optimizer/CodeGen/CodeGen.cpp:1581
not yet implemented: generate call to calculate size of PDTflang/lib/Optimizer/CodeGen/CodeGen.cpp:1708
not yet implemented: fir.embox codegen of derived with length parametersflang/lib/Optimizer/CodeGen/CodeGen.cpp:1749
not yet implemented: reboxing descriptor of derived type with length parametersflang/lib/Optimizer/CodeGen/CodeGen.cpp:2229
not yet implemented: derived type with type parametersflang/lib/Optimizer/CodeGen/CodeGen.cpp:2256
not yet implemented: compute size of derived type with type parametersflang/lib/Optimizer/CodeGen/TypeConverter.h:257
not yet implemented: extended descriptor derived with length parametersCurrent list of TODOs in optimizations:
flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp:1007
not yet implemented: unhandled dynamic type parametersResources: