纯函数指针

Ale*_*ogt 6 fortran gfortran intel-fortran

为了遍历Fortran中的链表,我使用指向当前元素的指针,该元素移动到循环内的下一个元素.尝试pure在对所述链表执行操作的函数内应用此操作会导致错误.

例:

module list
  implicit none

  ! Node
  type n_list
    integer               :: val
    type(n_list),pointer  :: next => NULL()
  end type

  ! Linked list
  type t_list
    type(n_list),pointer  :: head
  end type

contains

  pure function in_list( list, val ) result(res)
    implicit none
    class(t_list),intent(in)  :: list
    integer,intent(in)        :: val
    logical                   :: res
    type(n_list),pointer      :: cur

    res = .true.
    ! Traverse the list
    cur => list%head
    do while ( associated(cur) )
      if ( cur%val == val ) return 
      cur => cur%next
    enddo

    ! Not found
    res = .false.
  end function
end module
Run Code Online (Sandbox Code Playgroud)

结果是

    cur => list%head
         1
Error: Bad target in pointer assignment in PURE procedure at (1)
Run Code Online (Sandbox Code Playgroud)

我知道错误/警告背后的基本原理,并且很难确保在使用指针时函数的参数不会改变(Fortran 2008,ch.12.7"Pure procedures",特别是C1283).但在这种情况下,list永远不会改变.

是否可以告诉编译器(ifortgfortran)intent(in)没有违反?

Ale*_*ogt 5

我找到了一个使用recursive至少符合标准的功能的解决方案.它不优雅也不快,并且受到堆栈深度的限制,但它正在工作.我会发布它作为答案,虽然我希望有一个人有更好的解决方案......

module list
  implicit none

  ! Node
  type n_list
    integer               :: val
    type(n_list),pointer  :: next => NULL()
  end type

  ! Linked list
  type t_list
    type(n_list),pointer  :: head
  end type

contains

  pure function in_list( list, val ) result(res)
    implicit none
    class(t_list),intent(in)  :: list
    integer,intent(in)        :: val
    logical                   :: res

    if (  associated(list%head) ) then
      res = in_list_node( list%head, val ) 
    else
      res = .false.
    endif
  end function

  recursive pure function in_list_node( node, val ) result(res)
    implicit none
    class(n_list),intent(in)  :: node
    integer,intent(in)        :: val
    logical                   :: res

    if ( node%val == val ) then
      res = .true.
    elseif ( associated(node%next) ) then
      ! Recurse
      res = in_list_node( node%next, val ) 
    else
      res = .false.
    endif
  end function
end module

program test
  use list
  implicit none
  integer,parameter     :: MAXELEM = 100000
  integer               :: i
  type(t_list)          :: lst
  type(n_list),pointer  :: cur

  ! Fill list
  lst%head => NULL()
  allocate( lst%head )
  lst%head%val = 1

  cur => lst%head
  do i=2,MAXELEM
    allocate( cur%next )
    cur%next%val = i
    cur => cur%next
  enddo !i

  print *,'is MAXELEM/2 in list? ', in_list( lst, MAXELEM/2 )
  print *,'is MAXELEM+1 in list? ', in_list( lst, MAXELEM+1 )
end program
Run Code Online (Sandbox Code Playgroud)


fra*_*lus 5

你遇到的约束的相关部分(C1283)是

在纯子程序中,任何具有基础对象的指示符都是......具有INTENT(IN)属性的伪参数...不得使用

  • ..

  • 作为指针赋值stmt中的数据目标

下面的注释说明约束描述会激发它

上述约束旨在保证纯程序没有副作用

你想说的是"我保证没有副作用,我们不需要那些限制".约束条件已足够但不是必需的,您可以很好地分析代码.

但是,符合标准的处理器/编译器必须能够检测到约束的违反,而不仅仅是约束的总体目标,因此您不仅需要说"它pure确实",而且还"我不需要被告知违反C1283".对于编译器供应商而言,这似乎需要付出很多努力才能获得很少的好处.

