New array features

[speedfixer]

I like the syntax. Similar to the direct graphics functions. At this point, a programmer should expect and accept a slightly steeper learning curve. This isn't vanilla BASIC anymore.

doesn´t mean you could return an array

Just pass the pointer to the array as the result. Declare your UDT common shared in the inclusion, and its pointer.
Suffer the 'redim preserved' time hit when it happens, and reassign the pointer.

Not to beat a dead horse, but troubleshooting with a macro involved is painful.

david

[gothon]

1.) as is - add it as include file (definitions and run time code in array.bi). The features are available only, if array.bi is included. This makes everything acessible to the user.

I prefer option #1, as the features you are seeking seem appropriate to place in a new library separate from the compiler and its run time library.

Some more thoughts about this topic:

Exposing the array descriptor to the user would mean, that future changes of this descriptor might break user code relying on it. Fxm´s definition is correct, as far as i can tell, but it´s an undocumented and unofficial feature and thus subject to change. There are still some problems with arrays in FB in general, e.g. you can REDIM a fixed size array passed as a procedure parameter, this shouldn´t be possible and raise a compiler error, but currently the array descriptor doesn´t tell us, if an array is of fixed size or dynamic.

Therefore i think, it would be a wiser decision not to expose the descriptor itself, but to supply a method of retrieving it´s content (as far as not available yet). This way possible future changes of the descriptor will not necessarily break user code based on these new methods.


JK

I have taken a peek at source code for the array descriptor in the rtlib: https://github.com/freebasic/fbc/blob/master/src/rtlib/fb_array.h
It would seem the critical members are the pointer to the data and the element size member.

When a n-dimension array is defined, the address of the data section is get by:
@array(Lbound(array, 1), Lbound(array, 2), ..., Lbound(array, n))

For an erased dynamic array:
@array(Lbound(array, 1), Lbound(array, 2), ..., Lbound(array, n))
is still valid, corresponding to:
@array(0, 0, ..., 0)
but it returns 0.
(all other index values inducing a runtime error).

The data pointer 'ptr' can be obtained with the code provided by fxm, and the element size can be obtained by using the SizeOf() operator on the same element. The rest of the descriptor values can then be computed using these values and additional information obtainable from UBound() and LBound(). There are two difficulties with this. One is that the syntax for accessing the first element depends on the number of dimensions. The other is that there is no way for a function to accept an array as a parameter without knowing its whole data type. We can however use a macro such as the following:

Code: Select all

Type FBARRAY_DIM
    elements As UInteger
    _lbound As Integer
    _ubound As Integer
End Type

Type FBARRAY_DESC
    _data As Any Ptr
    _ptr As Any Ptr
    size As UInteger
    element_len As UInteger
    dimensions As UInteger
    dimTB(7) As FBARRAY_DIM
End Type

#Macro GenArrayDesc(DESC, ARRAY)
    #If UBound(ARRAY, 0) = 1
        #Define FIRST_ELEMENT LBound(ARRAY)
    #ElseIf UBound(ARRAY, 0) = 2
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2)
    #ElseIf UBound(ARRAY, 0) = 3
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3)
    #ElseIf UBound(ARRAY, 0) = 4
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4)
    #ElseIf UBound(ARRAY, 0) = 5
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5)
    #ElseIf UBound(ARRAY, 0) = 6
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6)
    #ElseIf UBound(ARRAY, 0) = 7
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6), LBound(ARRAY, 7)
    #ElseIf UBound(ARRAY, 0) = 8
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6), LBound(ARRAY, 7), LBound(ARRAY, 8)
    #EndIf
   
    (DESC)._ptr = @(ARRAY(FIRST_ELEMENT))
    (DESC).element_len = SizeOf(ARRAY(FIRST_ELEMENT))
    (DESC).dimensions = UBound(ARRAY, 0)
       
    Scope
        Var TotalElements = 1, Diff = 0
        For I As Integer = 0 To (DESC).dimensions - 1
            (DESC).dimTB(I)._lbound = LBound(ARRAY, I + 1)
            (DESC).dimTB(I)._ubound = UBound(ARRAY, I + 1)
            (DESC).dimTB(I).elements = (DESC).dimTB(I)._ubound - (DESC).dimTB(I)._lbound + 1
            TotalElements *= (DESC).dimTB(I).elements
            Diff = Diff * (DESC).dimTB(I).elements + (DESC).dimTB(I)._lbound
        Next I
       
        (DESC)._data = CPtr(UByte Ptr, (DESC)._ptr) - Diff * (DESC).element_len
        (DESC).size = TotalElements * (DESC).element_len
    End Scope
    #UnDef FIRST_ELEMENT
#EndMacro

Type MyUDT
    Key As Double
    Value As String
End Type

Dim MyArray(-5 To 5, 7) As MyUDT
Dim ArDesc As FBARRAY_DESC

GenArrayDesc(ArDesc, MyArray)

Print "data", ArDesc._data
Print "ptr", ArDesc._ptr
Print "size", ArDesc.size
Print "element_len", ArDesc.element_len
Print "dimensions", ArDesc.dimensions
For I As Integer = 0 To ArDesc.dimensions - 1
    Print "dimTB(" & I & ")", ArDesc.dimTB(I).elements, ArDesc.dimTB(I)._lbound, ArDesc.dimTB(I)._ubound
