纯函数中的指针
Pointers in pure functions
为了遍历 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
结果
cur => list%head
1
Error: Bad target in pointer assignment in PURE procedure at (1)
我知道 error/warning 背后的基本原理，并且很难确保在使用指针时函数的参数不被更改（Fortran 2008，第 12.7 章 "Pure procedures" ，尤其是 C1283）。但是，在这种情况下，list 永远不会改变。
是否可以告诉编译器（ifort和gfortran）intent(in)没有被违反？
我找到了一个使用 recursive 函数的解决方案，该解决方案至少符合标准。它既不优雅也不快速，并且受限于堆栈深度，但它正在工作。我会 post 它作为答案，虽然我希望有人有更好的解决方案...
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
您遇到的约束的相关部分 (C12831) 是
In a pure subprogram any designator with a base object that is .. a dummy argument with the INTENT (IN) attribute .. shall not be used
..
as the data-target in a pointer-assignment-stmt
约束描述下面的注释激发了它
The above constraints are designed to guarantee that a pure procedure is free from side effects
你想说的是“我保证没有副作用，我们不需要那个约束”。约束是足够的，但不是这个保证所必需的，你可以很好地分析你的代码。
但是，符合要求的 processor/compiler 必须 能够 检测违反约束的行为，而不仅仅是约束的总体目标，因此您不必只说“这确实是 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
这纯粹是肮脏的，而且是有限制的：您不再有模块过程；你不符合标准；编译器可能很聪明并检查接口（即使它不需要）。如果编译器因此讨厌你，那只能怪你自己。
总算费了好大劲才弄到程序pure.
1 这是Fortran 2008 对应询问时的语言版本。在 Fortran 2018 中，相应的约束是 C1594。
好的，我找到了使用 transfer 内部函数的解决方案。主要思想是克隆列表结构（没有数据，我检查过），并使用指向第一个节点（未更改）的指针作为起始值。是的，这是一个漏洞，但 ifort 和 gfortran 都在没有警告的情况下接受了它。
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
为了遍历 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
结果
cur => list%head
1
Error: Bad target in pointer assignment in PURE procedure at (1)
我知道 error/warning 背后的基本原理，并且很难确保在使用指针时函数的参数不被更改（Fortran 2008，第 12.7 章 "Pure procedures" ，尤其是 C1283）。但是，在这种情况下，list 永远不会改变。
是否可以告诉编译器（ifort和gfortran）intent(in)没有被违反？
我找到了一个使用 recursive 函数的解决方案，该解决方案至少符合标准。它既不优雅也不快速，并且受限于堆栈深度，但它正在工作。我会 post 它作为答案，虽然我希望有人有更好的解决方案...
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
您遇到的约束的相关部分 (C12831) 是
In a pure subprogram any designator with a base object that is .. a dummy argument with the INTENT (IN) attribute .. shall not be used
..
as the data-target in a pointer-assignment-stmt
约束描述下面的注释激发了它
The above constraints are designed to guarantee that a pure procedure is free from side effects
你想说的是“我保证没有副作用，我们不需要那个约束”。约束是足够的，但不是这个保证所必需的，你可以很好地分析你的代码。
但是，符合要求的 processor/compiler 必须 能够 检测违反约束的行为，而不仅仅是约束的总体目标，因此您不必只说“这确实是 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
这纯粹是肮脏的，而且是有限制的：您不再有模块过程；你不符合标准；编译器可能很聪明并检查接口（即使它不需要）。如果编译器因此讨厌你，那只能怪你自己。
总算费了好大劲才弄到程序pure.
1 这是Fortran 2008 对应询问时的语言版本。在 Fortran 2018 中，相应的约束是 C1594。
好的，我找到了使用 transfer 内部函数的解决方案。主要思想是克隆列表结构（没有数据，我检查过），并使用指向第一个节点（未更改）的指针作为起始值。是的，这是一个漏洞，但 ifort 和 gfortran 都在没有警告的情况下接受了它。
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