我想,答案是"不":没有办法编译你的代码.这不是确定的,因为我们真的是特定于实现的领域.你特别询问了gfortran和ifort,所以"使用-nocheck c1283"反驳了我的"回答".

现在,如果有一个选项,你就属于"信任我"(和非标准的Fortran).所以,无论如何,我们去吧.只是我们要撒谎.像往常一样,接口块将是我们的手段.

module list_mod
  implicit none

  ! Node
  type n_list
    integer               :: val
    type(n_list),pointer  :: next => NULL()
  end type

  ! Linked list
  type t_list
    type(n_list),pointer  :: head
  end type

  interface
    pure logical function in_list(list, val)
      import t_list
      class(t_list), intent(in) :: list
      integer, intent(in) :: val
    end function
  end interface

end module

! Interface mismatch in the external function
function in_list(list, val) result(res)
  use list_mod, only : t_list, n_list
  implicit none
  class(t_list),intent(in)  :: list
  integer,intent(in)        :: val
  logical                   :: res
  type(n_list),pointer      :: cur

  res = .true.
  ! Traverse the list
  cur => list%head
  do while ( associated(cur) )
    if ( cur%val == val ) return 
    cur => cur%next
  enddo

  ! Not found
  res = .false.
end function

  use list_mod
  type(t_list) testlist
  type(n_list), pointer :: ptr
  integer i
  logical :: res(5) = .FALSE.

  allocate(testlist%head)
  ptr => testlist%head

  do i=1,5
    allocate(ptr%next)
    ptr => ptr%next
    ptr%val = i
  end do

  ! in_list is pure, isn't it?
  forall(i=1:5:2) res(i)=in_list(testlist,i)
  print*, res
end
Run Code Online (Sandbox Code Playgroud)

这是纯粹的肮脏并且是有限的:你不再有模块程序; 你不符合标准; 编译器可能很聪明并检查接口(即使它不需要).如果编译器因此而讨厌您,那么您只能责怪自己.

最后,获得该程序需要付出很多努力pure.


Ale*_*ogt 2

好的,我找到了使用内在函数的解决方案transfer。主要思想是克隆列表结构(没有数据,我检查过),并使用指向第一个节点(未更改)的指针作为起始值。是的,这是一个漏洞,但双方ifortgfortran接受了这一点,没有任何警告。

module list_mod
  implicit none

  ! Node
  type n_list
    integer               :: val
    type(n_list),pointer  :: next => NULL()
  end type

  ! Linked list
  type t_list
    type(n_list),pointer  :: head
  end type

contains

  pure function getHead(list) result(res)
    implicit none
    class(t_list),intent(in)  :: list
    type(n_list),pointer      :: res
    type(t_list),pointer      :: listPtr

    ! Create a copy of pointer to the list struct
    allocate( listPtr )
    listPtr = transfer( list, listPtr )

    ! Set the pointer
    res => listPtr%head

    ! Free memory
    deallocate( listPtr )
  end function

  pure function in_list( list, val ) result(res)
    implicit none
    class(t_list),intent(in)  :: list
    integer,intent(in)        :: val
    logical                   :: res
    type(n_list),pointer      :: cur

    res = .true.

    ! Traverse the list
    cur => getHead(list)
    do while ( associated(cur) )
      if ( cur%val == val ) return
      cur => cur%next
    enddo

    ! Not found
    res = .false.
  end function

end module

program test
  use list_mod
  implicit none
  integer,parameter     :: MAXELEM = 10000000
  integer               :: i
  type(t_list)          :: list
  type(n_list),pointer  :: cur

  ! Fill list
  list%head => NULL()
  allocate( list%head )
  list%head%val = 1

  cur => list%head
  do i=2,MAXELEM
    allocate( cur%next )
    cur%next%val = i
    cur => cur%next
  enddo !i

  print *,'is MAXELEM/2 in list? ', in_list( list, MAXELEM/2 )
  print *,'is MAXELEM+1 in list? ', in_list( list, MAXELEM+1 )
end program
Run Code Online (Sandbox Code Playgroud)