This is totally illogical, as well as contradictory to what you wrote yourself.Juergen Kuehlwein wrote:i know, but that´s exactly what i want.
Since this is based on "local" only and, is very well possible for a externallywhich sets a local #define or variable for later processing, but cannot be used for returning a value like this
i want it to be valid only in scope of my array macro. Anyway my previous question is obsolete now, because i have a better solution. You will understand, when i´m ready to present code.I fail to understand, what you are after ...
I made a working version of my example by implementing HeapSort, https://en.wikipedia.org/wiki/Heapsortgothon wrote: 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.
Code: Select all
#Inclib "BinaryHeap"
Type ArrayRange
FirstElement As Any Ptr
ElementSize As Integer
LastElementIdx As Integer
End Type
Type BinaryHeap
AR As ArrayRange
LessComp As Function(L As Any Ptr, R As Any Ptr) As Integer
Private:
Declare Sub SiftDown(I As Integer)
Declare Sub BuildHeap
Public:
Declare Constructor(R As ArrayRange, LC As Function(L As Any Ptr, R As Any Ptr) As Integer)
Declare Sub Insert
Declare Sub ExtractMax
End Type
#Define ElementArray(ELEMENT, Length) Type<ArrayRange>(@(ELEMENT), SizeOf(ELEMENT), (Length) - 1)
#Define SubArray(ARRAY, LB, UB) Type<ArrayRange>(@ARRAY(LB), SizeOf(ARRAY(LBound(ARRAY))), (UB) - (LB))
#Define WholeArray(ARRAY) SubArray(ARRAY, LBound(ARRAY), UBound(ARRAY))
Declare Sub HeapSort(Range As ArrayRange, LessComp As Function(L As Any Ptr, R As Any Ptr) As Integer)
Code: Select all
#Macro DefineCompareNumeric(VARTYPE)
Function VARTYPE##_AscendingCompare(L As Any Ptr, R As Any Ptr) As Integer
Return *CPtr(VARTYPE Ptr, L) < *CPtr(VARTYPE Ptr, R)
End Function
Function VARTYPE##_DescendingCompare(L As Any Ptr, R As Any Ptr) As Integer
Return *CPtr(VARTYPE Ptr, L) > *CPtr(VARTYPE Ptr, R)
End Function
#EndMacro
#Macro HeapSortNumeric(ARRAYRANGE, ARRAY, DIRECTION)
#If TypeOf(ARRAY) = Byte
HeapSort ARRAYRANGE, @Byte_##DIRECTION##Compare
#ElseIf TypeOf(ARRAY) = UByte
HeapSort ARRAYRANGE, @UByte_##DIRECTION##Compare
#ElseIf TypeOf(ARRAY) = Short
HeapSort ARRAYRANGE, @Short_##DIRECTION##Compare
#ElseIf TypeOf(ARRAY) = UShort
HeapSort ARRAYRANGE, @UShort_##DIRECTION##Compare
#ElseIf TypeOf(ARRAY) = Integer
HeapSort ARRAYRANGE, @Integer_##DIRECTION##Compare
#ElseIf TypeOf(ARRAY) = UInteger
HeapSort ARRAYRANGE, @UInteger_##DIRECTION##Compare
#ElseIf TypeOf(ARRAY) = Long
HeapSort ARRAYRANGE, @Long_##DIRECTION##Compare
#ElseIf TypeOf(ARRAY) = ULong
HeapSort ARRAYRANGE, @ULong_##DIRECTION##Compare
#ElseIf TypeOf(ARRAY) = LongInt
HeapSort ARRAYRANGE, @LongInt_##DIRECTION##Compare
#ElseIf TypeOf(ARRAY) = ULongInt
HeapSort ARRAYRANGE, @ULongInt_##DIRECTION##Compare
#ElseIf TypeOf(ARRAY) = Single
HeapSort ARRAYRANGE, @Single_##DIRECTION##Compare
#ElseIf TypeOf(ARRAY) = Double
HeapSort ARRAYRANGE, @Double_##DIRECTION##Compare
#Else
#Print Warning: ARRAY is not of a numeric type and will not be sorted!
#EndIf
#EndMacro
#Define HeapSortNumericElement(ELEMENT, LENGTH, DIRECTION) HeapSortNumeric(ElementArray(ELEMENT, LENGTH), ELEMENT, DIRECTION)
#Define HeapSortNumericSub(ARRAY, LB, UB, DIRECTION) HeapSortNumeric(SubArray(ARRAY, LB, UB), ARRAY, DIRECTION)
#Define HeapSortNumericWhole(ARRAY, DIRECTION) HeapSortNumeric(WholeArray(ARRAY), ARRAY, DIRECTION)
'Should probably Declare functions here and put defines in a seperate .bas file
DefineCompareNumeric(Byte)
DefineCompareNumeric(UByte)
DefineCompareNumeric(Short)
DefineCompareNumeric(UShort)
DefineCompareNumeric(Integer)
DefineCompareNumeric(UInteger)
DefineCompareNumeric(Long)
DefineCompareNumeric(ULong)
DefineCompareNumeric(LongInt)
DefineCompareNumeric(ULongInt)
DefineCompareNumeric(Single)
DefineCompareNumeric(Double)
Code: Select all
#Include "BinaryHeap.bi"
#Define Element(I) (AR.FirstElement + (I) * AR.ElementSize)
#Define MemSwap(A, B) fb_MemSwap *CPtr(UByte Ptr, A), *CPtr(UByte Ptr, B), AR.ElementSize
#Define Parent(I) ((I) \ 2) 'One Based Heap Array
#Define LChild(I) ((I) * 2)
#Define RChild(I) ((I) * 2 + 1)
'Restore the heap property downward at node I
Sub BinaryHeap.SiftDown(I As Integer)
Do While LChild(I) <= AR.LastElementIdx
Var J = I
Var LeftChild = Element(LChild(I))
If LessComp(Element(J), LeftChild) Then J = LChild(I)
If RChild(I) <= AR.LastElementIdx AndAlso LessComp(Element(J), LeftChild + AR.ElementSize) Then J = RChild(I)
If J = I Then Exit Sub
MemSwap(Element(I), Element(J))
I = J
Loop
End Sub
'Make the unordered elements satisfy the heap property in O(n) time
Sub BinaryHeap.BuildHeap
For I As Integer = Parent(AR.LastElementIdx) To 1 Step -1
SiftDown I
Next I
End Sub
'Take an ArrayRange and a comparison and make it into a BinaryHeap
Constructor BinaryHeap(R As ArrayRange, LC As Function(L As Any Ptr, R As Any Ptr) As Integer)
AR.FirstElement = R.FirstElement - R.ElementSize 'Now the Heap Array is 1 Based
AR.ElementSize = R.ElementSize
AR.LastElementIdx = R.LastElementIdx + 1
LessComp = LC
BuildHeap
End Constructor
'Decrement the size of the heap by swaping out the max element in O(Log(n)) time
Sub BinaryHeap.ExtractMax
Assert (AR.LastElementIdx > 0)
MemSwap(Element(1), Element(AR.LastElementIdx))
AR.LastElementIdx -= 1
SiftDown 1
End Sub
'Increment the size of the heap by sifting in the next array element O(1) average time, O(Log(n)) worst case
Sub BinaryHeap.Insert
'ToDo:
'AR.LastElementIdx += 1
'SiftUp AR.LastElementIdx
End Sub
Sub HeapSort(R As ArrayRange, LessComp As Function(L As Any Ptr, R As Any Ptr) As Integer)
Dim Heap As BinaryHeap = BinaryHeap(R, LessComp)
Do While Heap.AR.LastElementIdx > 1
Heap.ExtractMax
Loop
End Sub
Code: Select all
#Include "BinaryHeap.bi"
#Include "NumberCompare.bi"
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(3) As MyUDT
MyArray(0).Key = 10
MyArray(0).Value = "For I As Integer = 0 To UBound(MyArray)"
MyArray(1).Key = 20
MyArray(1).Value = " Var J = I + Int(Rnd * (UBound(MyArray) + 1 - I))"
MyArray(2).Key = 30
MyArray(2).Value = " Swap MyArray(I), MyArray(J)"
MyArray(3).Key = 40
MyArray(3).Value = "Next I"
'Make a random permutation
For I As Integer = 0 To UBound(MyArray)
Var J = I + Int(Rnd * (UBound(MyArray) + 1 - I))
Swap MyArray(I), MyArray(J)
Next I
For I As Integer = 0 To UBound(MyArray)
Print MyArray(I).Key & " " & MyArray(I).Value
Next I
Print
HeapSort WholeArray(MyArray), @MyUDT_LessComp
For I As Integer = 0 To UBound(MyArray)
Print MyArray(I).Key & " " & MyArray(I).Value
Next I
Print
Dim Nums(20) As Byte
Print "Input Nums Array"
For I As Integer = 0 To UBound(Nums)
Nums(I) = Int(Rnd * 90) + 10
Print Nums(I);
Next I
Print
Print
HeapSortNumericWhole(Nums, Descending)
Print "Descending Nums Array"
For I As Integer = 0 To UBound(Nums)
Print Nums(I);
Next I
Print
Print
HeapSortNumericSub(Nums, 1, UBound(Nums) - 2, Ascending)
Print "Ascending Nums Sub Array"
For I As Integer = 0 To UBound(Nums)
Print Nums(I);
Next I
Print
Print
Dim pNum As Single Ptr = CAllocate(10, SizeOf(Single))
Print "Manually allocated Array"
For I As Integer = 0 To 9
pNum[I] = Int(Rnd * 50) / 10
Print pNum[I];
Next I
Print
Print
HeapSortNumericElement(pNum[0], 10, Ascending)
Print "Sorted manually allocated Array"
For I As Integer = 0 To 9
Print pNum[I];
Next I
DeAllocate(pNum) 'Remember to free memory
Sleep
'This prints a warning when compiled:
'HeapSortNumericWhole(MyArray, Ascending)
Code: Select all
Type arrayDimensionDescriptor
Dim As Uinteger nbOfElements ' number of elements: (highBound-lowBound+1)
' Dim As Uinteger lowBound ' lbound
Dim As Integer lowBound ' lbound
' Dim As Uinteger highBound ' ubound
Dim As Integer highBound ' ubound
End Type
Code: Select all
'***********************************************************************************************
' array(sort, array)
' array(sort, array, down [, (i1 [, i2 [, ...]]) | pos(i), [, count]])
' array(sort, (array, nocase))
' array(sort, (array1, array2, nocase) [, (i1 [, i2 [, ...]]) | pos(i), [, count]])
' array(sort, (array, nocase), down [, (i1 [, i2 [, ...]]) | pos(i), [, count]])
' array(sort, array, @customsortproc [, (i1 [, i2 [, ...]]) | pos(i), [, count]])
'***********************************************************************************************
' array(insert, array, value [, (i1 [, i2 [, ...]]) | pos(i), [, count]])
'***********************************************************************************************
' array(delete, array [, (i1 [, i2 [, ...]]) | pos(i), [, count]])
'***********************************************************************************************
' u = array(scan, array, for()[, (i1 [, i2 [, ...]]) | pos(i), [, count]]), returns array_index
' for(searchterm [,nocase [,from])
' for(searchterm [,from])
' for(@customproc)
'***********************************************************************************************
' i = array(info, array, specifier), returns requested value as integer
'***********************************************************************************************
' i = array(calc, array, pos, (i1 [, i2 [,...]])) returns linear (one based) position from (array_)index
' p = array(calc, array, ptr, (i1 [, i2 [,...]])) returns memory ptr for this index
' u = array(calc, array, index, pos) returns array_index from linear position
' u = array(calc, array, index, ptr) returns array_index from memory ptr
'***********************************************************************************************
' array(attach, array, redim(1 to 5[, 1 to 6 [1, ...]]), memory ptr)
' array(reset, array)
'***********************************************************************************************
Doing this makes compile-time information available at run-time, which might be useful for something like variants (run-time), though storing the data type as a string is not really all that efficient so we would probably look to have some kind of mapping between an integer type and the represented data type. Regardless, should not be needed for generics (compile-time), or in the case of fbc, pseudo-generics, using #macros as templates and code generators. fbc is pretty good at optimizing out constant expressions, though, so depending on usage maybe doesn't matter that an inefficient string representation of the data type is created at compile time. If it must be stored for later use during run-time seems like a bad design.Juergen Kuehlwein wrote: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.
Old VB had the vartype(variable) function that returned an integer. Which is basically what array.bi:a_ext__get_typeof__ () is doing. This is an example of something that could be developed completely separately from the new array features, and would have general purpose usage. Readily available is the "dtype" of a symbol in the compiler. I don't know how useful the raw value from the compiler would be, but it contains a lot of information packed in to one integer type. Data type, pointer level, const bits, byref, etc.coderJeff wrote:though storing the data type as a string is not really all that efficient so we would probably look to have some kind of mapping between an integer type and the represented data type.