RosettaCodeData/Task/Parsing-Shunting-yard-algor.../FreeBASIC/parsing-shunting-yard-algor...

122 lines
2.8 KiB
Plaintext

Dim Shared As String stack, queue, token
stack = ""
queue = ""
token = "#"
Function word_(s As String, n As Integer, sep As String = " ") As String
Dim As Integer pio, cnt, posic, i
pio = 1 : cnt = 0 : posic = 0
For i = 1 To Len(s)
If Mid(s, i, Len(sep)) = sep Then
cnt += 1
If cnt = n - 1 Then pio = i + Len(sep)
If cnt = n Then posic = i: Exit For
End If
Next
If cnt < n Then Return ""
If posic = 0 Then posic = Len(s) + 1
Return Mid(s, pio, posic - pio)
End Function
Sub stackPush(s As String)
stack = s & "|" & stack
End Sub
Sub queuePush(s As String)
queue = queue & s & "|"
End Sub
Function queuePop() As String
Dim As String result = word_(queue, 1, "|")
queue = Mid(queue, Instr(queue, "|") + 1)
Return result
End Function
Function isOperator(op As String) As Boolean
Return Instr("+-*/^", op) <> 0 And Len(op) = 1
End Function
Function precedence(op As String) As Integer
If isOperator(op) Then
Return 1 + (Instr("+-*/^", op) <> 0) + (Instr("*/^", op) <> 0) + (Instr("^", op) <> 0)
End If
End Function
Function stackPop() As String
Dim As String result = word_(stack, 1, "|")
stack = Mid(stack, Instr(stack, "|") + 1)
Return result
End Function
Function stackPeek() As String
Return word_(stack, 1, "|")
End Function
Function reverse(s As String) As String
Dim As String result = ""
Dim As String token = "#"
Dim As Integer i = 0
While token <> ""
i += 1
token = word_(s, i, "|")
result = token & " " & result
Wend
Return result
End Function
Dim As String test = "3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3"
Print !"Input:\n"; test; !"\nNo", "token", "stack", "queue"
Dim As Integer i = 0
Do
i += 1
token = word_(test, i)
If token = "" Then Exit Do
Print i, token, reverse(stack), queue
Select Case token
Case "("
stackPush(token)
Case ")"
While stackPeek() <> "("
If stack = "" Then Print "Error: no matching '(' for token "; i: Sleep: End
queuePush(stackPop())
Wend
Dim As String discard = stackPop() 'discard "("
Case Else
If isOperator(token) Then
Dim As String op1 = token
While isOperator(stackPeek())
Dim As String op2 = stackPeek()
If op2 <> "^" And precedence(op1) = precedence(op2) Then
queuePush(stackPop())
Else
Exit While
End If
Wend
stackPush(op1)
Else 'number
queuePush(token)
End If
End Select
Loop
While stack <> ""
If stackPeek() = "(" Then Print "no matching ')'": Sleep:End
queuePush(stackPop())
Wend
Print !"\nOutput:"
While queue <> ""
Print queuePop(); " ";
Wend
Sleep