Next I
Sleep


Of course most of this information is extraneous for your purposes. For a sorting routine, I would focus on 1 dimensional arrays to keep it simple.
And to implement an array sort you need 2 critical operations: an element comparison and an element position swapping routine. You can obtain the comparison from the user via a function pointer, and you can call the internal rtlib function "fb_MemSwap" to swap array elements of arbitrary size.

Code: Select all

Type ArrayRange
    FirstElement As Any Ptr
    Length As Integer
    ElementSize As Integer
End Type

#Define WholeArray(ARRAY) Type<ArrayRange>(@ARRAY(LBound(ARRAY)), UBound(ARRAY) - LBound(ARRAY) + 1, SizeOf(ARRAY(LBound(ARRAY))))

Sub ArraySort(Range As ArrayRange, LessComp As Function(L As Any Ptr, R As Any Ptr) As Integer)
    '...
    'If LessComp(Range.FirstElement, Range.FirstElement) Then fb_MemSwap Range.FirstElement, Range.FirstElement, Range.ElementSize
    '...
End Sub

Type MyUDT
    Key As Double
    Value As String
End Type

Function MyUDT_LessComp(L As Any Ptr, R As Any Ptr) As Integer
    Return CPtr(MyUDT Ptr, L)->Key < CPtr(MyUDT Ptr, R)->Key
End Function

Dim MyArray(31) As MyUDT

ArraySort WholeArray(MyArray), @MyUDT_LessComp


This example is based on variable sized data referenced using the 'Any Ptr' type rather than macros, so it will not generate any significant bloat if it is reused on many different kinds of array.

[dodicat]

gothon.
Your arrayinfo data, ptr, size e.t.c. works well in the main module.
And it is a very clean method.
But inside a sub/function the non constant #if halts it. I cannot see immediately a workaround.

Code: Select all


Type FBARRAY_DIM
    elements As UInteger
    _lbound As Integer
    _ubound As Integer
End Type

Type FBARRAY_DESC
    _data As Any Ptr
    _ptr As Any Ptr
    size As UInteger
    element_len As UInteger
    dimensions As UInteger
    dimTB(7) As FBARRAY_DIM
End Type

#Macro GenArrayDesc(DESC, ARRAY)
    #If UBound(ARRAY, 0) = 1
        #Define FIRST_ELEMENT LBound(ARRAY)
    #ElseIf UBound(ARRAY, 0) = 2
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2)
    #ElseIf UBound(ARRAY, 0) = 3
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3)
    #ElseIf UBound(ARRAY, 0) = 4
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4)
    #ElseIf UBound(ARRAY, 0) = 5
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5)
    #ElseIf UBound(ARRAY, 0) = 6
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6)
    #ElseIf UBound(ARRAY, 0) = 7
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6), LBound(ARRAY, 7)
    #ElseIf UBound(ARRAY, 0) = 8
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6), LBound(ARRAY, 7), LBound(ARRAY, 8)
    #EndIf
   
    (DESC)._ptr = @(ARRAY(FIRST_ELEMENT))
    (DESC).element_len = SizeOf(ARRAY(FIRST_ELEMENT))
    (DESC).dimensions = UBound(ARRAY, 0)
       
    Scope
        Var TotalElements = 1, Diff = 0
        For I As Integer = 0 To (DESC).dimensions - 1
            (DESC).dimTB(I)._lbound = LBound(ARRAY, I + 1)
            (DESC).dimTB(I)._ubound = UBound(ARRAY, I + 1)
            (DESC).dimTB(I).elements = (DESC).dimTB(I)._ubound - (DESC).dimTB(I)._lbound + 1
            TotalElements *= (DESC).dimTB(I).elements
            Diff = Diff * (DESC).dimTB(I).elements + (DESC).dimTB(I)._lbound
        Next I
       
        (DESC)._data = CPtr(UByte Ptr, (DESC)._ptr) - Diff * (DESC).element_len
        (DESC).size = TotalElements * (DESC).element_len
    End Scope
    #UnDef FIRST_ELEMENT
#EndMacro



Type MyUDT
    Key As Double
    Value As String
End Type

Dim  MyArray(-5 To 5, 7) As MyUDT

'===========================
sub dothis(M() as myudt)
   
Dim ArDesc As FBARRAY_DESC
GenArrayDesc(ArDesc, M)

Print "data", ArDesc._data
Print "ptr", ArDesc._ptr
Print "size", ArDesc.size
Print "element_len", ArDesc.element_len
Print "dimensions", ArDesc.dimensions
For I As Integer = 0 To ArDesc.dimensions - 1
    Print "dimTB(" & I & ")", ArDesc.dimTB(I).elements, ArDesc.dimTB(I)._lbound, ArDesc.dimTB(I)._ubound
Next I
end sub
'============================

dothis(myarray())
Sleep 

Whereas the other method by fxm works inside a sub/function
(Using the pointer to data start only for brevity)

Code: Select all



#include "file.bi"
'fxm stuff
Function arrayDescriptorGetPtrFunction (Byval p As Any Ptr) As Any Ptr
    Return p
End Function

