sub/function as datatype

Forum for discussion about the documentation project.
fxm
Posts: 8351
Joined: Apr 22, 2009 12:46
Location: Paris (suburb), FRANCE

Re: sub/function as datatype

Postby fxm » Jul 22, 2018 8:01

KeyPgFunctionPtr → fxm [Added an intermediate example]
Tourist Trap
Posts: 2383
Joined: Jun 02, 2015 16:24

Re: sub/function as datatype

Postby Tourist Trap » Jul 22, 2018 10:41

fxm wrote:KeyPgFunctionPtr → fxm [Added an intermediate example]

Hello,

There is something I would like to share here again on the subject of procedure pointer. It's the sequel of the previous remark about the fact that the procedure pointer is a typed pointer and we can do almost nothing with it in the form of an "any ptr".

We need the full procedure signature to play the role of the type of the pointer. (That the signature becomes a type is by itself a non trivial concept!)

Note that the term signature seems not to be included in the manual's glossary, so this is what I'm talking about:
---> sig=proc_type + proc_name + proc_arguments_list [ + proc_return_type ]

There is probably a better way to define the term of course, but I wanted to reiterate my concern about the 2 problems that occurs if someone wants to use the procedure with the help of only the address:

Code: Select all

cast( proc_signature_as_type, proc_address_as_anyptr)(<proc_args_list>)

We have seen how to deal with proc_signature_as_type, with the help of TYPEOF if we keep a track of the PROCPTR (typed pointer, not an ANY PTR).
But the proc_args_list is somehow complicated to store in a syntactic structure... (I didn't find a macro to do the job, but maybe someone here will ?)

My question here is about the second aspect. Isn't it possible to pass an argument list to a procedure (sub or function), in the form of a unique pointer (a buffer), so that we can unify the syntax required to use the procedure retrieved from its any ptr version?

It's a little technical but it would be very useful I think. Thanks anyway.

- - - - - -
Last minute note:
Should this article deal with instance member procedure pointers, or give a link to the topic?
Last thing is pure curiosity, what about dim byref and procedure pointers?
Those 2 issues have no emergency character for me, it's just a reminder.

coderJeff wrote:, 2 things I most often use function pointers:
1) Call backs, for example, print logging, comparison function (for sorting using generic algorithm), enumerations (my own or like in WINAPI)
2) Interface: a TYPE with several function pointer methods that are initialized when the CONSTRUCTOR is called. For example, a stream-like interface that might work with a file or memory, gets constructed with members pointing to different methods.

Your definition of INTERFACE make it concrete. I don't use c++ and I find vb.net interfaces very strange, probably because I don't understand what they are useful for.

I would add a 3) :
library imported functions. They have there proper syntax in the context of dynamic libraries in fb, but it's the same familly.
fxm
Posts: 8351
Joined: Apr 22, 2009 12:46
Location: Paris (suburb), FRANCE

Re: sub/function as datatype

Postby fxm » Jul 22, 2018 12:24

Commonly, the signature of a procedure includes only:
- the calling convention,
- the number and type of parameters,
- the return type if any.

The "Typeof" contains in addition the procedure type (Sub, Function, ...), the passing types for parameters (Byval, Byref) and also for return if any.
Tourist Trap
Posts: 2383
Joined: Jun 02, 2015 16:24

Re: sub/function as datatype

Postby Tourist Trap » Jul 22, 2018 13:28

@fxm,

hi fxm, in order to get deeper on the topic I read this wikipedia page below,
https://en.m.wikipedia.org/wiki/First-class_function
Mostly got nothing from it really usable (by me) but I noticed that they forgot Freebasic in their language comparison table!!
I'm not able to fill the missing entry myself because I precisely would need it to understand the article :) If you or someone among the experts did the job, it would please me, but above all this is really a missing information that is only justified by the ignorance of the authors of the current version of the wikipedia page. This has to be avenged ;)
dodicat
Posts: 5161
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: sub/function as datatype

Postby dodicat » Jul 22, 2018 13:43

An artificial example.
I have put any ptr where a function would do.
But for fun (some old code pointered up)

Note: I think threading examples are a put off, they are a whole issue on their own.
IMHO only of course.

Code: Select all

 


Namespace globals
Dim Shared As Integer xres,yres
Dim Shared As Double minx,maxx,miny,maxy,PLOT_GRADE=5000
Dim Shared As Double MinimumY,MaximumY
Dim Shared As Double MinimumX,MaximumX
Type fun  As Function(x As Double) As Double
Dim Shared f As fun
End Namespace

