New array features

For other topics related to the FreeBASIC project or its community.
paul doe
Posts: 915
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: New array features

Postby paul doe » May 18, 2019 2:10

speedfixer wrote:Then, paul doe, what are you suggesting?
...

I already made my suggestions a few posts before. I won't repeat them.
speedfixer wrote:With your quote, perhaps I don't understand part what is suggested as a difference.
...

Read the original proposal by Juergen, then.

@Juergen: what I meant to say is this: if you already have something in mind, and how do you want to implement it, then why ask for 'opinions'? We all are bound to be opinionated, so I'd say that you just implement whatever you want, however you want, buddy.
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: New array features

Postby Tourist Trap » May 18, 2019 6:44

As far as I know there is plenty of good features that are empowering freebasic on the option 1 basis (simple include file). For example we can take DJ.Peters top quality optional additions like SNC (for networking), and many others as we know. For what I know, it never required a pull request in this case.
If we are in this configuration, then this thread is still useful if it gives us an occasion for gathering ideas about how empowering the arrays. However if it has to be really considered as a portion of the core, because it corresponds to a need, then, on the basis of the tradition of this language, it will be in some future to be melted in the core itself - at least it's how I like it.
It there is no necessity in term of true language feature, then in another hand, why bother making it a pull request?
In anyway we need all the possible optional extensions to fb all the time, and any work done is welcome and great. Making an addition to the language however have to be more subtle to keep it the whole thing not just a patchwork but rather some meaningful way of expression with the rock solid consistency that makes great languages (and less headaches).
Juergen Kuehlwein wrote:"VARPTR(array)" is syntactically different from "VARPTR(array(index))". Obviously we don´t have a need for "DESCPTR" for Strings, so why use it for Arrays?

Yes. Maybe the question should have been treated for strings in the past :)
Anyway, those syntactic features (varptr....) are all verbose versions of @. We probably just use them rather than tne simplest @ when we want to insist on what we really mean to write in a coding context (because they should be self explanatory). That's the reason why I find not useless to pay it attention.
But your remarks are right.
Juergen Kuehlwein
Posts: 162
Joined: Mar 07, 2018 13:59
Location: Germany

Re: New array features

Postby Juergen Kuehlwein » May 18, 2019 10:20

@paul doe,

Then what's the point of this thread? Stir controversy?

No, not at all! I want to collect ideas, opinions and arguments. Of course i have a personal opinion, but i want to be sure, that i am not the only one with this opinion. I want to do something, which is not only useful for me, but for others too. So i must know what they think and maybe adapt my work. To my experience exchanging arguments, discussing things with others is always helpful, even if in the end not all share the same opinion.


@ Tourist Trap,

a pull request is necessary, because for VARPTR/@ to return an array descriptor the compiler must be adapted.

I see your point about syntax. Yes, it should be logical and self-explanatory whenever possible, therefore we must try to find the most "logical" or "intuitive" way. In our case retrieving a pointer to a variable, retrieving a pointer to a variable descriptor and retrieving an array descriptor are different things indeed. On the other side they are similar enough to use the same syntax, a syntax a user already is familiar with. I think it is a better choice than introducing something new for this single situation. Thanks for giving food for thinking!


JK
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: New array features

Postby Tourist Trap » May 18, 2019 13:43

Juergen Kuehlwein wrote:

Code: Select all

#define all(X) A, X, 0                                'sort the whole array or a given dimension
#define ascend AC                                     'sort ascending
#define descend DC                                    'sort descending

#define ascend_ AC, A, 1, 0                           'sort the entire 1. dimension ascending
#define descend_ DC, A, 1, 0                          'sort the entire 1. dimension descending


#macro array_Sort(x, t, D, I, C)
'***********************************************************************************************
' array_sort(array, ascend/descend/@Customsortproc, dimension, index , count)

' Sorts a one-dimensional(!) fixed-size or dynamic array calling the C qsort function.
' String sorting is case sensitive. Make it case insensitive by using a custom sort (ucase compare)

' 5 Parameters:
' - x: array variable without brackets
' - t: "ac"/"{a}s{c}end", "dc"/"{d}es{c}end" or a pointer to a custom sort function (@customsortproc)
'      "a/descend_" replaces the last 4 parameters and sorts the first dimension entirely

' Example: array_sort(myarray, ascend_)

' - d: dimension
' - i: absolute index to start at (inside dimension)
' - c: count (# of elements to sort)

' the last three argumemts may be replaced by "ALL()", "ALL(1)", "ALL(2)" ...
' where the number inside the brackets denominates the dimension to sort entirely
' "ALL()" sorts the entire array over all dimensions

' Example: array_sort(myarray, ac, 2, 3, 4): sorts 4 elements in the 2. dimension
'                                            of myarray starting at myarray(2, 3)
' Example: array_sort(myarray, ac, all(3)) : sorts the 3. dimension of myarray entirely

' Example: array_sort(myarray, ascend_)    : sorts the 1. dimension of myarray entirely ascending