#macro arrayDescriptorPtr(array, p)
Scope
    Dim As Function (() As Typeof((array))) As Any Ptr f
    f = Cast(Function (() As Typeof((array))) As Any Ptr, @arrayDescriptorGetPtrFunction)
    p = f(array())
End Scope
#endmacro

'new
#macro GetArrayPointer(a,address)
Scope
    Dim As Uinteger Ptr pt
    arrayDescriptorPtr(a,pt)
    address=pt[1] 
End Scope
#endmacro

Type udt
    As Integer x,y,z
    End Type


Function address(u() As udt) As udt Ptr
    Dim As Integer t
    GetarrayPointer(u,t)
    Return Cast(Typeof(u) Ptr,t)
End Function

Dim As udt z(-4 To 1,5,3 To 7,1)
Print address(z()),@z(-4,0,3,0)
#print typeof(address(z()))
#print typeof(@z(-4,0,3,0))
Sleep

 

[gothon]

gothon.
Your arrayinfo data, ptr, size e.t.c. works well in the main module.
And it is a very clean method.
But inside a sub/function the non constant #if halts it. I cannot see immediately a workaround.

Yes, inside a function the compiler doesn't know the dimensions of the array and cannot resolve the macro at compile time. Thus you must use run time branching instead of compile time branching as demonstrated by the following macro:

Code: Select all

#Macro GenArrayDescUnknownDim(DESC, ARRAY)
    (DESC).dimensions = UBound(ARRAY, 0)
    Select Case (DESC).dimensions
    Case 1
        (DESC)._ptr = @(ARRAY(LBound(ARRAY)))
        (DESC).element_len = SizeOf(ARRAY(LBound(ARRAY)))
    Case 2
        (DESC)._ptr = @(ARRAY(LBound(ARRAY, 1), LBound(ARRAY, 2)))
        (DESC).element_len = SizeOf(ARRAY(LBound(ARRAY, 1), LBound(ARRAY, 2)))
    Case 3
        (DESC)._ptr = @(ARRAY(LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3)))
        (DESC).element_len = SizeOf(ARRAY(LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3)))
    Case 4
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4)
        (DESC)._ptr = @(ARRAY(FIRST_ELEMENT))
        (DESC).element_len = SizeOf(ARRAY(FIRST_ELEMENT))
        #UnDef FIRST_ELEMENT
    Case 5
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5)
        (DESC)._ptr = @(ARRAY(FIRST_ELEMENT))
        (DESC).element_len = SizeOf(ARRAY(FIRST_ELEMENT))
        #UnDef FIRST_ELEMENT
    Case 6
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6)
        (DESC)._ptr = @(ARRAY(FIRST_ELEMENT))
        (DESC).element_len = SizeOf(ARRAY(FIRST_ELEMENT))
        #UnDef FIRST_ELEMENT
    Case 7
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6), LBound(ARRAY, 7)
        (DESC)._ptr = @(ARRAY(FIRST_ELEMENT))
        (DESC).element_len = SizeOf(ARRAY(FIRST_ELEMENT))
        #UnDef FIRST_ELEMENT
    Case 8
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6), LBound(ARRAY, 7), LBound(ARRAY, 8)
        (DESC)._ptr = @(ARRAY(FIRST_ELEMENT))
        (DESC).element_len = SizeOf(ARRAY(FIRST_ELEMENT))
        #UnDef FIRST_ELEMENT
    End Select
   
    Scope
        Var TotalElements = 1, Diff = 0
        For I As Integer = 0 To (DESC).dimensions - 1
            (DESC).dimTB(I)._lbound = LBound(ARRAY, I + 1)
            (DESC).dimTB(I)._ubound = UBound(ARRAY, I + 1)
            (DESC).dimTB(I).elements = (DESC).dimTB(I)._ubound - (DESC).dimTB(I)._lbound + 1
            TotalElements *= (DESC).dimTB(I).elements
            Diff = Diff * (DESC).dimTB(I).elements + (DESC).dimTB(I)._lbound
        Next I
       
        (DESC)._data = CPtr(UByte Ptr, (DESC)._ptr) - Diff * (DESC).element_len
        (DESC).size = TotalElements * (DESC).element_len
    End Scope
#EndMacro


If the compiler knows the dimensions of the array you have no choice but to use compile time branching. If the compiler does not know the dimensions of the array you have no choice but to use run time branching. You will need both macros to be able to handle any situation:

Code: Select all

Type FBARRAY_DIM
    elements As UInteger
    _lbound As Integer
    _ubound As Integer
End Type

Type FBARRAY_DESC
    _data As Any Ptr
    _ptr As Any Ptr
    size As UInteger
    element_len As UInteger
    dimensions As UInteger
    dimTB(7) As FBARRAY_DIM
End Type