Sub sketch(fn As Any Ptr,colour As Ulong,axiscolour As Ulong=Rgb(150,150,150))
    Using globals
    f=fn
    Dim As Double last=f(minx)
    For x As Double=minx To maxx Step (maxx-minx)/PLOT_GRADE
        Dim As Double x1=(xres)*(x-minx)/(maxx-minx)
        Dim As Double d=f(x)
        Dim As Double y1=(yres)*(d-maxy)/(miny-maxy)
        If Sgn(last)<> Sgn(d)  Then Circle(x1,y1),2,0,,,,f
        If x=minx Then Pset(x1,y1),colour Else Line -(x1,y1),colour
        last=d
    Next x
    'axis
    Dim As Long f1,f2
    If Sgn(minx)<>Sgn(maxx) Then
        Line(((minx/(minx-maxx))*xres),0)-(((minx/(minx-maxx))*xres),yres),(axiscolour) 'y axis
        f1=1
        If Sgn(minx)=0 Or Sgn(maxx)=0 Then f1=0
    End If
    If Sgn(miny)<>Sgn(maxy) Then
        Line(0,(yres-(miny/(miny-maxy))*yres))-(xres,(yres-(miny/(miny-maxy))*yres)),(axiscolour) 'x axi
        f2=1
        If Sgn(miny)=0 Or Sgn(maxy)=0 Then f2=0
    End If
   
    If f2 Then
        Draw String(0,(yres-(miny/(miny-maxy))*yres)),Str(minx),(axiscolour)
        Draw String(xres-8-8*(Len(Str(maxx))),(yres-(miny/(miny-maxy))*yres)),Str(maxx),(axiscolour)
    Else
        Draw String(0,yres/2),Str(minx),(axiscolour)
        Draw String(xres-8-8*(Len(Str(maxx))),yres/2),Str(maxx),(axiscolour)
    End If
   
    If f1 Then
        Draw String(((minx/(minx-maxx))*xres),0),Str(maxy),(axiscolour)
        Draw String(((minx/(minx-maxx))*xres),yres-16),Str(miny),(axiscolour)
    Else
        Draw String(xres/2,0),Str(maxy),(axiscolour)
        Draw String(xres/2,yres-16),Str(miny),(axiscolour)
    End If
End Sub

Sub getyrange(fn As Any Ptr,sx As Double,lx As Double,Byref by As Double,Byref sy As Double)
    Using globals
    f=fn
    #macro _window(topleftX,topleftY,bottomrightX,bottomrightY)
    minx=(topleftX)
    maxx=(bottomrightX)
    miny=(bottomrightY)
    maxy=(topleftY)
    #endmacro
    MinimumY=1e50:MaximumY=-1e50
    For n As Double=MinimumX To lx Step(lx-MinimumX)/10000
        Dim As Double v=f(n)
        If MinimumY>V Then MinimumY=v
        If MaximumY<V Then MaximumY=V
    Next
    _window(MinimumX,MaximumY,MaximumX,MinimumY)
End Sub

Sub bisect(fn As Any Ptr,min As Double,max As Double,Byref O As Double)
    Using globals
    f=fn
    Dim As Double last,st=(max-min)/100000,v
    For n As Double=min To max Step st
        v=f(n)
        If Sgn(v)<>Sgn(last) Then
            Print(n);Tab(27);f(n)
            O=n+st:Exit Sub
        End If
        last=v
    Next
End Sub

Sub roots(fn As Any Ptr,min As Double,max As Double)
    Using globals
    f=fn
    MinimumX=min
    MaximumX=max
    Dim As Double last,O,v,st=(max-min)/10000000
    For n As Double=min To max Step st
        v=f(n)
        If Sgn(v)<>Sgn(last) And n>min Then bisect(f,n-st,n,O):n=O
        last=v
    Next
    ''  screen plot optional -- get fn moving
    getyrange(f,MinimumX,MaximumX,MinimumY,MaximumY)
    Screen 19,32
    Color ,Rgb(255,255,255)
    Screeninfo globals.xres,globals.yres
    Screencontrol 100,.4*globals.xres,.4*globals.yres
    Cls
    sketch(f,Rgb(0,100,255))
End Sub

'====================================== 
#include "crt.bi"  '' for hyperbolic functions

#macro InputFunction(fn)
Print #fn
Print
Function f(x As Double) As Double
    Return fn
End Function
#endmacro

'================   USER INPUT PART ======================
Locate 2
InputFunction (   tanh(x)+Sin(x^2)-Exp(x)+Cos(3*x)+2  ) '<---- write your function(x) inside the brackets.
Print "ROOTS -if any";Tab(27);"ROOT error value"

roots(Procptr(f),-6,2)     ' Please note: catches roots AND discontinuaties in the given x range

Sleep
 
Tourist Trap
Posts: 2383
Joined: Jun 02, 2015 16:24

Re: sub/function as datatype

Postby Tourist Trap » Jul 22, 2018 13:55

dodicat wrote:An artificial example.
I have put any ptr where a function would do.

Hi dodi,

not so artificial. As far as I understand correctly this page
https://en.m.wikipedia.org/wiki/Map_(hi ... r_function)
you show us here how to implement a "map". And an anonymous like. According to the Wikipedia this is advanced feature that one may find or not in the language. Here we have to conclude, it's feasible in fb thanks to the power of macros and procedure pointers (and to the artist that melts the both!).

dodi:

Code: Select all

 roots(Procptr(f),-6,2)
 

wiki:

Code: Select all

 map square [1, 2, 3, 4, 5]
fxm
Posts: 8351
Joined: Apr 22, 2009 12:46
Location: Paris (suburb), FRANCE

Re: sub/function as datatype

Postby fxm » Jul 22, 2018 14:30

dodicat wrote:I have put any ptr where a function would do.