' ERR = 0 for success, = 6 for invalid index or dimension values, 7 for invalid custom sort proc
' any other value = run time error 
'***********************************************************************************************
scope
dim p__t_r as any ptr
dim n__u_m as ulong = 0


  err = 0

  #if (#D = "A")                                      'all(...)
    #if (#i = "")                                     'whole array
      scope
        dim l as long                                 'looper
        dim z as long                                 '# of dimensions available
        dim n as long                                 'max. size of dimension
        Dim As Integer Ptr pArrayDescriptor

        z = ubound(x, 0)                              '# of dimensions
        if z <= 0 then
          err = 6

        else
          for l = 1 to z
            n = UBOUND(x, l) - LBOUND(x, l) + 1
            if n > n__u_m then
              n__u_m = n
            end if 
          next l

          n__u_m = n__u_m * z

          arrayDescriptorPtr(x, pArrayDescriptor)
          p__t_r = Cptr(Integer Ptr Ptr, pArrayDescriptor)[1]
        end if
      end scope
     
    #else                                             'dimension #i
      scope
        dim l as long                                 'looper
        dim z as long                                 '# of dimensions available
        dim n as long                                 'max. size of dimension
        Dim As Integer Ptr pArrayDescriptor

        z = ubound(x, 0)                              '# of dimensions
        if (z <= 0) or (i < 1) or (i > z) then
          err = 6

        else
          for l = 1 to z
            n = UBOUND(x, l) - LBOUND(x, l) + 1
            if n > n__u_m then
              n__u_m = n
            end if 
          next l

          n__u_m = n__u_m * (i-1)

          arrayDescriptorPtr(x, pArrayDescriptor)

          p__t_r = Cptr(Integer Ptr Ptr, pArrayDescriptor)[1]
          p__t_r = p__t_r + (n__u_m * sizeof(typeof((x))))
          n__u_m = UBOUND(x, i) - LBOUND(x, i) + 1
        end if
      end scope
     
    #endif
 
  #else                                               'dimension #d, from i, for c
    scope
      dim l as long                                   'looper
      dim z as long                                   '# of dimensions available
        dim n as long                                 'max. size of dimension
      Dim As Integer Ptr pArrayDescriptor

      z = ubound(x, 0)                                '# of dimensions
      if (z <= 0) or (d < 1) or (d > z) then
        err = 6

      else
        for l = 1 to z
          n = UBOUND(x, l) - LBOUND(x, l) + 1
          if n > n__u_m then
            n__u_m = n
          end if 
        next l

        n__u_m = n__u_m * (d-1)

        arrayDescriptorPtr(x, pArrayDescriptor)
        p__t_r = Cptr(Integer Ptr Ptr, pArrayDescriptor)[1]
        p__t_r = p__t_r + (n__u_m + i - 1) * sizeof(typeof((x)))
        n__u_m = c
      end if
    end scope
  #endif
 

  #if (#t = "ac") or (#t = "Ac") or (#t = "AC") or (#t = "aC")
    #if TypeOf((x)) = BYTE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Byte)
    #elseif TypeOf((x)) = UBYTE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UByte)
    #elseif TypeOf((x)) = SHORT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Short)
    #elseif TypeOf((x)) = USHORT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UShort)
    #elseif TypeOf((x)) = INTEGER
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Integer)
    #elseif TypeOf((x)) = UINTEGER
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UInteger)
    #elseif TypeOf((x)) = LONG
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Long)
    #elseif TypeOf((x)) = ULONG
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_ULong)
    #elseif TypeOf((x)) = LONGINT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Longint)
    #elseif TypeOf((x)) = ULONGINT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_ULongint)

    #elseif TypeOf((x)) = SINGLE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Single)
    #elseif TypeOf((x)) = DOUBLE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Double)

    #elseif typeof((x)) = typeof(zstring * sizeof(typeof((x))))
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_ZString)
    #elseif TypeOf((x)) = STRING
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_String)
    #elseif typeof((x)) = typeof(Wstring * sizeof(typeof((x))))
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Wstring)
    #elseif TypeOf((x)) = Typeof(USTRING)
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UString)
    #elseif TypeOf((x)) = TypeOf(CWSTR)
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UString)
    #elseif TypeOf((x)) = TypeOf(CBSTR)
      #ifdef AFX
        if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_CBstr)
      #endif
    #else
      #error "Only standard variable types are supported, consider using a custom sort function"
    #endif

  #elseif (#t = "dc") or (#t = "Dc") or (#t = "DC") or (#t = "dC")
    #if TypeOf((x)) = BYTE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Byte)
    #elseif TypeOf((x)) = UBYTE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UByte)
    #elseif TypeOf((x)) = SHORT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Short)
    #elseif TypeOf((x)) = USHORT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UShort)
    #elseif TypeOf((x)) = INTEGER
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Integer)
    #elseif TypeOf((x)) = UINTEGER
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UInteger)
    #elseif TypeOf((x)) = LONG
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Long)
    #elseif TypeOf((x)) = ULONG
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_ULong)
    #elseif TypeOf((x)) = LONGINT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Longint)
    #elseif TypeOf((x)) = ULONGINT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_ULongint)

    #elseif TypeOf((x)) = SINGLE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Single)
    #elseif TypeOf((x)) = DOUBLE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Double)

    #elseif typeof((x)) = typeof(zstring * sizeof(typeof((x))))
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_ZString)
    #elseif TypeOf((x)) = STRING
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_String)
    #elseif typeof((x)) = typeof(Wstring * sizeof(typeof((x))))
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Wstring)
    #elseif TypeOf((x)) = Typeof(USTRING)
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UString)
    #elseif TypeOf((x)) = TypeOf(CWSTR)
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UString)
    #elseif TypeOf((x)) = TypeOf(CBSTR)
      #ifdef AFX
        if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_CBstr)
      #endif
    #else
      #error "Only standard variable types are supported, consider using a custom sort function"
    #endif

  #else
    if t <> 0 then                                    'prevent null pointer
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), cast(any ptr, t)

    else
      err = 7
    end if 
  #endif
end scope
#endmacro


'***********************************************************************************************


#macro array_insert(a, i, v)                          'array, (absolute) index , value
'***********************************************************************************************
' Inserts a new element at the specified index of a dynamic array and assigns a value to it
' this macro fails for fixed-size arrays (cannot be redimed!)

' 3 Parameters:
' - a: array (without brackets)
' - i: absolute index in the array where the new element will be added.
' - v: value of the new element.
'      this may be a variable of the same type or constant where applicable
'      for UDTs not supporting the "=" operator, you must pass a variable of
'      the same type, initialzed to whatever is needed

' ERR is set to 0 for success, to 99 for fixed-size array, 6 = invalid index
' any other value = run time error 
'***********************************************************************************************
scope
err = 0                                               'assume success

DIM l__b AS LONG = LBOUND(a)
DIM u__b AS LONG = UBOUND(a)

  IF (i >= l__b) and (i <= u__b + 1) THEN             'a valid index
    scope
      REDIM PRESERVE a(l__b TO u__b + 1)
    END scope                                         'this scope is necessary for correct results of ubound(a)
                                                      'in case of a fixed-size array

    IF UBOUND(a) = u__b + 1 THEN                      'success
      FOR z AS LONG = UBOUND(a) TO i + 1 STEP - 1     'move elements up, last one first
         a(z) = a(z - 1)
      NEXT

      a(i) = v                                        'assign value to new element

    else
      err = 99                                        'return fail (fixed-size array)
    end if

  else
    err = 6                                           'index out of bounds
  end if 
END scope
#endmacro


'***********************************************************************************************


#macro array_delete(a, i)                             'array, (absolute) index
'***********************************************************************************************
' Deletes the element at the specified index of a dynamic array by shifting down all
' following elements, this function works for fixed-size arrays too
' Please note: in case of a fixed-size array the last element will still be present
' (cannot be redimed!) but it will be reinitialzed to it´s default state

' 2 Parameters:
' - a: array (without brackets)
' - i: absolute index in the array which will be deleted