#Macro GenArrayDesc(DESC, ARRAY)
    #If UBound(ARRAY, 0) = 1
        #Define FIRST_ELEMENT LBound(ARRAY)
    #ElseIf UBound(ARRAY, 0) = 2
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2)
    #ElseIf UBound(ARRAY, 0) = 3
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3)
    #ElseIf UBound(ARRAY, 0) = 4
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4)
    #ElseIf UBound(ARRAY, 0) = 5
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5)
    #ElseIf UBound(ARRAY, 0) = 6
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6)
    #ElseIf UBound(ARRAY, 0) = 7
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6), LBound(ARRAY, 7)
    #ElseIf UBound(ARRAY, 0) = 8
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6), LBound(ARRAY, 7), LBound(ARRAY, 8)
    #EndIf
   
    (DESC)._ptr = @(ARRAY(FIRST_ELEMENT))
    (DESC).element_len = SizeOf(ARRAY(FIRST_ELEMENT))
    (DESC).dimensions = UBound(ARRAY, 0)
   
    Scope
        Var TotalElements = 1, Diff = 0
        For I As Integer = 0 To (DESC).dimensions - 1
            (DESC).dimTB(I)._lbound = LBound(ARRAY, I + 1)
            (DESC).dimTB(I)._ubound = UBound(ARRAY, I + 1)
            (DESC).dimTB(I).elements = (DESC).dimTB(I)._ubound - (DESC).dimTB(I)._lbound + 1
            TotalElements *= (DESC).dimTB(I).elements
            Diff = Diff * (DESC).dimTB(I).elements + (DESC).dimTB(I)._lbound
        Next I
       
        (DESC)._data = CPtr(UByte Ptr, (DESC)._ptr) - Diff * (DESC).element_len
        (DESC).size = TotalElements * (DESC).element_len
    End Scope
    #UnDef FIRST_ELEMENT
#EndMacro

#Macro GenArrayDescUnknownDim(DESC, ARRAY)
    (DESC).dimensions = UBound(ARRAY, 0)
    Select Case (DESC).dimensions
    Case 1
        (DESC)._ptr = @(ARRAY(LBound(ARRAY)))
        (DESC).element_len = SizeOf(ARRAY(LBound(ARRAY)))
    Case 2
        (DESC)._ptr = @(ARRAY(LBound(ARRAY, 1), LBound(ARRAY, 2)))
        (DESC).element_len = SizeOf(ARRAY(LBound(ARRAY, 1), LBound(ARRAY, 2)))
    Case 3
        (DESC)._ptr = @(ARRAY(LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3)))
        (DESC).element_len = SizeOf(ARRAY(LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3)))
    Case 4
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4)
        (DESC)._ptr = @(ARRAY(FIRST_ELEMENT))
        (DESC).element_len = SizeOf(ARRAY(FIRST_ELEMENT))
        #UnDef FIRST_ELEMENT
    Case 5
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5)
        (DESC)._ptr = @(ARRAY(FIRST_ELEMENT))
        (DESC).element_len = SizeOf(ARRAY(FIRST_ELEMENT))
        #UnDef FIRST_ELEMENT
    Case 6
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6)
        (DESC)._ptr = @(ARRAY(FIRST_ELEMENT))
        (DESC).element_len = SizeOf(ARRAY(FIRST_ELEMENT))
        #UnDef FIRST_ELEMENT
    Case 7
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6), LBound(ARRAY, 7)
        (DESC)._ptr = @(ARRAY(FIRST_ELEMENT))
        (DESC).element_len = SizeOf(ARRAY(FIRST_ELEMENT))
        #UnDef FIRST_ELEMENT
    Case 8
        #Define FIRST_ELEMENT LBound(ARRAY, 1), LBound(ARRAY, 2), LBound(ARRAY, 3), LBound(ARRAY, 4), LBound(ARRAY, 5), LBound(ARRAY, 6), LBound(ARRAY, 7), LBound(ARRAY, 8)
        (DESC)._ptr = @(ARRAY(FIRST_ELEMENT))
        (DESC).element_len = SizeOf(ARRAY(FIRST_ELEMENT))
        #UnDef FIRST_ELEMENT
    End Select
   
    Scope
        Var TotalElements = 1, Diff = 0
        For I As Integer = 0 To (DESC).dimensions - 1
            (DESC).dimTB(I)._lbound = LBound(ARRAY, I + 1)
            (DESC).dimTB(I)._ubound = UBound(ARRAY, I + 1)
            (DESC).dimTB(I).elements = (DESC).dimTB(I)._ubound - (DESC).dimTB(I)._lbound + 1
            TotalElements *= (DESC).dimTB(I).elements
            Diff = Diff * (DESC).dimTB(I).elements + (DESC).dimTB(I)._lbound
        Next I
       
        (DESC)._data = CPtr(UByte Ptr, (DESC)._ptr) - Diff * (DESC).element_len
        (DESC).size = TotalElements * (DESC).element_len
    End Scope
#EndMacro

Type MyUDT
    Key As Double
    Value As String
End Type

Dim MyArray(-5 To 5, 7) As MyUDT
Dim ArDesc As FBARRAY_DESC

GenArrayDesc(ArDesc, MyArray)

Print "data", ArDesc._data
Print "ptr", ArDesc._ptr
Print "size", ArDesc.size
Print "element_len", ArDesc.element_len
Print "dimensions", ArDesc.dimensions
For I As Integer = 0 To ArDesc.dimensions - 1
    Print "dimTB(" & I & ")", ArDesc.dimTB(I).elements, ArDesc.dimTB(I)._lbound, ArDesc.dimTB(I)._ubound
Next I
Sleep

