## sub/function as datatype

Forum for discussion about the documentation project.
fxm
Posts: 10051
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: sub/function as datatype

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

### Re: sub/function as datatype

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:
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: 10051
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: sub/function as datatype

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: 2958
Joined: Jun 02, 2015 16:24

### Re: sub/function as datatype

@fxm,

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: 6763
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: sub/function as datatype

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 globalsDim Shared As Integer xres,yresDim Shared As Double minx,maxx,miny,maxy,PLOT_GRADE=5000Dim Shared As Double MinimumY,MaximumYDim Shared As Double MinimumX,MaximumXType fun  As Function(x As Double) As DoubleDim Shared f As funEnd NamespaceSub 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 IfEnd SubSub 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 SubSub 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    NextEnd SubSub 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 #fnPrintFunction f(x As Double) As Double    Return fnEnd Function#endmacro'================   USER INPUT PART ======================Locate 2InputFunction (   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 rangeSleep  `
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

### Re: sub/function as datatype

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

Hi dodi,

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: 10051
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: sub/function as datatype

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: 10051
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: sub/function as datatype

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 TypeSub t0.s0(Byval I As Integer)  Print "s0(Byval As Integer)", IEnd SubType t1 Extends Object  Declare Static Sub s1(Byref S As String, Byval D As Double)End TypeSub t1.s1(Byref S As String, Byval D As Double)  Print "s1(Byref As String, Byval As Double)", S, DEnd SubDim As t0 it0Dim As t1 it1Dim 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 NEnd Subprocedure(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 TypeSub t0.s0(Byval I As Integer)  Print "s0(Byval As Integer)", IEnd SubType t1 Extends Object  Declare Static Sub s1(Byref S As String, Byval D As Double)End TypeSub t1.s1(Byref S As String, Byval D As Double)  Print "s1(Byref As String, Byval As Double)", S, DEnd SubDim As t0 it0Dim As t1 it1Dim As Object Ptr Ptr pobuffer = Callocate(2, Sizeof(Object Ptr))pobuffer = @it0pobuffer = @it1Sub 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 NEnd Subprocedure(pobuffer, 3, "PI", 3.14)Deallocate(pobuffer)`
dodicat
Posts: 6763
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: sub/function as datatype

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 longFunction 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 0End FunctionFunction 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 0End Functiondim as callback FI,FSFI=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 nqsort( @a(Lbound(a)),(Ubound(a)-Lbound(a)+1),Sizeof(a),FI)For n As Integer=1 To 50    Print a(n)Next nPrintDim 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)=sNextqsort( @g(Lbound(g)),(Ubound(g)-Lbound(g)+1),Sizeof(g),FS)For n As Integer=0 To 90    Print g(n)Next nPrintsleep   `
fxm
Posts: 10051
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: sub/function as datatype

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: 10051
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: sub/function as datatype

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 SubSub goodbye()  Print "Goodbye"End SubFunction initProcPtr ( Byref pp As Sub() ) Byref As Sub()  Return ppEnd FunctionDim As Sub() pp = @hellopp()Dim Byref As Sub() rpp = pp( initProcPtr(rpp) ) = @goodbyepp()`
fxm
Posts: 10051
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: sub/function as datatype

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: 2958
Joined: Jun 02, 2015 16:24

### Re: sub/function as datatype

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))#endMacrotype PROCEDUREARGUMENTLISTDESCRIPTOR    declare constructor()    declare constructor(as any ptr, as integer, () as string)        as any ptr  _procedureRawAddress        as integer  _procedureArgumentCount        as string   _arrayOfProcedureArgumentTypeCode(any)end typetype PROCARGDESC as PROCEDUREARGUMENTLISTDESCRIPTORtype PROCEDUREARGUMENTUNIFIEDBUFFER    declare constructor()    declare constructor(as PROCARGDESC ptr)    declare function ComputeBufferSize() as integer        as PROCARGDESC ptr  _procArgDescPtr        as integer          _bufferSize        as uByte ptr        _bufferend typetype 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      F0ArgDescriptordim 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      => 100dim as any ptr      ii_1   => @i_1cast(integer ptr, F1procArgBuffer._buffer) = cast(integer ptr, ii_1)'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      => 200dim as any ptr      ii_2   => @i_2dim as double      d_2      => 3.1422202dim as any ptr      dd_2   => @d_2cast(integer ptr, F2procArgBuffer._buffer) = cast(integer ptr, ii_2)cast(double ptr, F2procArgBuffer._buffer)[sizeOf(i_2) - 1] = cast(double ptr, dd_2)'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      => 200dim as any ptr      ii_3   => @i_3dim as double      d_3      => 6.2833303dim as any ptr      dd_3   => @d_3dim as string      s_3      => "string variable"dim as any ptr      ss_3   => @s_3cast(integer ptr, F3procArgBuffer._buffer) = cast(integer ptr, ii_3)cast(double ptr, F3procArgBuffer._buffer)[sizeOf(i_3) - 1] = cast(double ptr, dd_3)cast(string ptr, F3procArgBuffer._buffer)[sizeOf(d_3) - 1] = cast(string ptr, ss_3)''----------------------------------------------------------------------------------------------'----------------------------------------------------------------------------------------------'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 constructorconstructor PROCARGDESC(RawAddress as any ptr, _                         ArgCount as integer, _                         ArgTypeCodeArray() as string)    THIS._procedureRawAddress       => RawAddress    THIS._procedureArgumentCount    => ArgCount    redim THIS._arrayOfProcedureArgumentTypeCode(1 to ArgCount)end constructorconstructor PROCARGUNIBUFFER()    THIS._procArgDescPtr    => 0    THIS._bufferSize        => 0    THIS._buffer     => 0end constructorconstructor PROCARGUNIBUFFER(ProcArgDescPtr as PROCARGDESC ptr)    THIS._procArgDescPtr    => ProcArgDescPtr    THIS._bufferSize        => THIS.ComputeBufferSize()    THIS._buffer     => _     allocate(THIS._procArgDescPtr->_procedureArgumentCount*THIS._bufferSize)end constructorfunction 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 returnValueend functionsub F0(F0ArgDesc as PROCARGDESC, F0ArgBuffer as PROCARGUNIBUFFER)   ? "F0 call - no arg"end subsub 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)      end select   next index   '   ? "F1 call - arg = ", iend subsub 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)         case 2            d = cast(typeOf(d) ptr, F2ArgBuffer._buffer)[sizeOf(i) - 1]      end select   next index   '   ? "F2 call - arglist = ", i , dend subsub 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)         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, send sub'(eof)`
fxm
Posts: 10051
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: sub/function as datatype

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 ppEnd TypeConstructor ci(Byval p As Integer Ptr)  This.pp = pEnd ConstructorType csvi Extends Object  '' Class for Sub(byVal as Integer)  Declare Constructor(Byval p As Sub(Byval As Integer))  Dim As Sub(Byval As Integer) ppEnd TypeConstructor csvi(Byval p As Sub(Byval As Integer))  This.pp = pEnd ConstructorType 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) ppEnd TypeConstructor csrsvd(Byval p As Sub(Byref As String, Byval As Double))  This.pp = pEnd ConstructorType 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 ppEnd TypeConstructor cfvivs(Byval p As Function(Byval I As Integer) As String)  This.pp = pEnd Constructor  Type cs Extends Object  '' Class for String  Declare Constructor(Byval p As String Ptr)  Dim As String Ptr ppEnd TypeConstructor cs(Byval p As String Ptr)  This.pp = pEnd ConstructorType cpi Extends Object  '' Class for Pointer to Integer  Declare Constructor(Byval p As Integer Ptr Ptr)  Dim As Integer Ptr Ptr ppEnd TypeConstructor cpi(Byval p As Integer Ptr Ptr)  This.pp = pEnd ConstructorType 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 ppEnd TypeConstructor cpsvi(Byval p As Sub(Byval As Integer) Ptr)  This.pp = pEnd ConstructorType 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 ppEnd TypeConstructor cpsrsvd(Byval p As Sub(Byref As String, Byval As Double) Ptr)  This.pp = pEnd ConstructorType fvivs As Function(Byval I As Integer) As StringType 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 ppEnd TypeConstructor cpfvivs(Byval p As fvivs Ptr)  This.pp = pEnd ConstructorType cps Extends Object  '' Class for Pointer to String  Declare Constructor(Byval p As String Ptr Ptr)  Dim As String Ptr Ptr ppEnd TypeConstructor cps(Byval p As String Ptr Ptr)  This.pp = pEnd 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#endmacroDim As Integer I1 = 1Dim As Integer I2 = 2Dim As String S1 = "P"Dim As String S2 = "I"Sub s11(Byval I As Integer)  Print "s11(Byval As Integer)", IEnd SubSub s12(Byval I As Integer)  Print "s12(Byval As Integer)", IEnd SubSub s21(Byref S As String, Byval D As Double)  Print "s21(Byref As String, Byval As Double)", S, DEnd SubSub s22(Byref S As String, Byval D As Double)  Print "s22(Byref As String, Byval As Double)", S, DEnd SubFunction f11(Byval I As Integer) As String  Print "f11() As String",  Return Str(I)End FunctionFunction f12(Byval I As Integer) As String  Print "f12() As String",  Return Str(I)End FunctionDim As Integer Ptr pI1 = @I1Dim As Integer Ptr pI2 = @I2Dim As String Ptr pS1 = @S1Dim As String Ptr pS2 = @S2Dim As Sub(Byval As Integer) ps11 =@s11Dim As Sub(Byref As String, Byval As Double) ps21 = @s21Dim As Function(Byval I As Integer) As String pf11 = @f11Dim As Sub(Byval As Integer) ps12 =@s12Dim As Sub(Byref As String, Byval As Double) ps22 = @s22Dim As Function(Byval I As Integer) As String pf12 = @f12buildInstance(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 NEnd SubanyDatatype(po(), 3, "PI", 3.14)Sleep`

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

