114 lines
4.0 KiB
Plaintext
114 lines
4.0 KiB
Plaintext
Red [ "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 [expr [string!] /trace] [
|
|
output: copy [] ops: copy []
|
|
prec: #["+" 2 "-" 2 "*" 3 "/" 3 "^^" 4]
|
|
asc: #["+" "L" "-" "L" "*" "L" "/" "L" "^^" "R"]
|
|
|
|
stats: function [t] [
|
|
if not trace [exit]
|
|
print [t "|" pad act 25 "|" pad (mold output) 45 pad/left (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
|
|
]
|
|
|
|
tokens: split expr " "
|
|
while [not empty? tokens] [
|
|
tok: first tokens tokens: next tokens
|
|
case [
|
|
find "0123456789" tok [
|
|
act: "1.Push number as value"
|
|
append output load 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 [
|
|
|
|
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"))
|
|
]
|
|
|
|
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
|
|
]
|
|
|
|
; 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 print [pad s 40 " ==> " pad (mold se) 45 " = " s-eval se]
|
|
s: "1 + 2 * 3" se: s-expr s print [pad s 40 " ==> " pad (mold se) 45 " = " s-eval se]
|
|
s: "( 1 + 2 ) * 3" se: s-expr s print [pad s 40 " ==> " pad (mold se) 45 " = " s-eval se]
|
|
s: "( 1 + 2 * 3 ) / 2" se: s-expr s print [pad s 40 " ==> " pad (mold se) 45 " = " s-eval se]
|
|
|
|
print "^/Complex ones:"
|
|
s: "3 + 4 * 2 / ( 1 - 5 ) ^^ 2 ^^ 3" se: s-expr s print [pad s 40 " ==> " pad (mold se) 45 " = " s-eval se]
|
|
s: "( 1 + 2 * 3 ) ^^ 2 / 6 ^^ 2 ^^ 3 - 1" se: s-expr s print [pad s 40 " ==> " pad (mold se) 45 " = " 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]
|