'===========================
Sub dothis(M() as MyUDT)
    Dim ArDesc As FBARRAY_DESC
    GenArrayDescUnknownDim(ArDesc, M)
   
    Print "data", ArDesc._data
    Print "ptr", ArDesc._ptr
    Print "size", ArDesc.size
    Print "element_len", ArDesc.element_len
    Print "dimensions", ArDesc.dimensions
    For I As Integer = 0 To ArDesc.dimensions - 1
        Print "dimTB(" & I & ")", ArDesc.dimTB(I).elements, ArDesc.dimTB(I)._lbound, ArDesc.dimTB(I)._ubound
    Next I
end sub
'============================

dothis(MyArray())
Sleep


[Lost Zergling]

Well, I'm going on something done quickly today, it's not functional, it's just a first translation in TypeDef what could give my way of seeing the thing, with my own technical limits of course. It's a little more concrete and it allows to clarify a little even if there is still a lot of technical work for me.
So it's just to give an idea. I see it as an extension of LZLE.

Code: Select all

/' LZAE : LICENCE will be CeCILL-C http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.txt - SUB Licence on LZLE : must be compiled using Free Basic Compiler
' Aext_Lcursor (element): specify a starting element in an array for being used by functions.
' Aext_Rcursor (element): specify a ending element
' Aext_SetCursor (item): set starting point for parsing
' Aext_Step (array): jump to next element (must NOT be Aext_Step (element))
' Aext_StepCursor (integer): a number of elements to jump when parsing (for example, by specifying the number of elements on a line, we parse on the column) (we can parse a dimension)
' Then more "classic" functions:
' Aext_Sort, Aext_Search, Aext_Unique but automatically taking into account Lcursor, Rcursor and StepCursor as they are settled when the function is called.
' Finally, an interesting function could be the persistence of the transposition vector of the last sorting performed: when sorting on a line, the index memorizes for each element the position of the original column. It would then be sufficient for the user to specify a vector (eg beginning and end of the second line), and then:
' Aext_Apply (array): repercutes the consequences of sorting the first line on the second line. It would be possible to propagate the consequences of a sort on a vector or array to another.
' Aext_Value : return current element value otherwise returned by Aext_Step
'/ ' END NOTICE
#Include once "D:\Basic\LZLE.bi"

Type ArrayExtension
    Declare Constructor() : Declare Destructor()
   
    Private:
    Dim As List GarbageCollector, SearchIndex, WorkingIndex
    Dim As uByte Datatype=0
    Dim As Integer INT_StepCursor=1
    Dim As String Ptr Str_StepPtr, Str_LeftPtr , Str_RightPtr, Str_RightVirtualPtr, Str_TmplPtr
    Dim As Integer Ptr Int_StepPtr, Int_LeftPtr, Int_RightPtr, Int_RightVirtualPtr, Int_TmplPtr
    Dim As Double Ptr Dbl_StepPtr, Dbl_LeftPtr, Dbl_RightPtr, Dbl_RightVirtualPtr, Dbl_TmplPtr
    Declare Property ComputeDescriptor As String     ' Do not need access to real descritptor using typedefs to work around array manipulations - compute a string descriptor, set private variables
    Declare Property LeftConsistency As Byte            ' to check : check if new array & autoset on fixed-size array otherwise error "Set(Array) required", set Rcursor to Last, set VirtualCursor
    Declare Property RightConsistency As Byte          ' Fail on Rcursor not in same array than Lcursor, fail on Rcursor<Lcursor, set VirtualCursor
    Declare Property StepConsistency As Byte           ' Set VirtualCursor= Find first element adress on the left of Rcursor wich is multiple of Lcursor+n*StepCursor, otherwise Lcursor (for use with function dataset parsing)
       
    Public:
    'Datasets & methods to prepare a job :a array's dataset is defined by : an array, a starting element, ending element, and a step (diag parse should be possible)
    Declare Property Set(aArray() As String) As Byte                    'ComputeDescriptor, Lcursor=>First, Current=>First, Rcursor=>Last
    Declare Property Set(aArray() As Integer) As Byte
    Declare Property Set(aArray() As Double) As Byte
    Declare Property Lcursor(ArrayElement As String) As Byte        ' String, Integer & double can cover most of use cases
    Declare Property Lcursor(ArrayElement As Integer) As Byte
    Declare Property Lcursor(ArrayElement As Double) As Byte
    Declare Property Rcursor(ArrayElement As String) As Byte
    Declare Property Rcursor(ArrayElement As Integer) As Byte
    Declare Property Rcursor(ArrayElement As Double) As Byte
    Declare Property StepCursor(StepCur As Integer) As Byte
    'Parser   
    Declare Property SetCursor(ArrayElement As String) As Byte      'Current cursor for programmatic handling
    Declare Property SetCursor(ArrayElement As Integer) As Byte
    Declare Property SetCursor(ArrayElement As Double) As Byte   
    Declare Property aStep As Byte                                                  'Does not accept 'Step'
    Declare Property Value As String
    Declare Property SlideCursors(SlideCur As Integer) As Byte      ' (left?) & Right slide both Lcursor & Rcursor of SlideCur elements, fast checks, so as user can design loops for parsing dimensions
    'Db or back-end interface oriented functions
    Declare Property Sort As Byte                                                   ' On current dataset
    Declare Property Search(ArrayElement As String) As Byte        ' On current dataset
    Declare Property Search(ArrayElement As Integer) As Byte
    Declare Property Search(ArrayElement As Double) As Byte
    Declare Property Unique As Byte                                              ' On current dataset
    Declare Property Apply As Byte                                                  ' aArray is the translation vector from latest sort to apply on a linearised parsing dataset (Lcursor, Rcursor, StepCursor)
    Declare Property Apply(aArray() As String) As Byte                     ' aArray is a translation vector to apply on a linearised parsing dataset (Lcursor, Rcursor, StepCursor)   
   