But no myster, the conversion to a typed procedure pointer is done by:
globals.f = fn
fxm
Posts: 8351
Joined: Apr 22, 2009 12:46
Location: Paris (suburb), FRANCE

Re: sub/function as datatype

Postby fxm » Jul 22, 2018 16:23

Tourist Trap wrote:My question here is about the second aspect. Isn't it possible to pass an argument list to a procedure (sub or function), in the form of a unique pointer (a buffer), so that we can unify the syntax required to use the procedure retrieved from its any ptr version?

A twisted solution, using an OBJET PTR array, and the RTTI capability to retrieve the real type of object (among those derived from OBJECT) and thus the associated static procedure (but no procedure pointer usage):

Code: Select all

Type t0 Extends Object
  Declare Static Sub s0(Byval I As Integer)
End Type
Sub t0.s0(Byval I As Integer)
  Print "s0(Byval As Integer)", I
End Sub

Type t1 Extends Object
  Declare Static Sub s1(Byref S As String, Byval D As Double)
End Type
Sub t1.s1(Byref S As String, Byval D As Double)
  Print "s1(Byref As String, Byval As Double)", S, D
End Sub

Dim As t0 it0
Dim As t1 it1

Dim As Object Ptr po(...) = {@it0, @it1}

Sub procedure(p() As Object Ptr, Byval I As Integer, Byref S As String, Byval D As Double)
  For N As Integer = Lbound(p) To Ubound(p)
    Print N & ":",
    If *p(N) Is t0 Then
      t0.s0(I)
    Elseif *p(N) Is t1 Then
      t1.s1(S, D)
    End If
  Next N
End Sub

procedure(po(), 3, "PI", 3.14)

Similar example using an Object Ptr buffer:

Code: Select all

Type t0 Extends Object
  Declare Static Sub s0(Byval I As Integer)
End Type
Sub t0.s0(Byval I As Integer)
  Print "s0(Byval As Integer)", I
End Sub

Type t1 Extends Object
  Declare Static Sub s1(Byref S As String, Byval D As Double)
End Type
Sub t1.s1(Byref S As String, Byval D As Double)
  Print "s1(Byref As String, Byval As Double)", S, D
End Sub

Dim As t0 it0
Dim As t1 it1

Dim As Object Ptr Ptr pobuffer = Callocate(2, Sizeof(Object Ptr))
pobuffer[0] = @it0
pobuffer[1] = @it1

Sub procedure(Byval p As Object Ptr Ptr, Byval I As Integer, Byref S As String, Byval D As Double)
  For N As Integer = 0 To 1
    Print N & ":",
    If *p[N] Is t0 Then
      t0.s0(I)
    Elseif *p[N] Is t1 Then
      t1.s1(S, D)
    End If
  Next N
End Sub

procedure(pobuffer, 3, "PI", 3.14)

Deallocate(pobuffer)
dodicat
Posts: 5161
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: sub/function as datatype

Postby dodicat » Jul 22, 2018 16:31

I mean skipping the type declaration and inserting a function directly as a parameter.
As perhaps in the thread example

Code: Select all

 

'' thread Sub definition
  Sub threadInkey (callback As Function (ByRef As String) As Integer )
    If  callback  Then                                                '' test condition callback Function defined
     ' Dim As Function (ByRef As String) As Integer callback = p  '' convert the any ptr to a callback Function pointer
      Do
        Dim As String s = Inkey
        If s <> "" Then                                          '' test condition key pressed
          If callback(s) Then                                    '' test condition to finish thread
            Exit Do
          End If
        End If
        Sleep 50
      Loop
    End If
  End Sub

'' user callback Function definition
  Function printInkey (ByRef s As String) As Integer
    If Asc(s) = 27 Then                                        '' test condition key pressed = <escape>
      Print
      Return -1                                                '' order thread to finish
    Else
      Print s;
      Return 0                                                 '' order thread to continue
    End If
  End Function

'' user main code
  Dim As Any Ptr p = ThreadCreate(cast(any ptr,@threadInkey), @printInkey)   '' launch the thread, passing the callback Function address
  ThreadWait(p)                                                '' wait for the thread finish 


And the parameter 1 for my four procedures would be
f As Function(x As Double) As Double
with no f=fn or global type fun or f necessary.

Generally the word callback is a bit confusing. I think.
Is it not simply calling one function from another, by pointer or by name.

The C runtime sort for example uses a callback function via a pointer, as the WinApi
C sort:
The method is hidden in the dll of course in the C case.

Code: Select all



#include "crt.bi"
Type callback  As Function cdecl(As Any Ptr,As Any Ptr) As long

Function CallBackinteger Cdecl(n1 As Any Ptr,n2 As Any Ptr) As long
    If *Cptr(Integer Ptr,n1) < *Cptr(Integer Ptr,n2) Then Return -1
    If *Cptr(Integer Ptr,n1) > *Cptr(Integer Ptr,n2) Then Return 1
    Return 0
End Function


Function CallBackString Cdecl(n1 As Any Ptr,n2 As Any Ptr) As long
    If *Cptr(String Ptr,n1) > *Cptr(String Ptr,n2) Then Return -1
    If *Cptr(String Ptr,n1) < *Cptr(String Ptr,n2) Then Return 1
    Return 0
