Pointer on a nested function - closure

[Vladimír Fuka]

Hello,
is the following program legal? I think it segfaults on the last line,
because the closure data is not on the stack anymore. Is there a different
way how to do a function that returns a function?

Vladimir Fuka

module Parameters
implicit none

integer,parameter :: KND = kind(1.)
end module Parameters

module AritmFunctions
use Parameters
implicit none

abstract interface
real(KND) pure function fce(x)
import KND
real(KND),intent(in) :: x
end function fce
end interface

contains

real(KND) pure function plus1(x)
real(KND),intent(in) :: x
plus1=x+1
end function plus1

real(KND) pure function times2(x)
real(KND),intent(in) :: x
times2=times2*2
end function times2

endmodule AritmFunctions

function Compose(f1,f2)
use Parameters
use AritmFunctions
implicit none

procedure(fce) :: f1,f2
procedure(fce),pointer :: Compose
print *, "test",helper(1._KND)
Compose => helper

contains

pure real(KND) function helper(x)
real(KND), intent(in) :: x
helper = f1(f2(x))
end function helper

end function Compose

program Main
use Parameters
use AritmFunctions
implicit none

interface
function Compose(f1,f2)
procedure(fce) :: f1,f2
procedure(fce),pointer :: Compose
end function Compose
end interface

procedure(fce),pointer :: f,g,h

f => plus1
g => times2

print *, times2(plus1(1._KND))

h = Compose(times2,plus1)

print *, h(1._KND)
end program Main


--
Tato zpráva byla vytvořena převratným poštovním klientem Opery:
http://www.opera.com/mail/

[Ian Harvey]

On 2012-02-23 8:46 PM, Vladimír Fuka wrote:
> Hello,
> is the following program legal? I think it segfaults on the last line,
> because the closure data is not on the stack anymore. Is there a
> different way how to do a function that returns a function?

It is not legal for the reasons you state. Note also the use of an
assignment statement (h = Compose(...)) is problematic - that should
probably be pointer assignment.

You could make compose and helper both module procedures and store the
f1 and f2 procedure pointers in module variables, however obviously this
doesn't work if you need multiple "instances" active at once. In that
case I would use a polymorphic object with a binding for the function
that the object represents and components in an extension to store the
necessary child function pointers.

[Vladimír Fuka]

Dne Thu, 23 Feb 2012 11:49:19 +0100 Ian Harvey <ian_h...@bigpond.com>
napsal(a):

Thank you for the hint. I tried the object approach and this compiles and
gives correct result with gfortran-4.7, eventhough valgrind claims
uninitialized values on both prints:

module Parameters
implicit none

integer,parameter :: KND = kind(1.)
end module Parameters

module AritmFunctions
use Parameters
implicit none

abstract interface
real(KND) pure function fce(x)
import KND
real(KND),intent(in) :: x
end function fce
end interface

contains

real(KND) pure function plus1(x)
real(KND),intent(in) :: x
plus1=x+1
end function plus1

real(KND) pure function times2(x)
real(KND),intent(in) :: x
times2=times2*2
end function times2

endmodule AritmFunctions

module ComposeObj

use Parameters
use AritmFunctions
implicit none

private
public Compose

type Compose
private
procedure(fce),pointer,nopass :: f1 => null(),f2=>null()
contains
procedure,public :: call => helper
endtype Compose

interface Compose
procedure NewCompose
end interface

contains

function NewCompose(f,g)
procedure(fce) :: f,g
type(Compose) :: NewCompose

NewCompose%f1 => f
NewCompose%f2 => g
end function NewCompose

pure real(KND) function helper(this,x)
class(Compose),intent(in) :: this
real(KND),intent(in) :: x
helper = this%f1(this%f2(x))
end function helper

end module ComposeObj

program Main
use Parameters
use AritmFunctions

use ComposeObj
implicit none

type(Compose) :: h

print *, times2(plus1(1._KND))

h = Compose(times2,plus1)

print *, h%call(1._KND)

[Erik Toussaint]

On 23-2-2012 10:46, Vladimír Fuka wrote:
> program Main
> use Parameters
> use AritmFunctions
> implicit none
>
> interface
> function Compose(f1,f2)
> procedure(fce) :: f1,f2
> procedure(fce),pointer :: Compose
> end function Compose
> end interface

Side question: why does this interface work without an import statement
for fce?
Even if I include an implicit none statement in there, my compiler
doesn't complain about fce not being declared. I thought an interface
body formed a separate scoping unit.

>
> procedure(fce),pointer :: f,g,h
>
> f => plus1
> g => times2
>
> print *, times2(plus1(1._KND))
>
> h = Compose(times2,plus1)
>
> print *, h(1._KND)
> end program Main
>
>

I think you're hitting a limitation of the output statement. According
to the standard (f2008 9.6.3 Data transfer input/output list):

"C935 (R917) An expression that is an output-item shall not have a value
that is a procedure pointer."

If I use an intermediate variable to assign the result of h(1._KND) to,
and then print the value of that variable, the program completes without
segfault.

Erik.

[Tobias Burnus]