End Type
Constructor ArrayExtension : End Constructor
Destructor ArrayExtension : End Destructor

'==========================================================================================TYPE LIST PRIVATE PROPERTIES
Property ArrayExtension.ComputeDescriptor As String
    Dim As String str_tmp
    Return str_tmp
End Property
Property ArrayExtension.LeftConsistency As Byte

    Return 1
End Property
Property ArrayExtension.RightConsistency As Byte

    Return 1
End Property
Property ArrayExtension.StepConsistency As Byte

    Return 1
End Property


'==========================================================================================TYPE LIST PUBLIC PROPERTIES

 'Datasets & methods-----------------------------------------------------
Property ArrayExtension.Set(aArray() As String) As Byte
    Return 1
End Property
Property ArrayExtension.Set(aArray() As Integer) As Byte
    Return 1
End Property
Property ArrayExtension.Set(aArray() As Double) As Byte
    Return 1
End Property

Property ArrayExtension.Lcursor(ArrayElement As String) As Byte
    this.Str_LeftPtr=@ArrayElement : Datatype=1 : Return 1
End Property
Property ArrayExtension.Lcursor(ArrayElement As Integer) As Byte
    this.Int_LeftPtr=@ArrayElement : Datatype=2 : Return 1
End Property
Property ArrayExtension.Lcursor(ArrayElement As Double) As Byte
    this.Dbl_LeftPtr=@ArrayElement : Datatype=3 : Return 1
End Property

Property ArrayExtension.Rcursor(ArrayElement As String) As Byte
    this.Str_RightPtr=@ArrayElement : Datatype=1 : Return 1
End Property
Property ArrayExtension.Rcursor(ArrayElement As Integer) As Byte
    this.Int_RightPtr=@ArrayElement : Datatype=2 : Return 1
End Property
Property ArrayExtension.Rcursor(ArrayElement As Double) As Byte
    this.Dbl_RightPtr=@ArrayElement : Datatype=3 : Return 1
End Property

Property ArrayExtension.StepCursor(StepCur As Integer) As Byte
    INT_StepCursor=StepCur : this.StepConsistency :
    Return 1
End Property

'Parser    ---------------------------------------------------------------
Property ArrayExtension.SetCursor(ArrayElement As String) As Byte
    this.Str_StepPtr=@ArrayElement : Datatype=1 : Return 1
End Property
Property ArrayExtension.SetCursor(ArrayElement As Integer) As Byte
    this.Int_StepPtr=@ArrayElement : Datatype=2 : Return 1
End Property
Property ArrayExtension.SetCursor(ArrayElement As Double) As Byte
    this.Dbl_StepPtr=@ArrayElement : Datatype=3 : Return 1
End Property
 
Property ArrayExtension.aStep As Byte
    Select Case As Const Datatype
    Case 1 : Str_StepPtr+=INT_StepCursor : Return 1
    Case 2 : Int_StepPtr+=INT_StepCursor : Return 1
    Case 3 : Dbl_StepPtr+=INT_StepCursor : Return 1
    End Select   
     Return 1
End Property

Property ArrayExtension.Value As String
    Select Case As Const Datatype
    Case 1 : Return *Str_StepPtr
    Case 2 : Return Str(*Int_StepPtr)
    Case 3 : Return Str(*Dbl_StepPtr)
    End Select
End Property

Property ArrayExtension.SlideCursors(SlideCur As Integer) As Byte
   
    Return 1
End Property

'Db or back-end interface oriented functions    -------------------

Property ArrayExtension.Sort As Byte
    Return 1
End Property

Property ArrayExtension.Search(ArrayElement As String) As Byte
    Return 1
End Property
Property ArrayExtension.Search(ArrayElement As Integer) As Byte
    Return 1
End Property
Property ArrayExtension.Search(ArrayElement As Double) As Byte
    Return 1
End Property

Property ArrayExtension.Unique As Byte
    Return 1
End Property

[Juergen Kuehlwein]

I finally manged to make VARPTR work for arrays under all circumstances i could think of. Hopefully i will be able to supply test versions of fbc.exe (32 and 64 bit) at the weekend.


JK

[Lost Zergling]

I did some very few test yesterday before posting with any Ptr and VarPtr and they were unsuccessful. I don't bother overloading or static (in the context). A way (faster) to get rid of theses ugly select in parsers avoiding macros would interest me. However, I did not go very far in my investigations.
EC

[Juergen Kuehlwein]

For various reasons it would be desirable to have a more function like syntax for getting the array descriptor. Obviously we cannot have:

Code: Select all

FUNCTION do_something(array() AS ANY) AS ...

