Use of unlimited polymorphic type for array operation in Fortran 03/08 (gfortran compiler)

浪尽此生 提交于 2019-12-04 12:18:16

This is not an easy problem You can use select type, but Fortran doesn't have anything like type is(type_of(x)). On the other hand, there are the SAME_TYPE_AS() and EXTENDS TYPE_OF() intrinsics, but you cannot use them as type guards.

It is necessary to assure, that the dynamic types of both array and element are the same.

I think this is a deficiency in the standard.

But still, there is an error in your approach. You should make the function result allocatable, to be able to allocate it to correct dynamic type:

class(*), allocatable ::add_element(:)

You may think something along the lines of: (UNTESTED! compiles with gfortran-4.9 ifort14)

allocate(add_element(size(array)+1), mold=array)

But how to actually transfer the values I don't know and I am worried it might not be possible without resorting to some dirty tricks.

You cannot even use transfer and that is where I see real deficiency. Eventhough you can call transfer with polymorphic mold

transfer(element, add_element(1))

you have no way to assign it to the array element

add_element(1) = transfer(element, add_element(1))

My opinion is that Fortran lacks an option for the type guards that just ensures that two variables have the same dynamic type.

You may think something along the lines of: (UNTESTED! compiles with gfortran-4.9 ifort14)

function add_element(array,element)
  use iso_c_binding
  implicit none
  class(*),intent(in)::array(:)
  class(*),intent(in)::element
  class(*), allocatable ::add_element(:)
  type(c_ptr) :: tmp

  interface
    function memcpy(dest, src, n) bind(c)
      use iso_c_binding
      integer(c_intptr_t),value :: dest, src
      integer(c_size_t) :: n
      type(c_ptr) :: memcpy
    end function
  end interface

  allocate(add_element(size(array)+1), mold=array)

  tmp = memcpy(loc(add_element(size(array)+1)), &
               loc(array), &
               size(array, kind=c_size_t) * storage_size(array, c_size_t)/8_c_size_t )
  tmp = memcpy(loc(add_element(size(array)+1)), &
               loc(array(1)), &
               storage_size(element, c_size_t)/8_c_size_t )

end function

CLASS(*) is a facility that basically allows runtime type safe but type agnostic storage. You are trying to use it as a compile time type parameterisation mechanism. It isn't terribly appropriate for that, and the language doesn't directly support an alternative means.

Traditionally type parameterisation is done by placing the common parts of the procedures to be parameterised in a separate file, and then including that file as appropriate, perhaps in a module that uses implicit typing to specify the type to be parameterised.

If you must use CLASS(*), you practically need to write and use a wrapper type. If all you are wrapping is basic array operations, then this will be far more trouble than it is worth.

In client code (versus your common procedures) to extract the thing that has been stored you generally need to use SELECT TYPE (you can use pointer assignment if the type of the data has BIND(C) or SEQUENCE, but this isn't type safe).

TYPE :: Wrapper
  CLASS(*), ALLOCATABLE :: item
END TYPE Wrapper

FUNCTION add_element(array, element)
  TYPE(Wrapper), INTENT(IN) :: array(:)
  CLASS(*), INTENT(IN) :: element
  TYPE(Wrapper), INTENT(OUT) :: add_element(SIZE(array)+1)
  ! If you want to enforce type consistency (at runtime)...
  IF (SIZE(array) > 0) THEN
    IF (.NOT. SAME_TYPE_AS(array(1)%item, element)) THEN
      STOP 'Objects not of same type!'
    END IF
  END IF
  add_element(:SIZE(array)) = array
  add_element(SIZE(add_element))%item = element
END FUNCTION add_element

FUNCTION get(scalar)
  TYPE(Wrapper), INTENT(IN) :: scalar
  CLASS(*), ALLOCATABLE :: get
  get = scalar%item
END FUNCTION get

...

TYPE(Wrapper), ALLOCATABLE :: array(:)
array = [ Wrapper :: ]
array = add_element(array, 'cat')
array = add_element(array, 'dog')

DO i = 1, SIZE(array)
  SELECT TYPE (item => get(array(i)))
  TYPE IS (CHARACTER(*))
    PRINT "(A)", item
  END SELECT
END DO
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!