Vladimír Fuka wrote:
> Thank you for the hint. I tried the object approach and this compiles
> and gives correct result with gfortran-4.7, eventhough valgrind claims
> uninitialized values on both prints:

I have to admit that I do not quite understand the location of the
warning, but I can tell you how to get rid of the valgrind warning.

> real(KND) pure function times2(x)
> real(KND),intent(in) :: x
> times2=times2*2
> end function times2

Try: "times2 = x*2" instead of multiplying times2 by 2.

Tobias

[Erik Toussaint]

On 23-2-2012 20:26, Erik Toussaint wrote:
> On 23-2-2012 10:46, Vladimír Fuka wrote:
>> print *, h(1._KND)
>> end program Main
>
> I think you're hitting a limitation of the output statement. According
> to the standard (f2008 9.6.3 Data transfer input/output list):
>
> "C935 (R917) An expression that is an output-item shall not have a value
> that is a procedure pointer."

Looking at it again I realize I made a mistake. Even though h is a
procedure pointer, the output-item is of course not; it's a function
invocation that produces a real(KND) value.

Erik.

[Vladimír Fuka]

>> real(KND) pure function times2(x)
>> real(KND),intent(in) :: x
>> times2=times2*2
>> end function times2
>
> Try: "times2 = x*2" instead of multiplying times2 by 2.
>
> Tobias

Thanks Tobias, so stupid. Strangely it did output 4, which is the correct
answer.

I came to yet another issue. Gfortran-4.7 behaves strange or I got
something wrong with allocatables. In this version and I don't have any
other compiler to test it. It works fine if I declare Compose%inner as
pointer, but not with allocatable. The procedure pointer h%inner%f is null
even if it was correct inside the procedure NewComposeFun and the program
fails on the last line.

Vladimir

module Parameters
implicit none

integer,parameter :: KND = kind(1.)
end module Parameters

module AritmFunctions
use Parameters
implicit none

abstract interface

real(KND) function fce(x)

import KND
real(KND),intent(in) :: x
end function fce
end interface

contains

real(KND) function plus1(x)

real(KND),intent(in) :: x
plus1=x+1
end function plus1

real(KND) function times2(x)
real(KND),intent(in) :: x
times2=x*2

end function times2

endmodule AritmFunctions


module ComposeObj
use Parameters
use AritmFunctions
implicit none

private

public Compose,Fx


type :: Fx
! private
procedure(fce),pointer,nopass :: f => null()
contains
procedure,public :: call => Fx_call
end type Fx

type,extends(Fx) :: Compose
! private
class(Fx),allocatable :: inner
contains
procedure,public :: call => Compose_call
end type Compose

interface Fx
procedure NewFx
end interface

interface Compose
procedure NewComposeFun
! procedure NewComposeObj
end interface

contains

function NewFx(f)
procedure(fce) :: f
type(Fx) :: NewFx
write(*,*) "allocating Fx", loc(f)
NewFx%f => f
end function NewFx

real(KND) function Fx_call(this,x)
class(Fx),intent(in) :: this
real(KND),intent(in) :: x
print *, "call object Fx"
write(*,*) loc(this%f)
write(*,*) associated(this%f)
Fx_call = this%f(x)
end function Fx_call


function NewComposeFun(f,g)
procedure(fce) :: f,g
type(Compose) :: NewComposeFun
write(*,*) "allocating Composition",loc(f),loc(g)
NewComposeFun%f => f
allocate(NewComposeFun%inner,source= Fx(g))
write(*,*) loc(NewComposeFun%inner%f)
end function NewComposeFun

function NewComposeObj(f,g)
class(Fx) :: f,g
type(Compose) :: NewComposeObj

NewComposeObj%f => f%f
allocate(NewComposeObj%inner, source=g)
end function NewComposeObj

real(KND) function Compose_call(this,x)
class(Compose),intent(in) :: this
real(KND),intent(in) :: x
real(KND) :: y
write(*,*) loc(this%inner)
y=this%inner%call(x)
Compose_call = this%f(y)
end function Compose_call

end module ComposeObj

program Main
use Parameters
use AritmFunctions
use ComposeObj
implicit none

class(Compose),allocatable :: f,g,h,h2

print *, times2(plus1(1._KND))

write(*,*) "loc times2"
write(*,*) loc(times2)
write(*,*) "loc plus1"
write(*,*) loc(plus1)

allocate(h,source= Compose(times2,plus1))

write(*,*) loc(h),loc(h%f),loc(h%inner),loc(h%inner%f)

[Ian Bush]

On 23/02/12 19:26, Erik Toussaint wrote:
> On 23-2-2012 10:46, Vladimír Fuka wrote:
>> program Main
>> use Parameters
>> use AritmFunctions
>> implicit none
>>
>> interface
>> function Compose(f1,f2)
>> procedure(fce) :: f1,f2
>> procedure(fce),pointer :: Compose
>> end function Compose
>> end interface
>
> Side question: why does this interface work without an import statement
> for fce?
> Even if I include an implicit none statement in there, my compiler
> doesn't complain about fce not being declared. I thought an interface
> body formed a separate scoping unit.
>

I must admit that confused me as well, but I'm not up to speed on all
this stuff yet so I assumed it was something that I don't know (yet). So
anybody?

Ian