This isn´t possible because of the compiler´s type checking. Fxm´s code fools the compiler by presenting an appropriate function, which makes it´s type checking logic happy, and exchanging the functions pointer with another function declared as:

Code: Select all

FUNCTION arrayDescriptorGetPtrFunction (BYVAL p AS ANY PTR) AS ANY PTR

This requires a macro for defining a function with the correct type for the passed array each time. But then, how does the compiler do that with statements like LBOUND, UBOUND, etc. ? You may pass arrays of arbitrary type to these staments! Investigating this a bit further, i found out, that the compiler DISABLES type checking for RTL-functions, if an array is passed. In other words RTL-functions can receive arrays AS ANY. Coding a quick test shows, that this works indeed.

So now we have two possible methods of a function like syntax:
- VARPTR, change the compiler´s code to return an array´s descriptor for VARTR(array)
- a dedicated RTL-function returning the descriptor or member values of it


In case of VARPTR we would have to define an array descriptor type, because a pointer is useless without a definition to what is is pointing. This means we must expose the descriptor and any future changes to this descriptor will possibly break existing code - hmm.

In case of a RTL-function we can keep the descriptor hidden in the RTL, but make all the members of it available - this serves the purpose and leaves room for future changes.


The more i think about it, the more i tend towards a RTL-function, even if all the work i put into making VARPTR work for arrays was in vain.


JK

[Lost Zergling]

I deviate a little from the original subject. What could be useful to some users? What I missed to optimize my simple and easy way code is a "Variant" type (I got it in my old Basic): if Any Ptr could inherit on demand and semi-persistently caracteristics of any other pointer type this would probably be a feature that would add power and ease and sometimes avoid many contortions. How about ?

[paul doe]

...
The more i think about it, the more i tend towards a RTL-function, even if all the work i put into making VARPTR work for arrays was in vain.
...

This goes precisely in the direction of a public API that exposes some compiler internals, which is an approach that I fully agree with. While developers would need to maintain yet another API, it doesn't need to be comprehensive, just provide some useful internals such as array descriptors, string descriptors and vtable info. As you point out, this prevents breaking entire codebases if some internal change is made (as opposed to relying on pointer hacks). This is especially important for me now, since I have a large codebase that's being used in a commercial project.

If you don't mind, would you also consider a function to return vtable info for a given type? I'm particularly interested in this (since I code mostly OO).

Thanks for your (and other devs) support ;)

[fxm]

if Any Ptr could inherit on demand and semi-persistently caracteristics of any other pointer type this would probably be a feature that would add power and ease and sometimes avoid many contortions. How about ?

You can start by defining a Union structure with the list of all desired pointer types.

For example:

Code: Select all

Union typePTR
  Declare Constructor (Byval p As Any Ptr = 0)
  Dim As Any Ptr pan
  Dim As Byte Ptr pby
  Dim As Ubyte Ptr pub
  Dim As Short Ptr psh
  Dim As Ushort Ptr pus
  Dim As Long Ptr plo
  Dim As Ulong Ptr pul
  Dim As Integer Ptr pin
  Dim As Uinteger Ptr pui
  Dim As Longint Ptr pli
  Dim As Ulongint Ptr puli
  Dim As Single Ptr psi
  Dim As Double Ptr pdo
  Dim As String Ptr pst
  Dim As Zstring Ptr pzs
  Dim As Wstring Ptr pws
' Dim As UDT Ptr pud
' .....
End Union
Constructor typePTR (Byval p As Any Ptr = 0)
  This.pan = p
End Constructor

Dim As Longint li = &h123456789ABCDEF0
Dim As typePTR p = @li
Print Hex(p.pub[7])
Print Hex(p.pub[6])
Print Hex(p.pub[5])
Print Hex(p.pub[4])
Print Hex(p.pub[3])
Print Hex(p.pub[2])
Print Hex(p.pub[1])
Print Hex(p.pub[0])
Print Hex(p.pus[3])
Print Hex(p.pus[2])
Print Hex(p.pus[1])
Print Hex(p.pus[0])
Print Hex(p.pul[1])
Print Hex(p.pul[0])
Print Hex(*p.pli)

Sleep


Code: Select all

12
34
56
78
9A
BC
DE
F0
1234
5678
9ABC
DEF0
12345678
9ABCDEF0
123456789ABCDEF0

[Lost Zergling]

@fxm : ouch! ;-) I'll study that one !..

[Juergen Kuehlwein]

I need a method of retrieving an array variable´s type in a function like manner. I could do something like this:

Code: Select all