### Re: sub/function as datatype

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-readdirectorychangeswvar 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 ..."; hDirdim as FILE_NOTIFY_INFORMATION ptr  fNIptrfNIptr = allocate(SizeOf(FILE_NOTIFY_INFORMATION))dim as LPDWORD  outbufferoutbuffer = allocate(sizeof(DWORD))dim r as integerdo    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 25loop 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.
{"ft_lang_label":"__label__en","ft_lang_prob":0.6675886,"math_prob":0.8497152,"size":33302,"snap":"2021-04-2021-17","text_gpt3_token_len":9337,"char_repetition_ratio":0.16989009,"word_repetition_ratio":0.3063007,"special_character_ratio":0.28004324,"punctuation_ratio":0.117177315,"nsfw_num_words":0,"has_unicode_error":false,"math_prob_llama3":0.9681191,"pos_list":[0],"im_url_duplicate_count":[null],"WARC_HEADER":"{\"WARC-Type\":\"response\",\"WARC-Date\":\"2021-01-22T21:45:02Z\",\"WARC-Record-ID\":\"<urn:uuid:d86dd32f-fdb5-48b7-9b74-92f92237c28f>\",\"Content-Length\":\"92413\",\"Content-Type\":\"application/http; msgtype=response\",\"WARC-Warcinfo-ID\":\"<urn:uuid:3285a005-2792-4235-a955-971d2aaa3755>\",\"WARC-Concurrent-To\":\"<urn:uuid:17bb6fb8-ec57-4d24-91c2-0640b4fda763>\",\"WARC-IP-Address\":\"198.252.100.173\",\"WARC-Target-URI\":\"https://www.freebasic.net/forum/viewtopic.php?f=9&t=26823&start=30\",\"WARC-Payload-Digest\":\"sha1:33L5UBVWI32D2SV4FX6Q7W7KHC6FOLOL\",\"WARC-Block-Digest\":\"sha1:ZN3VUQ5UCMPQ2WUZOZ32XEX6VKHKVCAS\",\"WARC-Identified-Payload-Type\":\"text/html\",\"warc_filename\":\"/cc_download/warc_2021/CC-MAIN-2021-04/CC-MAIN-2021-04_segments_1610703531429.49_warc_CC-MAIN-20210122210653-20210123000653-00500.warc.gz\"}"}