End Function

dim as callback FI,FS
FI=procptr(CallBackinteger)
FS=procptr(CallBackstring)

Dim  As Integer a(1 To 50)

For n As Integer=1 To 50
    a(n)= Int(Rnd * 10000)
Next n

qsort( @a(Lbound(a)),(Ubound(a)-Lbound(a)+1),Sizeof(a),FI)

For n As Integer=1 To 50
    Print a(n)
Next n
Print


Dim As String s="ABCD"
Dim As String g(90)
For n As Integer=0 To 90
    Swap s[Rnd*(Len(s)-1)],s[Rnd*(Len(s)-1)]
    g(n)=s
Next

qsort( @g(Lbound(g)),(Ubound(g)-Lbound(g)+1),Sizeof(g),FS)

For n As Integer=0 To 90
    Print g(n)
Next n
Print
sleep


   
fxm
Posts: 8351
Joined: Apr 22, 2009 12:46
Location: Paris (suburb), FRANCE

Re: sub/function as datatype

Postby fxm » Jul 22, 2018 17:50

dodicat wrote:I mean skipping the type declaration and inserting a function directly as a parameter.
As perhaps in the thread example

I suppose that passing an any ptr to Threadcreate(), instead of a typed SUB pointer with the requested signature ('Sub (Byval As Any Ptr)'), disables the compiler signature test, but this lax behavior is not specified and can change as well in future compiler releases.
fxm
Posts: 8351
Joined: Apr 22, 2009 12:46
Location: Paris (suburb), FRANCE

Re: sub/function as datatype

Postby fxm » Jul 22, 2018 19:22

Tourist Trap wrote:Last thing is pure curiosity, what about dim byref and procedure pointers?

I do not know if I understood your question, but:
Like any other pointer, a procedure pointer can be passed or returned by reference, and one can also create a reference to a procedure pointer.

Code: Select all

Sub hello()
  Print "Hello"
End Sub

Sub goodbye()
  Print "Goodbye"
End Sub

Function initProcPtr ( Byref pp As Sub() ) Byref As Sub()
  Return pp
End Function


Dim As Sub() pp = @hello
pp()

Dim Byref As Sub() rpp = pp
( initProcPtr(rpp) ) = @goodbye
pp()
fxm
Posts: 8351
Joined: Apr 22, 2009 12:46
Location: Paris (suburb), FRANCE

Re: sub/function as datatype

Postby fxm » Jul 22, 2018 19:32

Tourist Trap wrote:Should this article deal with instance member procedure pointers, or give a link to the topic?

More precisely, what do you mean by that?
Presently, pointers to member procedures (non static) are not supported by FreeBASIC.
Tourist Trap
Posts: 2383
Joined: Jun 02, 2015 16:24

Re: sub/function as datatype

Postby Tourist Trap » Jul 22, 2018 20:10

fxm wrote:Like any other pointer, a procedure pointer can be passed or returned by reference, and one can also create a reference to a procedure pointer.

Thanks. Overall, my questions are answered right now. There is still things to be clarified but I would have to test many things before - but already learnt good stuff today anyway :).

My 2 cents contribution to an attempt to get rid of the necessity to know by advance the procedure signature before using it when hidden in a pointer variable. Far from satisfying and very artificial , I think we will need the ability to treat a type as variable like the others some day. At least it's my temporary conclusion.

Code: Select all

 'attempt to standardize a procedure-pointer's storage that can be evaluated in
'a way where knowing the procedure signature is a minor burden for the user

'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

#macro _ADDPROCPTRTOARRAY(ProcArrayName, ProcIndex, ProcName)
    redim preserve ProcArrayName(lBound(ProcArrayName) to uBound(ProcArrayName) + 1)
    #undef ProcArrayName##ProcIndex
    var ProcArrayName##ProcIndex = procPtr(ProcName)
    ProcArrayName(ProcIndex) = ProcArrayName##ProcIndex