#macro array_get_data_type__ (a)
  #if TypeOf((a))     = BYTE
    #define a_d_t_ 1                                    'array´s data type
  #elseif TypeOf((a)) = UBYTE
    #define a_d_t_ 2
  #elseif TypeOf((a)) = SHORT
    #define a_d_t_ 3
  #elseif TypeOf((a)) = USHORT
    #define a_d_t_ 4
  #elseif TypeOf((a)) = INTEGER
    #define a_d_t_ 5
  #elseif TypeOf((a)) = UINTEGER
    #define a_d_t_ 6
  #elseif TypeOf((a)) = LONG
    #define a_d_t_ 7
  #elseif TypeOf((a)) = ULONG
    #define a_d_t_ 8
  #elseif TypeOf((a)) = LONGINT
    #define a_d_t_ 9
  #elseif TypeOf((a)) = ULONGINT
    #define a_d_t_ 10

  #elseif TypeOf((a)) = SINGLE
    #define a_d_t_ 20
  #elseif TypeOf((a)) = DOUBLE
    #define a_d_t_ 21

  #elseif typeof((a)) = typeof(zstring * sizeof(typeof((a))))
    #define a_d_t_ 30
  #elseif TypeOf((a)) = STRING
    #define a_d_t_ 31
  #elseif typeof((a)) = typeof(Wstring * sizeof(typeof((a))))
    #define a_d_t_ 32
  #elseif TypeOf((a)) = Typeof(USTRING)
    #define a_d_t_ 33
  #elseif TypeOf((a)) = TypeOf(CWSTR)
    #define a_d_t_ 34
  #elseif TypeOf((a)) = TypeOf(CBSTR)
    #define a_d_t_ 35
  #else
    #define a_d_t_ 40
  #endif
#endmacro


which sets a local #define or variable for later processing, but cannot be used for returning a value like this

Code: Select all

t = array_get_data_type__(array)

because of the embedded "#if ... #endif" blocks.

As an alternative i could implement an overloaded function:

Code: Select all

FUNCTION gettype OVERLOD (a() AS BYTE) AS LONG
  RETURN 1
END FUNCTION 

FUNCTION gettype(a() AS UBYTE) AS LONG
  RETURN 2
END FUNCTION 

...


but this works only for predefined types. In case of an UDT i would get a "no matching overloaded function" error, which is not what i want. It should tell me that there is a type other than the predefined ones and it shouldn´t raise an error (just like the macro above does).


The final goal of it is to pass the array´s type somehow into a function. This could be a variable value, a bit mask or a string - everything, which could be parsed later inside that function for enabling different action on different types.


Or - this would solve some other problems i have only workarounds for - is it possible to have a macro function?

Code: Select all

#MACRO function_like_macro(parameter(s))
-> do some preliminary things, which result in a body text

body text
#ENDMACRO


Only body text should be actually seen so that a syntax like this is still possible

Code: Select all

result = function_like_macro(parameters)

even with a multi-line macro.


Any ideas or suggestions?


JK

[MrSwiss]

On the quick, I can't do it function like but, what about ByRef Sub like (whould be easy):

Code: Select all

#macro array_get_data_type__ (a, a_d_t_)
  #if TypeOf((a))     = BYTE
    a_d_t_ = 1                                    'array´s data type
  #elseif TypeOf((a)) = UBYTE
    a_d_t_ = 2
  #elseif TypeOf((a)) = SHORT
    a_d_t_ = 3
  #elseif TypeOf((a)) = USHORT
    a_d_t_ = 4
  #elseif TypeOf((a)) = INTEGER
    a_d_t_ 5
  #elseif TypeOf((a)) = UINTEGER
    a_d_t_ = 6
  #elseif TypeOf((a)) = LONG
    a_d_t_ = 7
  #elseif TypeOf((a)) = ULONG
    a_d_t_ = 8
  #elseif TypeOf((a)) = LONGINT
    a_d_t_ = 9
  #elseif TypeOf((a)) = ULONGINT
    a_d_t_ = 10

  #elseif TypeOf((a)) = SINGLE
    a_d_t_ = 20
  #elseif TypeOf((a)) = DOUBLE
    a_d_t_ = 21

  #elseif typeof((a)) = typeof(zstring * sizeof(typeof((a))))
    a_d_t_ = 30
  #elseif TypeOf((a)) = STRING
    a_d_t_ = 31
  #elseif typeof((a)) = typeof(Wstring * sizeof(typeof((a))))
    a_d_t_ = 32
  #elseif TypeOf((a)) = Typeof(USTRING)
    a_d_t_ = 33
  #elseif TypeOf((a)) = TypeOf(CWSTR)
    a_d_t_ = 34
  #elseif TypeOf((a)) = TypeOf(CBSTR)
    a_d_t_ = 35
  #else
    a_d_t_ = 40
  #endif
#endmacro

Dim As UByte    a_d_t_
Dim As String   s

array_get_data_type__ (s, a_d_t_)
Print a_d_t_

Sleep

Local #Define is useless in this context, because it is destroyed, as soon as you quit scope!

[Juergen Kuehlwein]

Local #Define is useless in this context, because it is destroyed, as soon as you quit scope!

i know, but that´s exactly what i want.

Playing around trying to make the compiler do what i asked for (see question above) i remembered that i have the compiler sources ...

TYPEOF() currently works for preprocessor code and in regular code to infer the type of a variable when it is defined, but code like this is not possible:

Code: Select all

DIM s AS STRING
s = TYPEOF(s)
PRINT s 


So i made it possible. Now TYPEOF() additionally can return the type of a variable in uppercase letters in regular code too. This solves one of my key problems so far. I hope this doesn´t raise parsing abiguities for the compiler or other problems elsewhere. As far as i could test it, it seems to be safe. It was quite easy, so i´m a bit astonished it hasn´t been done before, maybe nobody thought, it could be useful.


JK