' ERR is set to 0 for success, to 99 for fixed-size array, any other value = run time error 
'***********************************************************************************************
scope
err = 0                                               'assume success

DIM l__b AS LONG = LBOUND(a)
DIM u__b AS LONG = UBOUND(a)

  scope
    IF (i >= l__b) and (i <= u__b + 1) THEN           'a valid index
      FOR z AS LONG = i to u__b - 1                   'move items down
         a(z) = a(z + 1)
      NEXT

      REDIM PRESERVE a(l__b TO u__b - 1)              'try to remove the last element

    else
      u__b += 1                                       'make ubound(a) <> u__b !
    end if 
  END scope                                           'this scope is necessary for correct results of ubound(a)
                                                      'in case of a fixed-size array

  IF UBOUND(a) = u__b THEN                            'a fixed-size array
    dim x as typeof(a)
    a(ubound(a)) = x                                  'reinitialize the variable, because it wasn´t deleted

    err = 99                                          'was a fixed-size array
  end if

end scope
#endmacro


'***********************************************************************************************
'***********************************************************************************************
'***********************************************************************************************


Hi,

Let's keep concentrate!...

I have another question that matters always from a user point of view. As far as I understand it you will put a lot of things in your .BI file, not only limited to the array descriptor access affairs, but including DEFINES. About this, there are some issues that desserve attention I think.

