113 lines
5.8 KiB
Text
113 lines
5.8 KiB
Text
Rebol [
|
|
title: "Rosetta code: Parsing/Shunting-yard algorithm"
|
|
file: %Parsing-Shunting-yard_algorithm.r3
|
|
url: https://rosettacode.org/wiki/Parsing-Shunting-yard_algorithm
|
|
needs: 3.15.0 ;; or something like that
|
|
note: "Based on Red language solution (Hinjolicious)!"
|
|
purpose: {Shunting-Yard Infix to RPN - Hinjo, July 2025}
|
|
]
|
|
; no error handling, assumed expr is spaced and correct
|
|
shunting: function/with [expr [string!] /trace] [
|
|
output: copy [] ops: copy []
|
|
stats: either trace [:print-stats][none]
|
|
tokens: split expr " "
|
|
while [not empty? tokens] [
|
|
tok: first tokens tokens: next tokens
|
|
case [
|
|
find "0123456789" tok [ ; add numbers to output
|
|
act: "(a) Add number to output"
|
|
append output tok
|
|
stats tok
|
|
]
|
|
find "(" tok [ ; push "(" to stack
|
|
act: "(b) Push ( to stack"
|
|
append ops tok
|
|
stats tok
|
|
]
|
|
find ")" tok [ ; pop stack to output until "("
|
|
while [(last ops) <> "("] [ ; assume input is correct!
|
|
act: "(c) Pop op to output"
|
|
append output (take/last ops)
|
|
stats tok
|
|
]
|
|
act: "(d) Discard ( from stack"
|
|
take/last ops
|
|
stats SP ; should be ")"
|
|
]
|
|
find "+-*/^^" tok [
|
|
; Pop higher or equal-left operators from stack
|
|
while [not empty? ops] [
|
|
last-op: last ops
|
|
if any [
|
|
none? last-op
|
|
last-op == "(" ; skip, we're in ()
|
|
prec/:last-op < prec/:tok
|
|
asc/:last-op <> "L"
|
|
][ break ]
|
|
act: "(e) Pop higher/equal op to output" append output take/last ops stats SP
|
|
]
|
|
; Now push current operator
|
|
act: "(f) Push op to stack"
|
|
append ops tok
|
|
stats tok
|
|
]
|
|
]
|
|
]
|
|
; flush the stack to output
|
|
act: "Finished. Flush ops:" stats SP
|
|
while [not empty? ops] [
|
|
act: "(g) Pop op to output"
|
|
append output (take/last ops)
|
|
stats SP
|
|
]
|
|
; return output
|
|
form output
|
|
][
|
|
output: ops: tokens: act: none
|
|
prec: #["+" 2 "-" 2 "*" 3 "/" 3 "^^" 4 ] ; precedence
|
|
asc: #["+" "L" "-" "L" "*" "L" "/" "L" "^^" "R"] ; association
|
|
|
|
print-stats: function [t] [ ; display basic tracing
|
|
print [t "|" pad act 35 "|" pad (form output) 30 pad (reverse form ops) -15]
|
|
]
|
|
]
|
|
|
|
context [
|
|
; assumed input is space separated! ('^' is escape char!)
|
|
print "Some test for input and output with trace:"
|
|
print ["^/" s: "3 + 4 * 2 / ( 1 - 5 ) ^^ 2 ^^ 3"] shunting/trace s
|
|
print ["^/" s: "( ( 1 + 2 ) ^^ ( 3 + 4 ) ) ^^ ( 5 + 6 )"] shunting/trace s
|
|
print ["^/" s: "1 + 2 * 3 / 4 + 5"] shunting/trace s
|
|
|
|
check: function [s t u][
|
|
print [pad s 40 "|" pad t 30 "|" pad u 30 "|" t = u]
|
|
]
|
|
|
|
print "^/Print input, validation and the output:"
|
|
s: "1 + 2 * 3 / 4 + 5" t: "1 2 3 * 4 / + 5 +" u: shunting s check s t u
|
|
s: "3 + 4 * 2 / ( 1 - 5 ) ^^ 2 ^^ 3" t: "3 4 2 * 1 5 - 2 3 ^^ ^^ / +" u: shunting s check s t u
|
|
s: "( ( 1 + 2 ) ^^ ( 3 + 4 ) ) ^^ ( 5 + 6 )" t: "1 2 + 3 4 + ^^ 5 6 + ^^" u: shunting s check s t u
|
|
s: "( 1 + 2 ) ^^ ( 3 + 4 ) ^^ ( 5 + 6 )" t: "1 2 + 3 4 + 5 6 + ^^ ^^" u: shunting s check s t u
|
|
s: "( ( 3 ^^ 4 ) ^^ 2 ^^ 9 ) ^^ 2 ^^ 5" t: "3 4 ^^ 2 9 ^^ ^^ 2 5 ^^ ^^" u: shunting s check s t u
|
|
s: "( 1 + 4 ) * ( 5 + 3 ) * 2 * 3" t: "1 4 + 5 3 + * 2 * 3 *" u: shunting s check s t u
|
|
s: "1 * 2 * 3 * 4" t: "1 2 * 3 * 4 *" u: shunting s check s t u
|
|
s: "1 + 2 + 3 + 4" t: "1 2 + 3 + 4 +" u: shunting s check s t u
|
|
s: "( 1 + 2 ) ^^ ( 3 + 4 )" t: "1 2 + 3 4 + ^^" u: shunting s check s t u
|
|
s: "( 5 ^^ 6 ) ^^ 7" t: "5 6 ^^ 7 ^^" u: shunting s check s t u
|
|
s: "5 ^^ 4 ^^ 3 ^^ 2" t: "5 4 3 2 ^^ ^^ ^^" u: shunting s check s t u
|
|
s: "1 + 2 + 3" t: "1 2 + 3 +" u: shunting s check s t u
|
|
s: "1 ^^ 2 ^^ 3" t: "1 2 3 ^^ ^^" u: shunting s check s t u
|
|
s: "( 1 ^^ 2 ) ^^ 3" t: "1 2 ^^ 3 ^^" u: shunting s check s t u
|
|
s: "1 - 1 + 3" t: "1 1 - 3 +" u: shunting s check s t u
|
|
s: "3 + 1 - 1" t: "3 1 + 1 -" u: shunting s check s t u
|
|
s: "1 - ( 2 + 3 )" t: "1 2 3 + -" u: shunting s check s t u
|
|
s: "4 + 3 + 2" t: "4 3 + 2 +" u: shunting s check s t u
|
|
s: "5 + 4 + 3 + 2" t: "5 4 + 3 + 2 +" u: shunting s check s t u
|
|
s: "5 * 4 * 3 * 2" t: "5 4 * 3 * 2 *" u: shunting s check s t u
|
|
s: "5 + 4 - ( 3 + 2 )" t: "5 4 + 3 2 + -" u: shunting s check s t u
|
|
s: "3 - 4 * 5" t: "3 4 5 * -" u: shunting s check s t u
|
|
s: "3 * ( 4 - 5 )" t: "3 4 5 - *" u: shunting s check s t u
|
|
s: "( 3 - 4 ) * 5" t: "3 4 - 5 *" u: shunting s check s t u
|
|
s: "4 * 2 + 1 - 5" t: "4 2 * 1 + 5 -" u: shunting s check s t u
|
|
s: "4 * 2 / ( 1 - 5 ) ^^ 2" t: "4 2 * 1 5 - 2 ^^ /" u: shunting s check s t u
|
|
]
|