#endMacro
#macro _CALLPROCARRAYATINDEX(ProcArrayName, ProcIndex)
    cast(typeOf(ProcArrayName##ProcIndex), ProcArrayName(ProcIndex))
#endMacro

type PROCEDUREARGUMENTLISTDESCRIPTOR
    declare constructor()
    declare constructor(as any ptr, as integer, () as string)

        as any ptr  _procedureRawAddress
        as integer  _procedureArgumentCount
        as string   _arrayOfProcedureArgumentTypeCode(any)
end type
type PROCARGDESC as PROCEDUREARGUMENTLISTDESCRIPTOR

type PROCEDUREARGUMENTUNIFIEDBUFFER
    declare constructor()
    declare constructor(as PROCARGDESC ptr)
    declare function ComputeBufferSize() as integer

        as PROCARGDESC ptr  _procArgDescPtr
        as integer          _bufferSize
        as uByte ptr        _buffer
end type
type PROCARGUNIBUFFER as PROCEDUREARGUMENTUNIFIEDBUFFER

'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

declare sub F0( as PROCARGDESC,  as PROCARGUNIBUFFER)
declare sub F1( as PROCARGDESC,  as PROCARGUNIBUFFER)
declare sub F2( as PROCARGDESC,  as PROCARGUNIBUFFER)
declare sub F3( as PROCARGDESC,  as PROCARGUNIBUFFER)

'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

dim as any ptr procArray(any)
_ADDPROCPTRTOARRAY(procArray, 0, F0)
_ADDPROCPTRTOARRAY(procArray, 1, F1)
_ADDPROCPTRTOARRAY(procArray, 2, F2)
_ADDPROCPTRTOARRAY(procArray, 3, F3)


dim as PROCARGDESC      F0ArgDescriptor
dim as PROCARGUNIBUFFER   F0procArgBuffer
'
dim as string         F1arrayOfProcedureArgumentTypeName(1)
F1arrayOfProcedureArgumentTypeName(1)   => "integer"
dim as PROCARGDESC      F1ArgDescriptor   => _
                  PROCARGDESC(procArray(1), 1, F1arrayOfProcedureArgumentTypeName())
dim as PROCARGUNIBUFFER   F1procArgBuffer => PROCARGUNIBUFFER(@F1ArgDescriptor)
dim as integer      i_1      => 100
dim as any ptr      ii_1   => @i_1
cast(integer ptr, F1procArgBuffer._buffer)[0] = cast(integer ptr, ii_1)[0]
'
dim as string         F2arrayOfProcedureArgumentTypeName(2)
F2arrayOfProcedureArgumentTypeName(1)   => "integer"
F2arrayOfProcedureArgumentTypeName(2)   => "double"
dim as PROCARGDESC      F2ArgDescriptor => _
                  PROCARGDESC(procArray(2), 2, F2arrayOfProcedureArgumentTypeName())
dim as PROCARGUNIBUFFER   F2procArgBuffer => PROCARGUNIBUFFER(@F2ArgDescriptor)
dim as integer      i_2      => 200
dim as any ptr      ii_2   => @i_2
dim as double      d_2      => 3.1422202
dim as any ptr      dd_2   => @d_2
cast(integer ptr, F2procArgBuffer._buffer)[0] = cast(integer ptr, ii_2)[0]
cast(double ptr, F2procArgBuffer._buffer)[sizeOf(i_2) - 1] = cast(double ptr, dd_2)[0]
'
dim as string         F3arrayOfProcedureArgumentTypeName(3)
F3arrayOfProcedureArgumentTypeName(1)   => "integer"
F3arrayOfProcedureArgumentTypeName(2)   => "double"
F3arrayOfProcedureArgumentTypeName(3)   => "string"
dim as PROCARGDESC      F3ArgDescriptor => _
                  PROCARGDESC(procArray(3), 3, F3arrayOfProcedureArgumentTypeName())
dim as PROCARGUNIBUFFER   F3procArgBuffer => PROCARGUNIBUFFER(@F3ArgDescriptor)
dim as integer      i_3      => 200
dim as any ptr      ii_3   => @i_3
dim as double      d_3      => 6.2833303
dim as any ptr      dd_3   => @d_3
dim as string      s_3      => "string variable"
dim as any ptr      ss_3   => @s_3
cast(integer ptr, F3procArgBuffer._buffer)[0] = cast(integer ptr, ii_3)[0]
cast(double ptr, F3procArgBuffer._buffer)[sizeOf(i_3) - 1] = cast(double ptr, dd_3)[0]
cast(string ptr, F3procArgBuffer._buffer)[sizeOf(d_3) - 1] = cast(string ptr, ss_3)[0]
'

'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
'MAIN RESULT:

_CALLPROCARRAYATINDEX(procArray, 0)(F0ArgDescriptor, F0procArgBuffer)
_CALLPROCARRAYATINDEX(procArray, 1)(F1ArgDescriptor, F1procArgBuffer)
_CALLPROCARRAYATINDEX(procArray, 2)(F2ArgDescriptor, F2procArgBuffer)
_CALLPROCARRAYATINDEX(procArray, 3)(F3ArgDescriptor, F3procArgBuffer)


getKey()
end

'---------------------------------------------IMPLEMENTATIONS----------------------------------
constructor PROCARGDESC()
    THIS._procedureRawAddress       => 0
    THIS._procedureArgumentCount    => 0
    erase(THIS._arrayOfProcedureArgumentTypeCode)
end constructor
constructor PROCARGDESC(RawAddress as any ptr, _
                        ArgCount as integer, _
                        ArgTypeCodeArray() as string)
    THIS._procedureRawAddress       => RawAddress
    THIS._procedureArgumentCount    => ArgCount
    redim THIS._arrayOfProcedureArgumentTypeCode(1 to ArgCount)
end constructor


constructor PROCARGUNIBUFFER()
    THIS._procArgDescPtr    => 0
    THIS._bufferSize        => 0
    THIS._buffer     => 0
end constructor
constructor PROCARGUNIBUFFER(ProcArgDescPtr as PROCARGDESC ptr)
    THIS._procArgDescPtr    => ProcArgDescPtr
    THIS._bufferSize        => THIS.ComputeBufferSize()
    THIS._buffer     => _
    allocate(THIS._procArgDescPtr->_procedureArgumentCount*THIS._bufferSize)
end constructor
function PROCARGUNIBUFFER.ComputeBufferSize() as integer
    var argTotalCount => THIS._procArgDescPtr->_procedureArgumentCount
    #ifndef _ArrayOfProcArgType
    #define _ArrayOfProcArgType THIS._procArgDescPtr->_arrayOfProcedureArgumentTypeCode
    #endIf
    dim as integer returnValue => 0
    for index as integer = 1 to argTotalCount
        returnValue += sizeOf(_ArrayOfProcArgType(index))
    next index
    #undef _ArrayOfProcArgType
    '
    return returnValue
end function


sub F0(F0ArgDesc as PROCARGDESC, F0ArgBuffer as PROCARGUNIBUFFER)
   ? "F0 call - no arg"
end sub
sub F1(F1ArgDesc as PROCARGDESC, F1ArgBuffer as PROCARGUNIBUFFER)
   dim i as integer
   for index as integer = lBound(F1ArgDesc._arrayOfProcedureArgumentTypeCode) to _
                     uBound(F1ArgDesc._arrayOfProcedureArgumentTypeCode)
      select case index
         case 1
            i = cast(typeOf(i) ptr, F1ArgBuffer._buffer)[0]
      end select
   next index
   '
   ? "F1 call - arg = ", i
end sub
sub F2(F2ArgDesc as PROCARGDESC, F2ArgBuffer as PROCARGUNIBUFFER)
   dim i as integer
   dim d as double
   for index as integer = lBound(F2ArgDesc._arrayOfProcedureArgumentTypeCode) to _
                     uBound(F2ArgDesc._arrayOfProcedureArgumentTypeCode)
      select case index
         case 1
            i = cast(typeOf(i) ptr, F2ArgBuffer._buffer)[0]
         case 2
            d = cast(typeOf(d) ptr, F2ArgBuffer._buffer)[sizeOf(i) - 1]
      end select
   next index
   '
   ? "F2 call - arglist = ", i , d
end sub
sub F3(F3ArgDesc as PROCARGDESC, F3ArgBuffer as PROCARGUNIBUFFER)
   dim i as integer
   dim d as double
   dim s as string
   for index as integer = lBound(F3ArgDesc._arrayOfProcedureArgumentTypeCode) to _
                     uBound(F3ArgDesc._arrayOfProcedureArgumentTypeCode)
      select case index
         case 1
            i = cast(typeOf(i) ptr, F3ArgBuffer._buffer)[0]
         case 2
            d = cast(typeOf(d) ptr, F3ArgBuffer._buffer)[sizeOf(i) - 1]
         case 3
            s = cast(typeOf(s) ptr, F3ArgBuffer._buffer)[sizeOf(i) + sizeOf(d) - 1]
      end select
   next index
   '
   ? "F3 call - arglist = ", i, d, s
end sub

'(eof)
fxm
Posts: 8351
Joined: Apr 22, 2009 12:46
Location: Paris (suburb), FRANCE

Re: sub/function as datatype

Postby fxm » Jul 25, 2018 6:39

Tourist Trap wrote:My 2 cents contribution to an attempt to get rid of the necessity to know by advance the procedure signature before using it when hidden in a pointer variable.

My very small personal contribution:

Code: Select all

' Classes of datatypes (derived from Object):
'    - Each class contains a datatyped pointer, initialized to the variable address at instance construction.
'    - 10 datatypes are taken into account in this examples, including:
'       - Integer,
'       - String,
'       - Sub(byVal as Integer),
'       - Sub(byRef as String, byVal as Double),
'       - Function(Byval As Integer) (byVal) as String
'       - Pointer to Integer,
'       - Pointer to String,
'       - Pointer to Sub(byVal as Integer),
'       - Pointer to Sub(byRef as String, byVal as Double),
'       - Pointer to Function(Byval As Integer) (byVal) as String
'    - 20 variables are tested, using the 10 datatypes.
'    - For each variable, an instance of matching class is created (a macro simplifies the creation syntax).
'    - The 20 instances are passed to a Sub by means of an array of Object pointers to instances.
'    - Using the Is (RTTI) keyword, the real datatype of each variable is recovered from its Object pointer.


Type ci Extends Object  '' Class for Integer
  Declare Constructor(Byval p As Integer Ptr)
  Dim As Integer Ptr pp
End Type
Constructor ci(Byval p As Integer Ptr)
  This.pp = p
End Constructor

Type csvi Extends Object  '' Class for Sub(byVal as Integer)
  Declare Constructor(Byval p As Sub(Byval As Integer))
  Dim As Sub(Byval As Integer) pp
End Type
Constructor csvi(Byval p As Sub(Byval As Integer))
  This.pp = p
End Constructor

Type csrsvd Extends Object  '' Class for Sub(byRef as String, byVal as Double)
  Declare Constructor(Byval p As Sub(Byref As String, Byval As Double))
  Dim As Sub(Byref As String, Byval As Double) pp
End Type
Constructor csrsvd(Byval p As Sub(Byref As String, Byval As Double))
  This.pp = p
End Constructor

Type cfvivs Extends Object  '' Class for Function(Byval As Integer) (byVal) as String
  Declare Constructor(Byval p As Function(Byval I As Integer) As String)
  Dim As Function(Byval I As Integer) As String pp
End Type
Constructor cfvivs(Byval p As Function(Byval I As Integer) As String)
  This.pp = p
End Constructor
 
Type cs Extends Object  '' Class for String
  Declare Constructor(Byval p As String Ptr)
  Dim As String Ptr pp
End Type
Constructor cs(Byval p As String Ptr)
  This.pp = p
End Constructor

Type cpi Extends Object  '' Class for Pointer to Integer
  Declare Constructor(Byval p As Integer Ptr Ptr)
  Dim As Integer Ptr Ptr pp
End Type
Constructor cpi(Byval p As Integer Ptr Ptr)
  This.pp = p
End Constructor

Type cpsvi Extends Object  '' Class for Pointer to Sub(byVal as Integer)
  Declare Constructor(Byval p As Sub(Byval As Integer) Ptr)
  Dim As Sub(Byval As Integer) Ptr pp
End Type
Constructor cpsvi(Byval p As Sub(Byval As Integer) Ptr)
  This.pp = p
End Constructor

Type cpsrsvd Extends Object  '' Class for Pointer to Sub(byRef as String, byVal as Double)
  Declare Constructor(Byval p As Sub(Byref As String, Byval As Double) Ptr)
  Dim As Sub(Byref As String, Byval As Double) Ptr pp
End Type
Constructor cpsrsvd(Byval p As Sub(Byref As String, Byval As Double) Ptr)
  This.pp = p
End Constructor

Type fvivs As Function(Byval I As Integer) As String
Type cpfvivs Extends Object  '' Class for Pointer to Function(Byval As Integer) (byVal) as String
  Declare Constructor(Byval p As fvivs Ptr)
  Dim As fvivs Ptr pp
End Type
Constructor cpfvivs(Byval p As fvivs Ptr)
  This.pp = p
End Constructor

Type cps Extends Object  '' Class for Pointer to String
  Declare Constructor(Byval p As String Ptr Ptr)
  Dim As String Ptr Ptr pp
End Type
Constructor cps(Byval p As String Ptr Ptr)
  This.pp = p
End Constructor

#macro buildInstance(variableName, instanceName)
  #if Typeof(@##variableName) = Typeof(ci(0).pp)
    Dim As ci instanceName = @##variableName
  #endif
  #if Typeof(@##variableName) = Typeof(csvi(0).pp)
    Dim As csvi instanceName = @##variableName
  #endif
  #if Typeof(@##variableName) = Typeof(csrsvd(0).pp)
    Dim As csrsvd instanceName = @##variableName
  #endif
  #if Typeof(@##variableName) = Typeof(cfvivs(0).pp)
    Dim As cfvivs instanceName = @##variableName
  #endif
  #if Typeof(@##variableName) = Typeof(cs(0).pp)
    Dim As cs instanceName = @##variableName
  #endif
  #if Typeof(@##variableName) = Typeof(cpi(0).pp)
    Dim As cpi instanceName = @##variableName
  #endif
  #if Typeof(@##variableName) = Typeof(cpsvi(0).pp)
    Dim As cpsvi instanceName = @##variableName
  #endif
  #if Typeof(@##variableName) = Typeof(cpsrsvd(0).pp)
    Dim As cpsrsvd instanceName = @##variableName
  #endif
  #if Typeof(@##variableName) = Typeof(cpfvivs(0).pp)
    Dim As cpfvivs instanceName = @##variableName
  #endif
  #if Typeof(@##variableName) = Typeof(cps(0).pp)
    Dim As cps instanceName = @##variableName
  #endif
#endmacro


Dim As Integer I1 = 1
Dim As Integer I2 = 2

Dim As String S1 = "P"
Dim As String S2 = "I"

Sub s11(Byval I As Integer)
  Print "s11(Byval As Integer)", I
End Sub

Sub s12(Byval I As Integer)
  Print "s12(Byval As Integer)", I
End Sub

Sub s21(Byref S As String, Byval D As Double)
  Print "s21(Byref As String, Byval As Double)", S, D
End Sub

Sub s22(Byref S As String, Byval D As Double)
  Print "s22(Byref As String, Byval As Double)", S, D
End Sub

Function f11(Byval I As Integer) As String
  Print "f11() As String",
  Return Str(I)
End Function

Function f12(Byval I As Integer) As String
  Print "f12() As String",
  Return Str(I)
End Function

Dim As Integer Ptr pI1 = @I1
Dim As Integer Ptr pI2 = @I2

Dim As String Ptr pS1 = @S1
Dim As String Ptr pS2 = @S2

Dim As Sub(Byval As Integer) ps11 =@s11

Dim As Sub(Byref As String, Byval As Double) ps21 = @s21

Dim As Function(Byval I As Integer) As String pf11 = @f11

Dim As Sub(Byval As Integer) ps12 =@s12

Dim As Sub(Byref As String, Byval As Double) ps22 = @s22

Dim As Function(Byval I As Integer) As String pf12 = @f12


buildInstance(I1, it01)
buildInstance(s11, it11)
buildInstance(s21, it21)
buildInstance(f11, it31)
buildInstance(S1, it41)
buildInstance(I2, it02)
buildInstance(s12, it12)
buildInstance(s22, it22)
buildInstance(f12, it32)
buildInstance(S2, it42)
buildInstance(pI1, pit01)
buildInstance(ps11, pit11)
buildInstance(ps21, pit21)
buildInstance(pf11, pit31)
buildInstance(pS1, pit41)
buildInstance(pI2, pit02)
buildInstance(pS12, pit12)
buildInstance(pS22, pit22)
buildInstance(pf12, pit32)
buildInstance(pS2, pit42)


Dim As Object Ptr po(...) = {@it01, @it11, @it21, @it31, @it41, @it02, @it12, @it22, @it32, @it42, _
                             @pit01, @pit11, @pit21, @pit31, @pit41, @pit02, @pit12, @pit22, @pit32, @pit42}


Sub anyDatatype(p() As Object Ptr, Byval I As Integer, Byref S As String, Byval D As Double)
  For N As Integer = Lbound(p) To Ubound(p)
    Print N & ":",
    If *p(N) Is ci Then
      Print *Cptr(ci Ptr, p(N))->pp
    Elseif *p(N) Is cs Then
      Print *Cptr(cs Ptr, p(N))->pp
    Elseif *p(N) Is csvi Then
      Cptr(csvi Ptr, p(N))->pp(I)
    Elseif *p(N) Is csrsvd Then
      Cptr(csrsvd Ptr, p(N))->pp(S, D)
    Elseif *p(N) Is cfvivs Then
      Print Cptr(cfvivs Ptr, p(N))->pp(I)
    Elseif *p(N) Is cpi Then
      Print **Cptr(cpi Ptr, p(N))->pp
    Elseif *p(N) Is cps Then
      Print **Cptr(cps Ptr, p(N))->pp
    Elseif *p(N) Is cpsvi Then
      *Cptr(cpsvi Ptr, p(N))->pp(I)
    Elseif *p(N) Is cpsrsvd Then
      *Cptr(cpsrsvd Ptr, p(N))->pp(S, D)
    Elseif *p(N) Is cpfvivs Then
      Print *Cptr(cpfvivs Ptr, p(N))->pp(I)
    End If
  Next N
End Sub

anyDatatype(po(), 3, "PI", 3.14)

Sleep


[edit]
- Added a 'buildInstance(variableName, instanceName)' macro to simplify the syntax for instance creation from any variable (if type taken into account).
Tourist Trap
Posts: 2383
Joined: Jun 02, 2015 16:24

Re: sub/function as datatype

Postby Tourist Trap » Jul 28, 2018 19:06

fxm wrote:My very small personal contribution:

...

Hi fxm. It's quite a powerful implementation of type resolution at runtime, which is a great thing that is quite tricky for the beginner in fb current version. Unfortunately I can't play with it at the moment. I have a real life question that is related to callbacks in this example:

Code: Select all

 'this example would be useful to poll a change from inside a folder
'but would require its async version in order to be really useful -> implies callback

#include "windows.bi"

'https://docs.microsoft.com/fr-fr/windows/desktop/api/winbase/nf-winbase-readdirectorychangesw

var hDir = CreateFile ( _
    "D:\Temp\WATCHTEST",_   'enter a directory here
    GENERIC_READ, _
    FILE_SHARE_READ + FILE_SHARE_WRITE + FILE_SHARE_DELETE, _
    NULL, _
    OPEN_EXISTING, _
    FILE_FLAG_BACKUP_SEMANTICS, _
    NULL _
)

? "watching dir num ..."; hDir

dim as FILE_NOTIFY_INFORMATION ptr  fNIptr
fNIptr = allocate(SizeOf(FILE_NOTIFY_INFORMATION))

dim as LPDWORD  outbuffer
outbuffer = allocate(sizeof(DWORD))

dim r as integer
do
    r = ReadDirectoryChangesW( _
      hDir, _
      fNIptr, _ 'LPVOID lpBuffer :: pointer to a FILE_NOTIFY_INFORMATION, _
      sizeOf(fNIptr), _ 'DWORD nBufferLength, _
      0, _ 'BOOL bWatchSubtree, _
      FILE_NOTIFY_CHANGE_FILE_NAME, _ 'DWORD dwNotifyFilter, _
      outbuffer, _ 'LPDWORD lpBytesReturned, _
      0, _ 'LPOVERLAPPED lpOverlapped, _
      0 _ 'LPOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine _
    )
   
    ? r 'this shows nothing because we are not in the insynchronous case, which would require callback
    sleep 25
loop until r<>0 or inkey()=chr(27)

? "you created or deleted a file in the folder"

sleep

To run this code , create a test directory and put the path of it in the code (in the 1st function).
The problem here is that I fail to add the last arguments related to asynchronous call, with a callback.
If someone knew how this has to be done it would be really interesting. Moreover this stuff is very useful if used asynchronously.

Thanks anyone if any hint given here.

Return to “Documentation”

Who is online

Users browsing this forum: No registered users and 0 guests