1
1
Fork 0
mirror of https://github.com/QB64-Phoenix-Edition/QB64pe.git synced 2024-09-09 12:50:17 +00:00
QB64-PE/source/utilities/elements.bas
Matthew Kilgore 83533dc319 Add support for optional function arguments
Currently functions only have very limited optional argument support,
this expands it so that we can have more complex sets of optional
arguments for functions, such as multiple arguments where not all need
to be provided. This will be used in the future for some upcoming
functionality.

Note that this does not support any generic optional argument format,
the commas always have to be provided unless an optional argument is at
the end of the parameter list. Thus, if you have a format with two
optional arguments and you want to omit the second, then you need to call
it as 'foo(2, , 3)`, rather than `foo(2, 3)`. This is important for
avoiding ambiguous situations, and is how many SUBs currently function.

The two functions that violate that requirement are INSTR() and
_INSTRREV(), which use the format `[?],?,?` and allow omitting the comma
for the first argument. This format is simply handled as a special case.

Fixes: #303
2023-02-12 22:38:50 -05:00

305 lines
8.1 KiB
QBasic

FUNCTION getelement$ (a$, elenum)
IF a$ = "" THEN EXIT FUNCTION 'no elements!
n = 1
p = 1
getelementnext:
i = INSTR(p, a$, sp)
IF elenum = n THEN
IF i THEN
getelement$ = MID$(a$, p, i - p)
ELSE
getelement$ = RIGHT$(a$, LEN(a$) - p + 1)
END IF
EXIT FUNCTION
END IF
IF i = 0 THEN EXIT FUNCTION 'no more elements!
n = n + 1
p = i + 1
GOTO getelementnext
END FUNCTION
FUNCTION getelements$ (a$, i1, i2)
IF i2 < i1 THEN getelements$ = "": EXIT FUNCTION
n = 1
p = 1
getelementsnext:
i = INSTR(p, a$, sp)
IF n = i1 THEN
i1pos = p
END IF
IF n = i2 THEN
IF i THEN
getelements$ = MID$(a$, i1pos, i - i1pos)
ELSE
getelements$ = RIGHT$(a$, LEN(a$) - i1pos + 1)
END IF
EXIT FUNCTION
END IF
n = n + 1
p = i + 1
GOTO getelementsnext
END FUNCTION
SUB insertelements (a$, i, elements$)
IF i = 0 THEN
IF a$ = "" THEN
a$ = elements$
EXIT SUB
END IF
a$ = elements$ + sp + a$
EXIT SUB
END IF
a2$ = ""
n = numelements(a$)
FOR i2 = 1 TO n
IF i2 > 1 THEN a2$ = a2$ + sp
a2$ = a2$ + getelement$(a$, i2)
IF i = i2 THEN a2$ = a2$ + sp + elements$
NEXT
a$ = a2$
END SUB
FUNCTION numelements (a$)
IF a$ = "" THEN EXIT FUNCTION
n = 1
p = 1
numelementsnext:
i = INSTR(p, a$, sp)
IF i = 0 THEN numelements = n: EXIT FUNCTION
n = n + 1
p = i + 1
GOTO numelementsnext
END FUNCTION
SUB removeelements (a$, first, last, keepindexing)
a2$ = ""
'note: first and last MUST be valid
' keepindexing means the number of elements will stay the same
' but some elements will be equal to ""
n = numelements(a$)
FOR i = 1 TO n
IF i < first OR i > last THEN
a2$ = a2$ + sp + getelement(a$, i)
ELSE
IF keepindexing THEN a2$ = a2$ + sp
END IF
NEXT
IF LEFT$(a2$, 1) = sp THEN a2$ = RIGHT$(a2$, LEN(a2$) - 1)
a$ = a2$
END SUB
' a$ should be a function argument list
' Returns number of function arguments (including empty ones) in the provided list
FUNCTION countFunctionElements (a$)
Dim count As Long, p As Long, lvl As Long
p = 1
lvl = 1
i = 0
if Len(a$) = 0 Then
countFunctionElements = 0
Exit Function
End If
Do
Select Case Asc(a$, i + 1)
Case Asc("("):
lvl = lvl + 1
Case Asc(")"):
lvl = lvl - 1
Case Asc(","):
If lvl = 1 Then
count = count + 1
End If
End Select
i = INSTR(p, a$, sp)
if i = 0 Then
Exit Do
End If
p = i + 1
Loop
' Make sure to count the argument after the last comma
countFunctionElements = count + 1
END FUNCTION
' a$ should be a function argument list
' Returns true if the argument was provided in the list
FUNCTION hasFunctionElement(a$, element)
Dim count As Long, p As Long, lvl As Long
start = 0
p = 1
lvl = 1
i = 1
if Len(a$) = 0 Then
hasFunctionElement = 0
Exit Function
End If
' Special case for a single provided argument
If INSTR(a$, sp) = 0 And Len(a$) <> 0 Then
hasFunctionElement = element = 1
Exit Function
End If
Do
If i > Len(a$) Then
Exit Do
End If
Select Case Asc(a$, i)
Case Asc("("):
lvl = lvl + 1
Case Asc(")"):
lvl = lvl - 1
Case Asc(","):
If lvl = 1 Then
count = count + 1
If element = count Then
' We have a element here if there's any elements
' inbetween the previous comma and this one
hasFunctionElement = (i <> 1) And (i - 2 <> start)
Exit Function
End If
start = i
End If
End Select
p = i
i = INSTR(i, a$, sp)
if i = 0 Then
Exit Do
End If
i = i + 1
Loop
If element > count + 1 Then
hasFunctionElement = 0
Exit Function
End If
' Check if last argument was provided.
'
' Syntax '2,3' has two arguments, the '3' argument is what gets compared here
' Syntax '2,' has one argument, the comma is the last element so it fails this check.
If p > 0 Then
If Asc(a$, p) <> Asc(",") Then
hasFunctionElement = -1
Exit Function
End If
End If
hasFunctionElement = 0
END FUNCTION
' Returns true if the provided arguments are a valid set for the given function format
' firstOptionalArgument returns the index of the first argument that is optional
FUNCTION isValidArgSet(format As String, providedArgs() As Long, firstOptionalArgument As Long)
Dim maxArgument As Long, i As Long
Dim currentArg As Long, optionLvl As Long
Dim wasProvided(0 To 10) As Long
Dim As Long ArgProvided , ArgNotProvided, ArgIgnored
ArgProvided = -1
ArgNotProvided = 0
ArgIgnored = -2
firstOptionalArgument = 0
wasProvided(0) = ArgIgnored
' Inside of each set of brackets, all arguments must either be provide or not provided, with no mixing.
' For nested brackets, if the argument(s) inside the nested brackets are
' provided, then the arguments inside the outer brackets also have to be
' provided. Ex:
'
' x[,y[,z]]
'
' When x is provided, y and z are optional, but when y is provided x is required.
' When z is provided both y and x are required.
maxArgument = UBOUND(providedArgs)
For i = 1 to Len(format)
Select Case Asc(format, i)
Case Asc("["):
optionLvl = optionLvl + 1
wasProvided(optionLvl) = ArgIgnored
Case Asc("]"):
optionLvl = optionLvl - 1
If wasProvided(optionLvl) = ArgIgnored Then
' If not provided, then we stay in the ignored state
' because whether this arg set was provided does not matter
' for the rest of the parsing
If wasProvided(optionLvl + 1) = ArgProvided Then
wasProvided(optionLvl) = ArgProvided
End If
Else
' If an arg at this level was already not provided, then
' this optional set can't be provided either
if wasProvided(optionLvl) = ArgNotProvided And wasProvided(optionLvl + 1) = ArgProvided Then
isValidArgSet = 0
EXIT FUNCTION
End If
End If
Case Asc("?"):
currentArg = currentArg + 1
if optionLvl >= 1 And firstOptionalArgument = 0 Then firstOptionalArgument = currentArg
if wasProvided(optionLvl) = ArgIgnored Then
If maxArgument >= currentArg Then
wasProvided(optionLvl) = providedArgs(currentArg)
else
wasProvided(optionLvl) = 0
End If
else
if maxArgument < currentArg Then
If wasProvided(optionLvl) <> ArgNotProvided Then
isValidArgSet = 0
Exit Function
End If
Elseif wasProvided(optionLvl) <> providedArgs(currentArg) Then
isValidArgSet = 0
EXIT FUNCTION
End If
End If
End Select
Next
' The base level of arguments are required. They can be in the
' 'ignored' state though if all arguments are within brackets
if currentArg < maxArgument Or wasProvided(0) = ArgNotProvided then
isValidArgSet = 0
Exit Function
End If
isValidArgSet = -1
END FUNCTION