I think that there are 2 kind of defines you introduce, some for internal stuff, and some others will be macros made avaiable to the user (unless only functions will be for the user and all the other stuff is for internal needs, I don't really see).
It seems to be at first sight that your naming of the macros by prefixing AC to a rather specific name, which is good. But you also defined things like "all", "ascend" etc... that are so common that it is very likely they will be in conflict with names defined by the user.

I think you see what I mean. If your addition has to become popular as I guess, you may want to minimize those potential annoyances. Maybe simply complicating the names that are just for internal use will suffice. (maybe also an underscoring policy would do?)

Thanks again.
paul doe
Posts: 915
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: New array features

Postby paul doe » May 18, 2019 15:13

@Juergen:

Unless I'm missing something, it doesn't work:

Code: Select all

'#include once "ustring.bi"
#INCLUDE ONCE "/crt/string.bi"
#INCLUDE ONCE "/crt/stdlib.bi"


#pragma once


'***********************************************************************************************
' Copyright (c) 2019 Juergen Kuehlwein
' Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ****************************************************************************************


' array_sort    - sort all kinds of arrays in many ways including custom sort
' array_insert  - insert an element into an one-dimensional array an assign a value to it
' array_delete  - delete an element of an one-dimensional array and close the gap


'***********************************************************************************************
' prototype of a custom sort procedure:
' it must be CDECL, and you must choose the corresponding data type (zstring is just an example)
'***********************************************************************************************


'PRIVATE FUNCTION CustomSortProc CDECL (BYVAL a AS zstring PTR, BYVAL b AS zstring PTR) AS LONG
''***********************************************************************************************
'' qsort custom comparison function
'' return  1, if a should precede b in sorting
'' return -1, if b should precede a in sorting
'' return  0, if both are equal
'' for UDT: compare member variable(s) to get the desired order
''***********************************************************************************************
'
'  if ucase(*a) > ucase(*b) then                       'make it case insensitive
'  if *a > *b then                                     'case sensitive
'    return 1
'  elseif *a < *b then
'    return -1
'  else
'    return 0
'  end if
'
'
'END FUNCTION


' You may implement other predefined string sorting functions like: CompareStringEx

' CompareStringEx returns one of the following values if successful: 1,2,3 To maintain the C runtime
' convention of comparing strings, the value 2 can be subtracted from a nonzero return value.
' Then, the meaning of <0, ==0, and >0 is consistent with the C runtime.
' CSTR_LESS_THAN (-1). The string indicated by a is less in lexical value than the string indicated by b.
' CSTR_EQUAL (0). The string indicated by a is equivalent in lexical value to the string indicated by b.
' The two strings are equivalent for sorting purposes, although not necessarily identical.
' CSTR_GREATER_THAN (1). The string indicated by a is greater in lexical value than the string indicated by b.

' The function returns 0 if it does not succeed. To get extended error information, the application
' can call GetLastError, which can return one of the following error codes:
' ERROR_INVALID_FLAGS. The values supplied for flags were invalid.
' ERROR_INVALID_PARAMETER. Any of the parameter values was invalid.

'***********************************************************************************************
'***********************************************************************************************


#macro AC_SORT(a, b)
  if *a > *b then
    return 1
  elseif *a < *b then
    return -1
  else
    return 0
  end if
#endmacro


PRIVATE FUNCTION AC_Byte CDECL (BYVAL a AS Byte PTR, BYVAL b AS Byte PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_UByte CDECL (BYVAL a AS uByte PTR, BYVAL b AS uByte PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_Short CDECL (BYVAL a AS Short PTR, BYVAL b AS Short PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_UShort CDECL (BYVAL a AS UShort PTR, BYVAL b AS UShort PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_Integer CDECL (BYVAL a AS Integer PTR, BYVAL b AS Integer PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_UInteger CDECL (BYVAL a AS UInteger PTR, BYVAL b AS UInteger PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_Long CDECL (BYVAL a AS Long PTR, BYVAL b AS Long PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_ULong CDECL (BYVAL a AS ULong PTR, BYVAL b AS ULong PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_Longint CDECL (BYVAL a AS Longint PTR, BYVAL b AS Longint PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_ULongint CDECL (BYVAL a AS ULongint PTR, BYVAL b AS ULongint PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_Single CDECL (BYVAL a AS Single PTR, BYVAL b AS Single PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_Double CDECL (BYVAL a AS Double PTR, BYVAL b AS Double PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_ZString CDECL (BYVAL a AS ZString PTR, BYVAL b AS ZString PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_String CDECL (BYVAL a AS String PTR, BYVAL b AS String PTR) AS LONG
  AC_SORT(a, b)
end function

PRIVATE FUNCTION AC_WString CDECL (BYVAL a AS WString PTR, BYVAL b AS WString PTR) AS LONG
  AC_SORT(a, b)
end function

'PRIVATE FUNCTION AC_UString CDECL (BYVAL a AS UString PTR, BYVAL b AS UString PTR) AS LONG
'  AC_SORT(a, b)
'end function

#ifdef AFX                                            'include José´s "CBstr" if WinFBX is present
PRIVATE FUNCTION AC_CBstr CDECL (BYVAL a AS CBstr PTR, BYVAL b AS CBstr PTR) AS LONG
  AC_SORT(a, b)
end function
#endif


#macro DC_SORT(a, b)
  if *a < *b then
    return 1
  elseif *a > *b then
    return -1
  else
    return 0
  end if
#endmacro


PRIVATE FUNCTION DC_Byte CDECL (BYVAL a AS Byte PTR, BYVAL b AS Byte PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_UByte CDECL (BYVAL a AS uByte PTR, BYVAL b AS uByte PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_Short CDECL (BYVAL a AS Short PTR, BYVAL b AS Short PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_UShort CDECL (BYVAL a AS UShort PTR, BYVAL b AS UShort PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_Integer CDECL (BYVAL a AS Integer PTR, BYVAL b AS Integer PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_UInteger CDECL (BYVAL a AS UInteger PTR, BYVAL b AS UInteger PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_Long CDECL (BYVAL a AS Long PTR, BYVAL b AS Long PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_ULong CDECL (BYVAL a AS ULong PTR, BYVAL b AS ULong PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_Longint CDECL (BYVAL a AS Longint PTR, BYVAL b AS Longint PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_ULongint CDECL (BYVAL a AS ULongint PTR, BYVAL b AS ULongint PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_Single CDECL (BYVAL a AS Single PTR, BYVAL b AS Single PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_Double CDECL (BYVAL a AS Double PTR, BYVAL b AS Double PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_ZString CDECL (BYVAL a AS ZString PTR, BYVAL b AS ZString PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_String CDECL (BYVAL a AS String PTR, BYVAL b AS String PTR) AS LONG
  DC_SORT(a, b)
end function

PRIVATE FUNCTION DC_WString CDECL (BYVAL a AS WString PTR, BYVAL b AS WString PTR) AS LONG
  DC_SORT(a, b)
end function

'PRIVATE FUNCTION DC_UString CDECL (BYVAL a AS UString PTR, BYVAL b AS UString PTR) AS LONG
'  DC_SORT(a, b)
'end function

#ifdef AFX                                            'include José´s "CBstr" if WinFBX is present
PRIVATE FUNCTION DC_CBstr CDECL (BYVAL a AS CBstr PTR, BYVAL b AS CBstr PTR) AS LONG
  DC_SORT(a, b)
end function
#endif


private Function arrayDescriptorGetPtrFunction (Byval p As Any Ptr) As Any Ptr    'thanks to fxm
  Return p
End function

#macro arrayDescriptorPtr(array, p)                   'thanks to fxm
  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


#define all(X) A, X, 0                                'sort the whole array or a given dimension
#define ascend AC                                     'sort ascending
#define descend DC                                    'sort descending

#define ascend_ AC, A, 1, 0                           'sort the entire 1. dimension ascending
#define descend_ DC, A, 1, 0                          'sort the entire 1. dimension descending


#macro array_Sort(x, t, D, I, C)
'***********************************************************************************************
' array_sort(array, ascend/descend/@Customsortproc, dimension, index , count)

' Sorts a one-dimensional(!) fixed-size or dynamic array calling the C qsort function.
' String sorting is case sensitive. Make it case insensitive by using a custom sort (ucase compare)

' 5 Parameters:
' - x: array variable without brackets
' - t: "ac"/"{a}s{c}end", "dc"/"{d}es{c}end" or a pointer to a custom sort function (@customsortproc)
'      "a/descend_" replaces the last 4 parameters and sorts the first dimension entirely

' Example: array_sort(myarray, ascend_)

' - d: dimension
' - i: absolute index to start at (inside dimension)
' - c: count (# of elements to sort)

' the last three argumemts may be replaced by "ALL()", "ALL(1)", "ALL(2)" ...
' where the number inside the brackets denominates the dimension to sort entirely
' "ALL()" sorts the entire array over all dimensions

' Example: array_sort(myarray, ac, 2, 3, 4): sorts 4 elements in the 2. dimension
'                                            of myarray starting at myarray(2, 3)
' Example: array_sort(myarray, ac, all(3)) : sorts the 3. dimension of myarray entirely

' Example: array_sort(myarray, ascend_)    : sorts the 1. dimension of myarray entirely ascending

' ERR = 0 for success, = 6 for invalid index or dimension values, 7 for invalid custom sort proc
' any other value = run time error
'***********************************************************************************************
scope
dim p__t_r as any ptr
dim n__u_m as ulong = 0


  err = 0

  #if (#D = "A")                                      'all(...)
    #if (#i = "")                                     'whole array
      scope
        dim l as long                                 'looper
        dim z as long                                 '# of dimensions available
        dim n as long                                 'max. size of dimension
        Dim As Integer Ptr pArrayDescriptor

        z = ubound(x, 0)                              '# of dimensions
        if z <= 0 then
          err = 6

        else
          for l = 1 to z
            n = UBOUND(x, l) - LBOUND(x, l) + 1
            if n > n__u_m then
              n__u_m = n
            end if
          next l

          n__u_m = n__u_m * z

          arrayDescriptorPtr(x, pArrayDescriptor)
          p__t_r = Cptr(Integer Ptr Ptr, pArrayDescriptor)[1]
        end if
      end scope
     
    #else                                             'dimension #i
      scope
        dim l as long                                 'looper
        dim z as long                                 '# of dimensions available
        dim n as long                                 'max. size of dimension
        Dim As Integer Ptr pArrayDescriptor

        z = ubound(x, 0)                              '# of dimensions
        if (z <= 0) or (i < 1) or (i > z) then
          err = 6

        else
          for l = 1 to z
            n = UBOUND(x, l) - LBOUND(x, l) + 1
            if n > n__u_m then
              n__u_m = n
            end if
          next l

          n__u_m = n__u_m * (i-1)

          arrayDescriptorPtr(x, pArrayDescriptor)

          p__t_r = Cptr(Integer Ptr Ptr, pArrayDescriptor)[1]
          p__t_r = p__t_r + (n__u_m * sizeof(typeof((x))))
          n__u_m = UBOUND(x, i) - LBOUND(x, i) + 1
        end if
      end scope
     
    #endif
 
  #else                                               'dimension #d, from i, for c
    scope
      dim l as long                                   'looper
      dim z as long                                   '# of dimensions available
        dim n as long                                 'max. size of dimension
      Dim As Integer Ptr pArrayDescriptor

      z = ubound(x, 0)                                '# of dimensions
      if (z <= 0) or (d < 1) or (d > z) then
        err = 6

      else
        for l = 1 to z
          n = UBOUND(x, l) - LBOUND(x, l) + 1
          if n > n__u_m then
            n__u_m = n
          end if
        next l

        n__u_m = n__u_m * (d-1)

        arrayDescriptorPtr(x, pArrayDescriptor)
        p__t_r = Cptr(Integer Ptr Ptr, pArrayDescriptor)[1]
        p__t_r = p__t_r + (n__u_m + i - 1) * sizeof(typeof((x)))
        n__u_m = c
      end if
    end scope
  #endif
 

  #if (#t = "ac") or (#t = "Ac") or (#t = "AC") or (#t = "aC")
    #if TypeOf((x)) = BYTE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Byte)
    #elseif TypeOf((x)) = UBYTE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UByte)
    #elseif TypeOf((x)) = SHORT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Short)
    #elseif TypeOf((x)) = USHORT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UShort)
    #elseif TypeOf((x)) = INTEGER
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Integer)
    #elseif TypeOf((x)) = UINTEGER
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UInteger)
    #elseif TypeOf((x)) = LONG
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Long)
    #elseif TypeOf((x)) = ULONG
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_ULong)
    #elseif TypeOf((x)) = LONGINT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Longint)
    #elseif TypeOf((x)) = ULONGINT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_ULongint)

    #elseif TypeOf((x)) = SINGLE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Single)
    #elseif TypeOf((x)) = DOUBLE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Double)

    #elseif typeof((x)) = typeof(zstring * sizeof(typeof((x))))
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_ZString)
    #elseif TypeOf((x)) = STRING
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_String)
    #elseif typeof((x)) = typeof(Wstring * sizeof(typeof((x))))
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_Wstring)
    #elseif TypeOf((x)) = Typeof(USTRING)
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UString)
    #elseif TypeOf((x)) = TypeOf(CWSTR)
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_UString)
    #elseif TypeOf((x)) = TypeOf(CBSTR)
      #ifdef AFX
        if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @AC_CBstr)
      #endif
    #else
      #error "Only standard variable types are supported, consider using a custom sort function"
    #endif

  #elseif (#t = "dc") or (#t = "Dc") or (#t = "DC") or (#t = "dC")
    #if TypeOf((x)) = BYTE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Byte)
    #elseif TypeOf((x)) = UBYTE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UByte)
    #elseif TypeOf((x)) = SHORT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Short)
    #elseif TypeOf((x)) = USHORT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UShort)
    #elseif TypeOf((x)) = INTEGER
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Integer)
    #elseif TypeOf((x)) = UINTEGER
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UInteger)
    #elseif TypeOf((x)) = LONG
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Long)
    #elseif TypeOf((x)) = ULONG
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_ULong)
    #elseif TypeOf((x)) = LONGINT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Longint)
    #elseif TypeOf((x)) = ULONGINT
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_ULongint)

    #elseif TypeOf((x)) = SINGLE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Single)
    #elseif TypeOf((x)) = DOUBLE
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Double)

    #elseif typeof((x)) = typeof(zstring * sizeof(typeof((x))))
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_ZString)
    #elseif TypeOf((x)) = STRING
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_String)
    #elseif typeof((x)) = typeof(Wstring * sizeof(typeof((x))))
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_Wstring)
    #elseif TypeOf((x)) = Typeof(USTRING)
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UString)
    #elseif TypeOf((x)) = TypeOf(CWSTR)
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_UString)
    #elseif TypeOf((x)) = TypeOf(CBSTR)
      #ifdef AFX
        if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), CPTR(ANY PTR, @DC_CBstr)
      #endif
    #else
      #error "Only standard variable types are supported, consider using a custom sort function"
    #endif

  #else
    if t <> 0 then                                    'prevent null pointer
      if n__u_m > 1 then qsort p__t_r, n__u_m, sizeof(typeof((x))), cast(any ptr, t)

    else
      err = 7
    end if
  #endif
end scope
#endmacro


'***********************************************************************************************


#macro array_insert(a, i, v)                          'array, (absolute) index , value
'***********************************************************************************************
' Inserts a new element at the specified index of a dynamic array and assigns a value to it
' this macro fails for fixed-size arrays (cannot be redimed!)

' 3 Parameters:
' - a: array (without brackets)
' - i: absolute index in the array where the new element will be added.
' - v: value of the new element.
'      this may be a variable of the same type or constant where applicable
'      for UDTs not supporting the "=" operator, you must pass a variable of
'      the same type, initialzed to whatever is needed

' ERR is set to 0 for success, to 99 for fixed-size array, 6 = invalid index
' any other value = run time error
'***********************************************************************************************
scope
err = 0                                               'assume success

DIM l__b AS LONG = LBOUND(a)
DIM u__b AS LONG = UBOUND(a)

  IF (i >= l__b) and (i <= u__b + 1) THEN             'a valid index
    scope
      REDIM PRESERVE a(l__b TO u__b + 1)
    END scope                                         'this scope is necessary for correct results of ubound(a)
                                                      'in case of a fixed-size array

    IF UBOUND(a) = u__b + 1 THEN                      'success
      FOR z AS LONG = UBOUND(a) TO i + 1 STEP - 1     'move elements up, last one first
         a(z) = a(z - 1)
      NEXT

      a(i) = v                                        'assign value to new element

    else
      err = 99                                        'return fail (fixed-size array)
    end if

  else
    err = 6                                           'index out of bounds
  end if
END scope
#endmacro


'***********************************************************************************************


#macro array_delete(a, i)                             'array, (absolute) index
'***********************************************************************************************
' Deletes the element at the specified index of a dynamic array by shifting down all
' following elements, this function works for fixed-size arrays too
' Please note: in case of a fixed-size array the last element will still be present
' (cannot be redimed!) but it will be reinitialzed to it´s default state

' 2 Parameters:
' - a: array (without brackets)
' - i: absolute index in the array which will be deleted

' ERR is set to 0 for success, to 99 for fixed-size array, any other value = run time error
'***********************************************************************************************
scope
err = 0                                               'assume success

DIM l__b AS LONG = LBOUND(a)
DIM u__b AS LONG = UBOUND(a)

  scope
    IF (i >= l__b) and (i <= u__b + 1) THEN           'a valid index
      FOR z AS LONG = i to u__b - 1                   'move items down
         a(z) = a(z + 1)
      NEXT

      REDIM PRESERVE a(l__b TO u__b - 1)              'try to remove the last element

    else
      u__b += 1                                       'make ubound(a) <> u__b !
    end if
  END scope                                           'this scope is necessary for correct results of ubound(a)
                                                      'in case of a fixed-size array

  IF UBOUND(a) = u__b THEN                            'a fixed-size array
    dim x as typeof(a)
    a(ubound(a)) = x                                  'reinitialize the variable, because it wasn´t deleted

    err = 99                                          'was a fixed-size array
  end if

end scope
#endmacro


'***********************************************************************************************
'***********************************************************************************************
'***********************************************************************************************


'***********************************************************************************************
'***********************************************************************************************
'***********************************************************************************************

dim as integer _
  a( any )
redim _
  a( 0 to 255 )

'dim as integer _
'  a( 0 to 255 )

for _
  i as integer => 0 to ubound( a )
 
  a( i ) => rnd() * 255
next

? "Unsorted:"

for _
  i as integer => 0 to ubound( a )
 
  ? a( i )
next

array_sort( a, ac, 1, 0, ubound( a ) )

?
? "Sorted:"

for _
  i as integer => 0 to ubound( a )
 
  ? a( i )
next

sleep()


FreeBasic 1.06.0, 64-bit (latest official version).
Compiler switches: fbc -console -gen gcc -Wc -Ofast -w all

It works (as in, it doesn't segfault) with static arrays:

Code: Select all

dim as integer _
  a( 0 to 255 )

for _
  i as integer => 0 to ubound( a )
 
  a( i ) => rnd() * 255
next

? "Unsorted:"

for _
  i as integer => 0 to ubound( a )
 
  ? a( i )
next

array_sort( a, ac, 1, 0, ubound( a ) )

?
? "Sorted:"

for _
  i as integer => 0 to ubound( a )
 
  ? a( i )
next

sleep()

As you can see, the last two elements aren't touched. Unless I misunderstood the interface...
Last edited by paul doe on May 18, 2019 15:23, edited 1 time in total.
coderJeff
Site Admin
Posts: 2908
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: New array features

Postby coderJeff » May 18, 2019 15:21

Not a bad idea to collect information and opinions; it can help give a direction for the overall goals. Ultimately, the one doing the work (and the ones helping to support the work) make the final choice. I do recommend a small change first to get started. The most concise and obvious pull requests are the quickest to be reviewed and merged in.

For the 3 methods proposed, in my opinion, the real changes are the features that get added to the fbc manual. If the feature is added to the documentation, then that means that the feature is accepted by the developers, and will be continued to be supported, probably forever.

Juergen Kuehlwein wrote: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.


fbc official distribution does not use this method for any of it's features currently. In this scheme, there's no real need for it to be part of the official distribution. It could be released as an extension, however desired, under whatever license desired, by whomever. Many community members release their contributions this way with great success. The main disadvantage is that the implementation is limited to official features. Adding a feature to fbc in this way would be a new method compared to what has been done in the past. We tend to avoid this method because, for example, if the implementation needs "crt/*.bi" then the user must also allow for "crt/*.bi" in every usage of the feature even if they are not directly needing "crt/*.bi". Plan on documenting everything exposed by the include file.

2.) add only the definitions to array.bi, and add the code to the runtime library, which still requires array.bi to be included for making the features available (just like file.bi). This keeps parts of the low level stuff away from the user


This is a common method that fbc currently uses for features. For example datetime.bi, fbgfx.bi and several other includes. The include file provides the declaration of the API, and fb (or gfx) run time provides the impementation. The main advantages of this scheme, is that only what is exposed to the user needs to be documented. The developers have some flexibility to change (or replace) internals without changing the public API. Functions are linked individually as part of the run time (do not need to be compiled every usage). The main disadvantage is that only a few users will ever look at the implementation as it currently written in C.

3.) add it to the compiler (new keywords etc.) and add the actual code to the runtime library, which makes an include file (array.bi) obsolete. This keeps all the low level stuff away from the user


This is a common method, but not the preferred method as it introduces symbol names to the global namespace. macros like LOWORD and functions like LEFT are automatically added to the compiler even though they are simple macros and function declarations. Only quirk keywords must be added to the compiler as there is no other syntax to declare them. I recommend against this method unless absolutely necessary.
speedfixer
Posts: 350
Joined: Nov 28, 2012 1:27
Location: California

Re: New array features

Postby speedfixer » May 18, 2019 17:50

I change my opinion.

I disagree that people won't look at the implementation.
Or rather, if they don't know what they are looking at, it doesn't matter.
The code has always been available.
Juergen Kuehlwein
Posts: 162
Joined: Mar 07, 2018 13:59
Location: Germany

Re: New array features

Postby Juergen Kuehlwein » May 18, 2019 19:00

@paul doe,

as already mentioned above there is a bug in the interface, it works for one-dimensional arrays using the following syntax:

Code: Select all

array_sort( a, ascend_)


@ all,

i tried to offer a simplified way of sorting multi-dimensional arrays too, but this works only, if certain conditions are met, and fails otherwise. I think i will use a different interface and approach for the next version. Basically sorting (even customsort), inserting and deleting works, but the current array_sort implementation in "array.bi" is still not bug-free. Fxm found another bug in array_delete.

Please be patient, i will fix that, after other decisions (1,2,3) and preliminary steps are made.

My first step i´m currently working on is making VARPTR(array) return a pointer to an array descriptor under all circumstances. This already works for dynamic and static arrays, even if passed as procedure parameter. It works for dynamic arrays inside TYPEs. But i´m still struggling with static arrays inside TYPEs, because, as it seems, these don´t have an array descriptor, i can just use. It looks like i will have to build a new one, just like it is done for passed static arrays.


JK
Lost Zergling
Posts: 221
Joined: Dec 02, 2011 22:51
Location: France

Re: New array features

Postby Lost Zergling » May 18, 2019 19:12

The perfect code that does everything does not exist. The algorithm to work on a huge table will not be the same as that for a multitude of small hierarchical tables in a tree if only because of the heaviness of loading the libraries. Tourist Trap mentioned a point I think is crucial about the importance of functional coherence. A library must be able to cover a homogeneous functional area. It is also expected to be in line with the spirit of language, the absence of bugs and technical excellence, and ideally the easy and fun side. It's a lot. Libraries and extensions must be able to "live their lives" and this agree with CoderJeff as he says that the man doing the job has the last word. I do not know exactly how the multi-dimensional arrays are organized, but the typical optimal organization would be a tree (left child right sibling or something approaching) with the sheets containing the data in sequential blocks. I see two solutions (at least) to create or manage a linear path: the calculation of the table (possibly by recursion) and the creation of a linear index table then the use of this table in the one hand and the course direct from the tree using a dynamic dual-chain list if necessary to memorize the current path of the parent documents and to allow the path (case of a left child right sibling) on the other hand. These two solutions appear to be suitable for different volumetric and different table structures. Comparable functionalities (data description) but technical specifications related to different use cases. The second option could suppose the perpetuation of a "hacking" insofar as the exploitation of the descriptor(s) of the table allows it. I hope that my remarks will contribute to advance the reflection, on my side I better measure the way that can remain to go!
fxm
Posts: 9015
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: New array features

Postby fxm » May 18, 2019 20:52

Juergen Kuehlwein wrote:But i´m still struggling with static arrays inside TYPEs, because, as it seems, these don´t have an array descriptor, i can just use. It looks like i will have to build a new one, just like it is done for passed static arrays

I see no difference for static arrays inside a Type.

See the following example with:
- An UDT containing an only declared static array.
- An UDT containing a declared and defined static array.

Code: Select all

Type arrayDimensionDescriptor
  Dim As Uinteger nbOfElements  ' number of elements: (highBound-lowBound+1)
  Dim As Integer lowBound       ' lbound
  Dim As Integer highBound      ' ubound
End Type

Type arrayDescriptor
  Dim As Any Ptr nullIndexesAddress  ' pointer to the real or virtual element: @array(0, 0,...)
  Dim As Any Ptr minIndexesAddress   ' pointer to the first real element: @array(lbound1, lbound2,...)
  Dim As Uinteger globalSize         ' "global" size in bytes: (ubound1-lbound1+1)*(ubound2-lbound2+1).....*(size of 1 element)
  Dim As Uinteger elementSize        ' size of one element in bytes
  Dim As Uinteger nbOfDimensions     ' number of dimensions
  Dim As arrayDimensionDescriptor arrayDimensions(1 to 8)  ' max number of dimensions = 8
End Type                                                   '   (numbered from 1 to 8)

private 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

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

Sub printArrayDescriptor (Byval p As Any Ptr)
  Dim As arrayDescriptor Ptr pu = p
  Print "[@array descriptor: "; pu; "]"
  Print "  @array(all_null_indexes)   ="; pu->nullIndexesAddress
  Print "  @array(all_min_indexes)    ="; pu->minIndexesAddress
  Print "  array_total_size_in_bytes  ="; pu->globalSize
  Print "  array_element_size_in_bytes="; pu->elementSize
  Print "  number_of_array_dimensions ="; pu->nbOfDimensions
  For i As Integer = 1 to pu->nbOfDimensions
    Print "  [dimension number:"; i; "]"
    Print "    number_of_elements="; pu->arrayDimensions(i).nbOfElements
    Print "    min_index         ="; pu->arrayDimensions(i).lowBound
    Print "    max_index         ="; pu->arrayDimensions(i).highBound
  Next i
End Sub

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

Type UDT1
  Static As LongInt test(0 To 9, 1 to 100)
  Dim As Integer I
End Type

Type UDT2
  Static As LongInt test(0 To 9, 1 to 100)
  Dim As Integer I
End Type
Static As LongInt UDT2.test(0 To 9, 1 to 100)

Screen 0
Width , 30

Dim p As Any Ptr

arrayDescriptorPtr(UDT1.test, p)
printArrayDescriptor(p)
Print
arrayDescriptorPtr(UDT2.test, p)
printArrayDescriptor(p)

Sleep

Code: Select all

[@array descriptor: 4317216]
  @array(all_null_indexes)   =0
  @array(all_min_indexes)    =0
  array_total_size_in_bytes  =0
  array_element_size_in_bytes=0
  number_of_array_dimensions =0

[@array descriptor: 4288992]
  @array(all_null_indexes)   =4317256
  @array(all_min_indexes)    =4317264
  array_total_size_in_bytes  =8000
  array_element_size_in_bytes=8
  number_of_array_dimensions =2
  [dimension number: 1]
    number_of_elements=10
    min_index         =0
    max_index         =9
  [dimension number: 2]
    number_of_elements=100
    min_index         =1
    max_index         =100


[edit]
In 'arrayDimensionDescriptor', 'lowBound' and 'highBound' must be Integer (not Uinteger).
Last edited by fxm on May 29, 2019 5:32, edited 2 times in total.
dodicat
Posts: 5825
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: New array features

Postby dodicat » May 18, 2019 21:35

A trivial way to retrieve say, an array pointer, an array size in bytes, array dimensions, would be one liners in an external file (bi).
The only implementation function would be -- Function arrayDescriptorGetPtrFunction(Byval p As Any Ptr) As Any Ptr --, everything else is a macro.
All in a namespace.
Also, no need to include "crt.bi" (for the sort anyway), just declare qsort from the OS C runtime.
I cannot get rid of these gcc warnings for the array stuff though.

Code: Select all



'==========   part of arrays.bi ===========
'fxm stuff for descriptors
Namespace arrays
Function arrayDescriptorGetPtrFunction(Byval p As Any Ptr) As Any Ptr
    Return p
End Function

Extern "c"
Declare Sub qsort(Byval As Any Ptr, Byval As Long, Byval As Long, As Function(Byval As Any Ptr, Byval As Any Ptr) As Long)
End Extern

#define ArrayPtr(array) _
Cptr(Typeof(array) Ptr,Cptr(uinteger Ptr,Cast(Function(() As Typeof(array)) As any Ptr ,@arrays.arrayDescriptorGetPtrFunction)(array()))[1])

#define Arraysize(array) _
Cptr(Uinteger Ptr,Cast(Function(() As Typeof(array)) As any Ptr ,@arrays.arrayDescriptorGetPtrFunction)(array()))[2]

#define Arraydimensions(array) _
Cptr(Uinteger Ptr,Cast(Function(() As Typeof(array)) As any Ptr ,@arrays.arrayDescriptorGetPtrFunction)(array()))[4]

#define up <,>
#define down >,<
#define Array(x,start,finish) @X((start)),((finish)-(start)+1),Sizeof(X)
#macro SetCSort(Datatype,FnName,b1,b2,dot)
Function FnName Cdecl(Byval n1 As Any Ptr,Byval n2 As Any Ptr) As Long
    If *Cptr(Datatype Ptr,n1)dot b1 *Cptr(Datatype Ptr,n2)dot Then Return -1
    If *Cptr(DataType Ptr,n1)dot b2 *Cptr(DataType Ptr,n2)dot Then Return 1
    Return 0
End Function
#endmacro
End Namespace
'=============================================

Dim As String s(1 To 3,-6 To 3,2)
Print @(s(1,-6,0))
Print arrayptr(s)
Print "size ";Arraysize(s)
Print "dimensions "; Arraydimensions(s)
Print

Dim As Double d(7 To 9,0)
Print @d(7,0)
Print arrayptr(d)
Print "size ";Arraysize(d)
Print "dimensions "; Arraydimensions(d)
Print
Type udt
    As String s
    As Long g
    As Double d(10)
End Type

Redim As udt z(6)
For n As Long=Lbound(z) To Ubound(z)
    z(n).s="Hello "+Str(Int(Rnd*100))
Next

Print @z(0)
#print typeof(@z(0))
Print arrayptr(z)
#print typeof(arrayptr(z))
Print "size ";Arraysize(z)
Print "dimensions "; Arraydimensions(z)
print

'==========   sort ============
print "C sort"
setCsort(udt,callbackstring,up,.s)


arrays.qsort(array(z,Lbound(z),Ubound(z)),@callbackstring)

Print
For n As Long=Lbound(z) To Ubound(z)
    Print z(n).s
Next

Sleep


 
Juergen Kuehlwein
Posts: 162
Joined: Mar 07, 2018 13:59
Location: Germany

Re: New array features

Postby Juergen Kuehlwein » May 18, 2019 23:14

@fxm,

your method of retrieving a pointer to an array descriptor implements a detour through a function, which forces the compiler to supply a descriptor. So you let the compiler do the dirty work for you - clever. I try to make the compiler do this internally without a detour, and it is still somewhat reluctant to do so for fixes size array inside TYPEs ...

@dodicat,

nice implementation!

I´m still looking for a way to have a consistent and flexible syntax using keywords and optional parameters as well.

Example:
ARRAY_SORT or ARRAY.SORT (a namespace is excellent for isolating keywords)
(arrayvar) -> sort everything ascending
(arrayvar, down) -> sort everything descending
(arrayvar, up, 4, 7) -> sort 7 elements ascending, starting at element 4
(arrayvar, @customsortproc, 5) -> sort using a customsort procedure, starting at element 5

Any suggestions welcome


JK
Lost Zergling
Posts: 221
Joined: Dec 02, 2011 22:51
Location: France

Re: New array features

Postby Lost Zergling » May 18, 2019 23:52

As usual, I am completely dumped by the technical level of Dodicat's code.
I did some tests at my level, and these codes are interesting for me to better understand the very basic implementation:

This code shows that for strings (variable lenght) data are referenced via pointers

Code: Select all

Dim As String s(1 To 3,-6 To 3, 2)
Print @(s(1,-6,0))
s(1,-6,0)="titi"
s(1,-6,1)="toto"

Dim sp1 as String Ptr
sp1= @(s(1,-6,0))
print *sp1

Dim zp1 As zString Ptr
zp1 = StrPtr(*sp1)
print *zp1
dim i as integer
For i=1 to 10
    zp1+=1
    print *zp1
Next i
sleep


Whereas for fixed lenght datatypes we can expect continguous adresses :

Code: Select all

Dim As Integer s(1 To 3,-6 To 3, 2)

Print @(s(1,-6,0))

s(1,-6,0)=34
s(1,-6,1)=45
s(1,-6,2)=658
s(1,-5,1)=703

Dim sp1 as Integer Ptr
sp1= @(s(1,-6,0))
print *sp1
sp1+=1
print *sp1
sp1+=1
print *sp1
sp1+=1
print *sp1
sp1+=1
print *sp1
sleep


Conclusion :
For fixed size datasets a fast parse seems conceivable. Thus linearized. Whenever cluster big enought, I may use it.
For var lenght dataset we can suspect that @(s(1,-6,0)) does not return really @(s(1,-6,0)) but @@(s(1,-6,0)) ?
If so, how to access @(s(1,-6,0)) ?..
fxm
Posts: 9015
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: New array features

Postby fxm » May 19, 2019 4:53

For any array type, the array data section is always a continuous block in memory (with a row-major order).
For a numeric array, the array data section is the the numeric values themselves (continuous block in memory).
For a string array, the array data section is the string descriptors (continuous block in memory, 3 integers by descriptor), but the string character data (referenced by their descriptors) are anywhere in memory.
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: New array features

Postby Tourist Trap » May 19, 2019 10:49

Juergen Kuehlwein wrote:Example:
ARRAY_SORT or ARRAY.SORT (a namespace is excellent for isolating keywords)
(arrayvar) -> sort everything ascending
(arrayvar, down) -> sort everything descending
(arrayvar, up, 4, 7) -> sort 7 elements ascending, starting at element 4
(arrayvar, @customsortproc, 5) -> sort using a customsort procedure, starting at element 5

Any suggestions welcome

Hi JK,

my modest view here again stated. The principle I want to defend is, if you can, help the user of your include not encountering names conflict. For this reason I state again my previous suggestion, have complicated names for the internal macros, and non trivial names for the exposed ones. You will reduce name conflicts, above all when the user introduces your include lately, and may have already standard names in use, or from its work, or from other includes.

A user can always redefine your defines to simplify them if he needs, but my opinion is that by default renaming should not be a almost necessary burden.

Use namespace please also, for the same reason. But you probably noticed that defines/macro can not be isolated in namespaces - unless I missed something of course. ARRAY seems a reasonable name, yet I would prefere FBARRAY (or underscores etc...), just because array is a so common name prone to conflict.

Here is a simple example of what I would do. Simply to illustrate my view:

Code: Select all

'namespace YYY
'    #define down       200
'end namespace
'#define down   100        ''duplicated definition; the namespace doesnt isolate a define

namespace ARRAY
    enum ArraySortParam
        sortdown
        sortup
    end enum
    function Sort(Array() as integer, SortParam as ArraySortParam=ArraySortParam.sortdown) as integer
        ? "dummy"
        return 0
    end function
end namespace

Code: Select all

#include "yyy.bas"

'name conflict if we Defined down in the include
'#define down   100        ''duplicated definition; the namespace didn't isolate the previous define

using ARRAY

dim as integer  x(any)

Sort(x(), ArraySortParam.sortdown)      ''allows autocompletion if the IDE supports it
Sort(x(), sortdown)                     ''also possible directly

var up = ArraySortParam.sortup   ''possible to do this if the users wants this short common name to be used

Sort(x(), up)

My fear is not technical here, it's just for the comfort of adding an Include with a minimum of additionnal constraints on the existing code.

Thanks.

ps: Also noticeable, namespaces, enums, and all that has dot members can switch on autocompletion in compatible IDEs.

Return to “Community Discussion”

Who is online

Users browsing this forum: No registered users and 3 guests