sub/function as datatype
Re: sub/function as datatype
KeyPgFunctionPtr → fxm [Added an intermediate example]
-
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: sub/function as datatype
Hello,fxm wrote:KeyPgFunctionPtr → fxm [Added an intermediate example]
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>)
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.
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.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.
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.
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.
- 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.
-
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: sub/function as datatype
@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 ;)
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 ;)
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.
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
-
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: sub/function as datatype
Hi dodi,dodicat wrote:An artificial example.
I have put any ptr where a function would do.
not so artificial. As far as I understand correctly this page
https://en.m.wikipedia.org/wiki/Map_(hi ... _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)
Code: Select all
map square [1, 2, 3, 4, 5]
Re: sub/function as datatype
But no myster, the conversion to a typed procedure pointer is done by:dodicat wrote:I have put any ptr where a function would do.
globals.f = fn
Re: sub/function as datatype
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):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?
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)
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)
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
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.
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
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
Re: sub/function as datatype
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.dodicat wrote:I mean skipping the type declaration and inserting a function directly as a parameter.
As perhaps in the thread example
Re: sub/function as datatype
I do not know if I understood your question, but:Tourist Trap wrote:Last thing is pure curiosity, what about dim byref and procedure pointers?
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()
Re: sub/function as datatype
More precisely, what do you mean by that?Tourist Trap wrote:Should this article deal with instance member procedure pointers, or give a link to the topic?
Presently, pointers to member procedures (non static) are not supported by FreeBASIC.
-
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: sub/function as datatype
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 :).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.
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)
Re: sub/function as datatype
My very small personal contribution: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.
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
- Added a 'buildInstance(variableName, instanceName)' macro to simplify the syntax for instance creation from any variable (if type taken into account).
-
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: sub/function as datatype
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:fxm wrote: My very small personal contribution:
...
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
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.