Many have been written before, but none have been properly extensible like this one. Trivially extend any UDT to have ForEach iteration with a neat BASIC-esque syntax fully parsed with preprocessor shenaigans. Feel free to use it however you wish. I present (probably) the most comprehensive ForEach macro in Freebasic (examples are at the bottom):
Code: Select all
#ifndef ForEach_bi
#define ForEach_bi
'The ultimate FOREACH iterator macro in FreeBasic!
'Usage is like so:
'FOREACH <positional argument 1>, [positional argument 2, 3, 4] <in iterator> [with index as integer [= number]]
'FOREACH_NEXT
'Each positional argument can be declared as either pattern:
'var item
'item as type
'Example:
'FOREACH var key, value as float, thing as UDT, otherThing as string in bigType with i as integer = 0
' key, value, thing, otherThing will be the
' resultant iterated items from variable "bigType"
' i will represent the index into "bigType".
' i may not be uniformly incremental depending on your implementation of ForEachNextArg0
'FOREACH_NEXT
'See more examples at the bottom of the code
'User must define the following functions in a UDT with the following features:
'Required:
'declare function ForEachNextArg0(byref as integer, as <some_type> ptr) as <some_type> ptr
' - First argument is the BYREF index that will be passed in by the macro.
' The index will start at 0 unless specified by the user.
' Since it is byref, this function may modify the index as needed
' for example to pass over empty items in a sparse array.
' - Second argument is a pointer to the previous iteration's first positional argument.
' If you wish to do:
' foreach item as string in list
' then the "type" of the first positional argument is type of 'string'
' and you will do "function ForEachNextArg0(..., item as string ptr) as string ptr
' - Returns the pointer type of the first positional type in the foreach iterator.
' This must be the same type as the second argument.
' If the return is 0, the foreach loop terminates. This function MUST conditionally
' return a null (0) pointer, no subsequent pointers are checked for null.
' If this function returns a non-null pointer, all subsequent ForEachNextArg functions
' must also return a non-null pointer.
'Optional:
'declare function ForEachNextArg1(as integer, as <some_type> ptr) as <some_type> ptr
' - First argument is the index resulting from ForEachNextArg0 call
' - Second argument is a pointer to the previous iteration's second positional argument
' - Returns a pointer to the "next item", whatever that is.
'Optional:
'declare function ForEachNextArg2(as integer, as <some_type> ptr) as <some_type> ptr
'declare function ForEachNextArg3(as integer, as <some_type> ptr) as <some_type> ptr
' - See above for details
'IMPLEMENTATION:
'The keywords I'm using to denote where the
'iterator is and where the index is
#define _FOREACH_ITERATOR_MARKER in
#define _FOREACH_INDEX_MARKER with
'Extracts out a variable token from a _STATEMENT and
'stores it as _FOREACH_VARIABLE_ID##_TOKEN
#macro _FOREACH_EXTRACT_SYMBOL(_STATEMENT, _TOKEN)
'Undefine it so we can re-use this macro multiple times
#undef _FOREACH_VARIABLE_ID##_TOKEN
#undef _FOREACH_IS_VAR##_TOKEN
#undef _FOREACH_VARIABLE_TYPE##_TOKEN
'Determine if the statement is of the pattern "var blah" (vs "blah as type")
#define _FOREACH_IS_VAR##_TOKEN __FB_EVAL__(__FB_QUOTE__(__FB_ARG_RIGHTOF__(_STATEMENT, var)) <> "")
#if _FOREACH_IS_VAR##_TOKEN
'Extract the token to the right of the "var"
#define _FOREACH_VARIABLE_ID##_TOKEN __FB_ARG_RIGHTOF__(_STATEMENT, var)
#else
'Extract the token to the left of the "as"
#define _FOREACH_VARIABLE_ID##_TOKEN __FB_UNQUOTE__(__FB_EVAL__(" " + __FB_QUOTE__(__FB_ARG_LEFTOF__(_STATEMENT, as))))
'Extract out the type (tokens to the right of "as")
#define _FOREACH_VARIABLE_TYPE##_TOKEN __FB_UNQUOTE__(__FB_EVAL__(" " + __FB_QUOTE__(__FB_ARG_RIGHTOF__(_STATEMENT, as))))
#endif
#endmacro
'Extract out the initial variables (a as integer, b as integer ...)
#macro _FOREACH_EXTRACT_VARIABLE(_ARG_INDEX, _STATEMENT)
_FOREACH_EXTRACT_SYMBOL(_STATEMENT, _ARG_INDEX)
#endmacro
'Extract out if there is an optional index (... with i as integer)
#macro _FOREACH_EXTRACT_INDEX(ARGS...)
#undef _FOREACH_INDEX
#undef _FOREACH_HAS_INDEX
#undef _FOREACH_ARGS_NO_INDEX
'Extract anything after a "with" keyword
#define _FOREACH_INDEX __FB_ARG_RIGHTOF__(__FB_ARG_EXTRACT__(__FB_EVAL__(__FB_ARG_COUNT__(ARGS) - 1), ARGS), _FOREACH_INDEX_MARKER)
'Check that whatever is after a with actually exists
#define _FOREACH_HAS_INDEX __FB_IIF__(__FB_QUOTE__(_FOREACH_INDEX) <> "", 1, 0)
#if _FOREACH_HAS_INDEX
'Note that janky hanging quotation mark, it's necessary
'This is due to the fact that the args themselves are entirely
'quoted, and this __FB_ARG_LEFTOF__ will chop off the right quotation mark
'so we gotta slap it back on.
'I couldn't figure out a way to make it more readable so enjoy the jank
#define _FOREACH_ARGS_NO_INDEX __FB_UNQUOTE__(__FB_ARG_LEFTOF__(#ARGS, _FOREACH_INDEX_MARKER)")
#else
'There is no optional index, so the args get effectively passed as-is
#define _FOREACH_ARGS_NO_INDEX ARGS
#endif
#endmacro
'Extract out the variable being iterated over
#macro _FOREACH_EXTRACT_ITERATOR(ARGS...)
#undef _FOREACH_ITERATOR
#undef _FOREACH_ARGS_TERMS_ONLY
'Everything after the word "in" (excluding an optional index)
#define _FOREACH_ITERATOR __FB_ARG_RIGHTOF__(__FB_ARG_EXTRACT__(__FB_EVAL__(__FB_ARG_COUNT__(ARGS) - 1), ARGS), _FOREACH_ITERATOR_MARKER)
'Again, that hanging quotation mark
#define _FOREACH_ARGS_TERMS_ONLY __FB_UNQUOTE__(__FB_ARG_LEFTOF__(#ARGS, _FOREACH_ITERATOR_MARKER)")
#endmacro
'Get the terms using the extracted variables
'dim a as integer
'var b
'etc
#macro _FOREACH_EXTRACT_TERMS(_ARG_INDEX, ARGS...)
#undef _FOREACHPTR##_FOREACH_VARIABLE_ID##_ARG_INDEX
_FOREACH_EXTRACT_VARIABLE(_ARG_INDEX, ##ARGS)
'Create a token for the shadow pointer variable
#define _FOREACHPTR##_FOREACH_VARIABLE_ID##_ARG_INDEX __FB_JOIN__(_INTERNAL_FOREACH, _FOREACH_VARIABLE_ID##_ARG_INDEX)
#endmacro
'Defines the index
#macro DEFINE_INDEX(_INDEX_ARG)
#if _FOREACH_HAS_INDEX
'Create the index symbol as _VARIABLE_IDINDEX
_FOREACH_EXTRACT_SYMBOL(_FOREACH_INDEX, INDEX)
'We declared something like "i as integer" so here's where
'it gets defined
dim _INDEX_ARG
'We also need the correct internal index
var _FOREACH_INTERNAL_INDEX = _FOREACH_VARIABLE_IDINDEX
#else
'We need to set up the internal indexes
'(these names suck)
dim _FOREACH_INTERNAL_INDEX as integer = 0
var _FOREACH_VARIABLE_IDINDEX = _FOREACH_INTERNAL_INDEX
#endif
#endmacro
#macro _FOREACH_BUILD_LOOP(ARGS...)
#undef _FOREACH_VARIABLE_COUNT
'Scope block of the entire foreach iteration
scope
'Extract the optional index
_FOREACH_EXTRACT_INDEX(ARGS)
'Extract the variable we're iterating over
_FOREACH_EXTRACT_ITERATOR(_FOREACH_ARGS_NO_INDEX)
'Define the index, either using the optionally supplied one
'or the internally named one
DEFINE_INDEX(_FOREACH_INDEX)
#define _FOREACH_VARIABLE_COUNT __FB_ARG_COUNT__(_FOREACH_ARGS_TERMS_ONLY)
'Declare the variable terms based on number of arguments
#if _FOREACH_VARIABLE_COUNT < 1 ORELSE _FOREACH_VARIABLE_COUNT > 4
#error Unsupported number of arguments ##_FOREACH_VARIABLE_COUNT, only supports 1 to 4 arguments
#endif
'Using a fallthrough pattern here
#if _FOREACH_VARIABLE_COUNT >= 1
'Declare the first argument's terms
_FOREACH_EXTRACT_TERMS(0, __FB_ARG_EXTRACT__(0, _FOREACH_ARGS_TERMS_ONLY))
'Explicitly declare the shadow pointer as the return
'value of the next argument function
dim _FOREACHPTR##_FOREACH_VARIABLE_ID0 as typeof(_FOREACH_ITERATOR.ForEachNextArg0(*cast(typeof(_FOREACH_VARIABLE_IDINDEX) ptr, 0), 0))
'Ensure that the user supplied type is actually correct
#if _FOREACH_IS_VAR0 = 0 ANDALSO typeof(_FOREACHPTR##_FOREACH_VARIABLE_ID0) <> typeof(any ptr)
#if typeof(*_FOREACHPTR##_FOREACH_VARIABLE_ID0) <> typeof(__FB_ARG_RIGHTOF__(__FB_ARG_EXTRACT__(0, _FOREACH_ARGS_TERMS_ONLY), as, any))
'Surely there's a better way than splitting this
'into three different error messages
#error Invalid assignment/conversion at Argument 1 of FORNEXT:
#error _FOREACH_VARIABLE_ID0 is not type
#error typeof(*_FOREACHPTR##_FOREACH_VARIABLE_ID0)
#endif
#endif
#endif
#if _FOREACH_VARIABLE_COUNT >= 2
_FOREACH_EXTRACT_TERMS(1, __FB_ARG_EXTRACT__(1, _FOREACH_ARGS_TERMS_ONLY))
dim _FOREACHPTR##_FOREACH_VARIABLE_ID1 as typeof(_FOREACH_ITERATOR.ForEachNextArg1(*cast(typeof(_FOREACH_VARIABLE_IDINDEX) ptr, 0), 0))
'Ensure that the user supplied type is actually correct
#if _FOREACH_IS_VAR1 = 0 ANDALSO typeof(_FOREACHPTR##_FOREACH_VARIABLE_ID1) <> typeof(any ptr)
#if typeof(*_FOREACHPTR##_FOREACH_VARIABLE_ID1) <> typeof(__FB_ARG_RIGHTOF__(__FB_ARG_EXTRACT__(1, _FOREACH_ARGS_TERMS_ONLY), as, any))
'Surely there's a better way than splitting this
'into three different error messages
#error Invalid assignment/conversion at Argument 2 of FORNEXT:
#error _FOREACH_VARIABLE_ID1 is not type
#error typeof(*_FOREACHPTR##_FOREACH_VARIABLE_ID1)
#endif
#endif
#endif
#if _FOREACH_VARIABLE_COUNT >= 3
_FOREACH_EXTRACT_TERMS(2, __FB_ARG_EXTRACT__(2, _FOREACH_ARGS_TERMS_ONLY))
dim _FOREACHPTR##_FOREACH_VARIABLE_ID2 as typeof(_FOREACH_ITERATOR.ForEachNextArg2(*cast(typeof(_FOREACH_VARIABLE_IDINDEX) ptr, 0), 0))
'Ensure that the user supplied type is actually correct
#if _FOREACH_IS_VAR2 = 0 ANDALSO typeof(_FOREACHPTR##_FOREACH_VARIABLE_ID2) <> typeof(any ptr)
#if typeof(*_FOREACHPTR##_FOREACH_VARIABLE_ID2) <> typeof(__FB_ARG_RIGHTOF__(__FB_ARG_EXTRACT__(2, _FOREACH_ARGS_TERMS_ONLY), as, any))
'Surely there's a better way than splitting this
'into three different error messages
#error Invalid assignment/conversion at Argument 3 of FORNEXT:
#error _FOREACH_VARIABLE_ID2 is not type
#error typeof(*_FOREACHPTR##_FOREACH_VARIABLE_ID2)
#endif
#endif
#endif
#if _FOREACH_VARIABLE_COUNT = 4
_FOREACH_EXTRACT_TERMS(3, __FB_ARG_EXTRACT__(3, _FOREACH_ARGS_TERMS_ONLY))
dim _FOREACHPTR##_FOREACH_VARIABLE_ID3 as typeof(_FOREACH_ITERATOR.ForEachNextArg3(*cast(typeof(_FOREACH_VARIABLE_IDINDEX) ptr, 0), 0))
'Ensure that the user supplied type is actually correct
#if _FOREACH_IS_VAR3 = 0 ANDALSO typeof(_FOREACHPTR##_FOREACH_VARIABLE_ID3) <> typeof(any ptr)
#if typeof(*_FOREACHPTR##_FOREACH_VARIABLE_ID3) <> typeof(__FB_ARG_RIGHTOF__(__FB_ARG_EXTRACT__(3, _FOREACH_ARGS_TERMS_ONLY), as, any))
'Surely there's a better way than splitting this
'into three different error messages
#error Invalid assignment/conversion at Argument 4 of FORNEXT:
#error _FOREACH_VARIABLE_ID3 is not type
#error typeof(*_FOREACHPTR##_FOREACH_VARIABLE_ID3)
#endif
#endif
#endif
'Start the loop
while 1
'Using a fallthrough pattern here
#if _FOREACH_VARIABLE_COUNT >= 1
'First ForEachNext.. return value determines whether or not
'the rest of the loop is executed
'Similarly, if arg0 is evaluated as non-null, then all subsequent
'arguments are assumed to also be non-null
_FOREACHPTR##_FOREACH_VARIABLE_ID0 = _FOREACH_ITERATOR.ForEachNextArg0(_FOREACH_INTERNAL_INDEX, _FOREACHPTR##_FOREACH_VARIABLE_ID0)
if _FOREACHPTR##_FOREACH_VARIABLE_ID0 = 0 then
exit while
end if
'Set up the user facing variable
#if _FOREACH_IS_VAR0
#if typeof(_FOREACHPTR##_FOREACH_VARIABLE_ID0) = typeof(any ptr)
'Catch incomplete type errors
#error Incomplete type,
#error _FOREACH_VARIABLE_ID0 cannot be set to the "any" type
#error change return type of procedure _FOREACH_ITERATOR.ForEachNextArg0 or explicitly specify type
#else
var byref _FOREACH_VARIABLE_ID0 = *_FOREACHPTR##_FOREACH_VARIABLE_ID0
#endif
#else
dim byref _FOREACH_VARIABLE_ID0 as _FOREACH_VARIABLE_TYPE0 = *cast(_FOREACH_VARIABLE_TYPE0 ptr, _FOREACHPTR##_FOREACH_VARIABLE_ID0)
#endif
#endif
#if _FOREACH_VARIABLE_COUNT >= 2
'Note that we actually pass the old index value (_FOREACH_VARIABLE_IDINDEX)
'to the subsequent NextArg functions as opposed to the one passed
'to the first function (_FOREACH_INTERNAL_INDEX), this is because
'the index will be properly updated in the NextArg0 function,
'and these all need to be given the original index.
_FOREACHPTR##_FOREACH_VARIABLE_ID1 = _FOREACH_ITERATOR.ForEachNextArg1(_FOREACH_INTERNAL_INDEX, _FOREACHPTR##_FOREACH_VARIABLE_ID1)
#if _FOREACH_IS_VAR1
#if typeof(_FOREACHPTR##_FOREACH_VARIABLE_ID1) = typeof(any ptr)
'Catch incomplete type errors
#error Incomplete type,
#error _FOREACH_VARIABLE_ID1 cannot be set to the "any" type
#error change return type of procedure _FOREACH_ITERATOR.ForEachNextArg1 or explicitly specify type
#else
var byref _FOREACH_VARIABLE_ID1 = *_FOREACHPTR##_FOREACH_VARIABLE_ID1
#endif
#else
dim byref _FOREACH_VARIABLE_ID1 as _FOREACH_VARIABLE_TYPE1 = *cast(_FOREACH_VARIABLE_TYPE1 ptr, _FOREACHPTR##_FOREACH_VARIABLE_ID1)
#endif
#endif
#if _FOREACH_VARIABLE_COUNT >= 3
_FOREACHPTR##_FOREACH_VARIABLE_ID2 = _FOREACH_ITERATOR.ForEachNextArg2(_FOREACH_INTERNAL_INDEX, _FOREACHPTR##_FOREACH_VARIABLE_ID2)
#if _FOREACH_IS_VAR2
#if typeof(_FOREACHPTR##_FOREACH_VARIABLE_ID2) = typeof(any ptr)
'Catch incomplete type errors
#error Incomplete type,
#error _FOREACH_VARIABLE_ID2 cannot be set to the "any" type
#error change return type of procedure _FOREACH_ITERATOR.ForEachNextArg2 or explicitly specify type
#else
var byref _FOREACH_VARIABLE_ID2 = *_FOREACHPTR##_FOREACH_VARIABLE_ID2
#endif
#else
dim byref _FOREACH_VARIABLE_ID2 as _FOREACH_VARIABLE_TYPE2 = *cast(_FOREACH_VARIABLE_TYPE2 ptr, _FOREACHPTR##_FOREACH_VARIABLE_ID2)
#endif
#endif
#if _FOREACH_VARIABLE_COUNT = 4
_FOREACHPTR##_FOREACH_VARIABLE_ID3 = _FOREACH_ITERATOR.ForEachNextArg3(_FOREACH_INTERNAL_INDEX, _FOREACHPTR##_FOREACH_VARIABLE_ID3)
#if _FOREACH_IS_VAR3
#if typeof(_FOREACHPTR##_FOREACH_VARIABLE_ID3) = typeof(any ptr)
'Catch incomplete type errors
#error Incomplete type,
#error _FOREACH_VARIABLE_ID3 cannot be set to the "any" type
#error change return type of procedure _FOREACH_ITERATOR.ForEachNextArg3 or explicitly specify type
#else
var byref _FOREACH_VARIABLE_ID3 = *_FOREACHPTR##_FOREACH_VARIABLE_ID3
#endif
#else
dim byref _FOREACH_VARIABLE_ID3 as _FOREACH_VARIABLE_TYPE3 = *cast(_FOREACH_VARIABLE_TYPE3 ptr, _FOREACHPTR##_FOREACH_VARIABLE_ID3)
#endif
#endif
#if _FOREACH_HAS_INDEX
'Keep the user facing index on the previous loops value
'This is what the user expects, as the alternative is seeing
'the index as +1 per iteration.
'This also works with the internal variables as I reused
'the _FOREACH_VARIABLE_IDINDEX token to just be an integer
'if an index wasn't explicitly declared
_FOREACH_VARIABLE_IDINDEX = _FOREACH_INTERNAL_INDEX
#endif
'Increment the internal index past our item
_FOREACH_INTERNAL_INDEX += 1
'All set!
#endmacro
'The ? allows the parenthesis to be optional
#macro FOREACH ? (ARGS...)
#if __FB_ARG_COUNT__(ARGS) < 1
#error "Insufficient arguments, expected FOREACH( <[variable as type | var variable], ...> <in iterator> [: index as integer] )"
#endif
_FOREACH_BUILD_LOOP(ARGS)
#endmacro
#macro FOREACH_NEXT
wend
end scope
#endmacro
'EXAMPLES
'A test of the max positional arguments
type MultiListType
const count as integer = 2
dim x(count) as string
dim y(count) as integer
dim z(count) as single ptr
dim a(count) as any ptr
declare function ForEachNextArg0(byref i as integer, a as string ptr) as string ptr
declare function ForEachNextArg1(i as integer, b as integer ptr) as integer ptr
declare function ForEachNextArg2(i as integer, c as single ptr ptr) as single ptr ptr
declare function ForEachNextArg3(i as integer, d as any ptr) as any ptr ptr
end type
function MultiListType.ForEachNextArg0(byref i as integer, a as string ptr) as string ptr
if i > count then
return 0
end if
return @this.x(i)
end function
function MultiListType.ForEachNextArg1(i as integer, b as integer ptr) as integer ptr
return @this.y(i)
end function
function MultiListType.ForEachNextArg2(i as integer, c as single ptr ptr) as single ptr ptr
return @this.z(i)
end function
function MultiListType.ForEachNextArg3(i as integer, d as any ptr) as any ptr ptr
return @this.a(i)
end function
type DictionaryType
const count as integer = 9
dim keys(count) as string
dim vals(count) as single
declare function ForEachNextArg0(byref i as integer, key as string ptr) as string ptr
declare function ForEachNextArg1(i as integer, value as single ptr) as single ptr
end type
function DictionaryType.ForEachNextArg0(byref i as integer, key as string ptr) as string ptr
'Search for the next item in the sparse array
while i <= this.count ANDALSO this.keys(i) = ""
'Increment the index, this is BYREF!!!
'Thus the changes will be visible outside this function
i += 1
wend
'Return if we've gone over every item
if i > this.count then
return 0
end if
'Return our item
return @this.keys(i)
end function
function DictionaryType.ForEachNextArg1(i as integer, val as single ptr) as single ptr
'Index is the same as was passed onto from ForNextArg0
print "index: ";i
return @this.vals(i)
end function
type ErasedType
const count as integer = 4
'Pretend this uses actual type erasure...
dim array1(sizeof(string) * count) as ubyte
dim array2(sizeof(single) * count) as ubyte
declare function ForEachNextArg0(byref i as integer, in as any ptr) as any ptr
declare function ForEachNextArg1(i as integer, in as any ptr) as any ptr
end type
function ErasedType.ForEachNextArg0(byref i as integer, in as any ptr) as any ptr
if i >= count then
return 0
end if
return cast(any ptr, @this.array1(i * sizeof(string)))
end function
function ErasedType.ForEachNextArg1(i as integer, in as any ptr) as any ptr
return cast(any ptr, @this.array2(i * sizeof(single)))
end function
'Max variable iteration test
dim list as MultiListType
list.x(0) = "asdf"
list.x(1) = "zcxv"
list.x(2) = "qwer"
list.y(0) = 1
list.y(1) = 2
list.y(2) = 3
list.z(0) = cast(single ptr, &hffff0000)
list.z(1) = cast(single ptr, &hf0f0f0f0)
list.z(2) = cast(single ptr, &habcdef00)
list.a(0) = cast(any ptr, &h12345678)
list.a(1) = cast(any ptr, &h88888888)
list.a(2) = cast(any ptr, &h55555555)
'Also acceptable (preferrable sometimes), explicit types:
'FOREACH a as string, b as integer, c as single ptr, d as any ptr in list with i as integer
'Also doable, explicit starting index
'FOREACH var a, var b, var c, var d in list with i as integer = 1
FOREACH var a, var b, var c, var d in list with i as integer
print a;" ";b;" ";hex(c);" ";hex(d)
#print typeof(a)
#print typeof(b)
#print typeof(c)
#print typeof(d)
print "list index: ";i
FOREACH_NEXT
print
'Sparse data set test (dictionary)
dim dict as DictionaryType
'Pretend we hashed some values into it
dict.keys(1) = "hello"
dict.vals(1) = 1.1111
dict.keys(4) = "from"
dict.vals(4) = 3.14159
dict.keys(7) = "for"
dict.vals(7) = 8.675309
dict.keys(9) = "each"
dict.vals(9) = 0.9999999
'Demonstrate sparse iteration
foreach var key, var value in dict with i as integer
print "key: ";key;" value: ";value;" index: ";i
foreach_next
print
'Index is optional
foreach var key, var value in dict
print "key: ";key;" value: ";value
foreach_next
print
'Type erasure test
dim erased as ErasedType
dim as string ptr arr1 = cast(string ptr, @erased.array1(0))
dim as single ptr arr2 = cast(single ptr, @erased.array2(0))
arr1[0] = "type"
arr1[1] = "erasure"
arr1[2] = "is kinda"
arr1[3] = "neat"
arr2[0] = 9.8
arr2[1] = 7.6
arr2[2] = 5.4
arr2[3] = 3.2
'Illegal, if the return type of the ForNext is "any ptr", then
'you must specify the actual type you expect to use
'FOREACH var s, var f in erased
FOREACH s as string, f as single in erased
print s;": ";f
FOREACH_NEXT
#endif