aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-04-30 12:34:36 -04:00
parent 4bb20c9b71
commit cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions
Download patch file Download diff file Expand all files Collapse all files

117
Task/Arithmetic-evaluation/Rebol/arithmetic-evaluation.rebol Normal file
View file

@ -0,0 +1,117 @@
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: "Ported 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]