Rebol3 Code Examplex

Rebol [
    title: "Rosetta code: Arithmetic evaluation"
    file:  %Arithmetic_evaluation.r3
    url:   https://rosettacode.org/wiki/Arithmetic_evaluation
    needs: 3.15.0 ;; or something like that
    note: "Based on Red language solution (Hinjolicious)!"
    purpose: {
        Arithmetic Evaluator - Hinjo, August 2025
        Using a Modified Shunting-Yard algorithm to produce S-Expression as the AST
        and a simple S-Expression evaluator (recursive).
    }
]

s-expr: function/with [expr [string!] /trace] [
    output: copy []  ops: copy []
    tokens: split expr " "
    stats: either trace [:print-stats][none]
    while [not empty? tokens] [
        tok: first tokens  tokens: next tokens
        case [
            find "0123456789" tok [
                act: "1.Push number as value"
                append output to integer! tok
                stats tok
            ]
            tok = "(" [
                act: "2.Push ( to ops"
                append ops tok
                stats tok
            ]
            tok = ")" [
                while [(last ops) <> "("] [
                    act: "3.Pop op, build node"
                    append/only output make-node take/last ops
                    stats tok
                ]
                act: "4.Discard ("
                take/last ops
                stats tok
            ]
            find "+-*/^^" tok [
                while [popping] [
                    act: "5.Pop op, build node"
                    append/only output make-node take/last ops
                    stats tok
                ]
                act: "6.Push current op"
                append ops tok
                stats tok
            ]
        ]
    ]
    act: "7.Final flush ops"
    stats " "
    while [not empty? ops] [
        act: "8.Pop op, build node"
        append/only output make-node take/last ops
        stats " "
    ]
    output/1
][
    output: ops: act: tok: tokens: none
    prec: #["+" 2 "-" 2 "*" 3 "/" 3 "^^" 4]
    asc:  #["+" "L" "-" "L" "*" "L" "/" "L" "^^" "R"]
    print-stats: function [t] [
        print [t "|" pad act 25 "|" pad (mold output) 45 pad (reverse form ops) -15]
    ]
    make-node: function [op] [
        right: take/last output
        left: take/last output
        node: load rejoin ["[" op " " mold left " " mold right "]"]
        node
    ]
    popping: func [][
        if empty? ops [return false]
        if none? last ops [return false]
        last-op: last ops
        if last-op = ")" [return false]
        if none? prec/:last-op [return false]
        return (prec/:last-op > prec/:tok) 
            or ((prec/:last-op = prec/:tok) and (asc/:tok = "L"))
    ]
]

; basic s-expression evaluator
s-eval: function [expr][
    either block? expr [
        op: expr/1
        a: s-eval expr/2
        b: s-eval expr/3
        case [
            op = '+ [a + b]
            op = '- [a - b]
            op = '* [a * b]
            op = '/ [a / b]
            op = '^ [a ** b]
            true [do make error! rejoin ["Unknown operator: " mold op]]
        ]
    ][
        expr ; base case: just a number
    ]
]

print "Simple test:"
s: "1 + 2"                                 se: s-expr s  printf [40 " ==> " 45 " = "] reduce [s mold se s-eval se]
s: "1 + 2 * 3"                             se: s-expr s  printf [40 " ==> " 45 " = "] reduce [s mold se s-eval se]
s: "( 1 + 2 ) * 3"                         se: s-expr s  printf [40 " ==> " 45 " = "] reduce [s mold se s-eval se]
s: "( 1 + 2 * 3 ) / 2"                     se: s-expr s  printf [40 " ==> " 45 " = "] reduce [s mold se s-eval se]

print "^/Complex ones:"
s: "3 + 4 * 2 / ( 1 - 5 ) ^^ 2 ^^ 3"       se: s-expr s  printf [40 " ==> " 45 " = "] reduce [s mold se s-eval se]
s: "( 1 + 2 * 3 ) ^^ 2 / 6 ^^ 2 ^^ 3 - 1"  se: s-expr s  printf [40 " ==> " 45 " = "] reduce [s mold se s-eval se]

print "^/Some test for input and output with trace:"
print ["^/" s: "3 + 4 * 2 / ( 1 - 5 ) ^^ 2 ^^ 3"]           se: s-expr/trace s  print [s " ==> " mold se " = " s-eval se]
print ["^/" s: "( ( 1 + 2 ) ^^ ( 3 + 4 ) ) ^^ ( 5 + 6 )"]   se: s-expr/trace s  print [s " ==> " mold se " = " s-eval se]
print ["^/" s: "1 + 2 * 3 / 4 + 5"]                         se: s-expr/trace s  print [s " ==> " mold se " = " s-eval se]