Rebol3 Code Examplex


Parsing/Shunting-yard algorithm

Convert expressions using the Shunting-yard method.

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
]