Data update
This commit is contained in:
Ingy döt Net
parent
4d5544505c
commit
4924dd0264
3073 changed files with 55820 additions and 4408 deletions
|
|
@ -1,7 +1,11 @@
|
|||
INT base=10;
|
||||
MODE FIXED = LONG REAL; # numbers in the format 9,999.999 #
|
||||
|
||||
#IF build abstract syntax tree and then EVAL tree #
|
||||
# set the error handler to the default error handler #
|
||||
PROC eval error := ( STRING message )VOID: (print(("****",message,newline)); stop);
|
||||
# sets the eval error handler #
|
||||
PROC on eval error = ( PROC(STRING)VOID handler )VOID: eval error := handler;
|
||||
|
||||
MODE AST = UNION(NODE, FIXED);
|
||||
MODE NUM = REF AST;
|
||||
MODE NODE = STRUCT(NUM a, PROC (FIXED,FIXED)FIXED op, NUM b);
|
||||
|
|
@ -9,23 +13,20 @@ MODE NODE = STRUCT(NUM a, PROC (FIXED,FIXED)FIXED op, NUM b);
|
|||
OP EVAL = (NUM ast)FIXED:(
|
||||
CASE ast IN
|
||||
(FIXED num): num,
|
||||
(NODE fork): (op OF fork)(EVAL( a OF fork), EVAL (b OF fork))
|
||||
(NODE tree): (op OF tree)(EVAL(a OF tree), EVAL (b OF tree))
|
||||
ESAC
|
||||
);
|
||||
|
||||
OP + = (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED a,b)FIXED:a+b, b) );
|
||||
OP - = (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED a,b)FIXED:a-b, b) );
|
||||
OP * = (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED a,b)FIXED:a*b, b) );
|
||||
OP / = (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED a,b)FIXED:a/b, b) );
|
||||
OP **= (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED a,b)FIXED:a**b, b) );
|
||||
OP + = (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED x,y)FIXED:x+y, b) );
|
||||
OP - = (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED x,y)FIXED:x-y, b) );
|
||||
OP * = (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED x,y)FIXED:x*y, b) );
|
||||
OP / = (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED x,y)FIXED:x/y, b) );
|
||||
OP **= (NUM a,b)NUM: ( HEAP AST := NODE(a, (FIXED x,y)FIXED:x**y, b) );
|
||||
|
||||
#ELSE simply use REAL arithmetic with no abstract syntax tree at all # CO
|
||||
MODE NUM = FIXED, AST = FIXED;
|
||||
OP EVAL = (FIXED num)FIXED: num;
|
||||
#FI# END CO
|
||||
AST error value := FIXED(-1);
|
||||
|
||||
MODE LEX = PROC (TOK)NUM;
|
||||
MODE MONADIC =PROC (NUM)NUM;
|
||||
MODE MONADIC = PROC (NUM)NUM;
|
||||
MODE DIADIC = PROC (NUM,NUM)NUM;
|
||||
|
||||
MODE TOK = CHAR;
|
||||
|
|
@ -40,8 +41,6 @@ MODE STACKACTION = PROC (REF STACKITEM)VOID;
|
|||
PROC begin = (REF STACKITEM top)VOID: prio OF op OF top -:= +10;
|
||||
PROC end = (REF STACKITEM top)VOID: prio OF op OF top -:= -10;
|
||||
|
||||
OP ** = (COMPL a,b)COMPL: complex exp(complex ln(a)*b);
|
||||
|
||||
[8]OPITEM op list :=(
|
||||
# OP PRIO ACTION #
|
||||
("^", (8, (NUM a,b)NUM: a**b)),
|
||||
|
|
@ -124,19 +123,19 @@ PROC build ast = (STRING expr)NUM:(
|
|||
(MONADIC): SKIP, # not implemented #
|
||||
(DIADIC):(
|
||||
value := compress ast stack(prio OF this op, value);
|
||||
IF top=UPB stack THEN index error FI;
|
||||
IF top=UPB stack THEN eval error("Stack overflow");GOTO index error FI;
|
||||
stack[top+:=1]:=STACKITEM(value, this op);
|
||||
value:=NIL
|
||||
)
|
||||
ESAC
|
||||
OD;
|
||||
compress ast stack(-max int, value)
|
||||
EXIT index error: error value
|
||||
);
|
||||
|
||||
test:(
|
||||
printf(($" euler's number is about: "g(-long real width,long real width-2)l$,
|
||||
EVAL build ast("1+1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+1/15)/14)/13)/12)/11)/10)/9)/8)/7)/6)/5)/4)/3)/2")));
|
||||
SKIP EXIT
|
||||
index error:
|
||||
printf(("Stack over flow"))
|
||||
#test#(
|
||||
on eval error( (STRING m)VOID: ( print(("EVAL error: ",m,newline));stop ) );
|
||||
FIXED eval result
|
||||
= EVAL build ast("1+1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+1/15)/14)/13)/12)/11)/10)/9)/8)/7)/6)/5)/4)/3)/2");
|
||||
print((" euler's number is about: ", fixed(eval result,-long real width,long real width-2), newline))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -94,10 +94,10 @@ singleton operatorState
|
|||
eval(ch)
|
||||
{
|
||||
ch =>
|
||||
$40 { // (
|
||||
$40 : { // (
|
||||
^ weak self.newBracket().gotoStarting()
|
||||
}
|
||||
! {
|
||||
! : {
|
||||
^ weak self.newToken().append(ch).gotoToken()
|
||||
}
|
||||
}
|
||||
|
|
@ -108,22 +108,22 @@ singleton tokenState
|
|||
eval(ch)
|
||||
{
|
||||
ch =>
|
||||
$41 { // )
|
||||
$41 : { // )
|
||||
^ weak self.closeBracket().gotoToken()
|
||||
}
|
||||
$42 { // *
|
||||
$42 : { // *
|
||||
^ weak self.newProduct().gotoOperator()
|
||||
}
|
||||
$43 { // +
|
||||
$43 : { // +
|
||||
^ weak self.newSummary().gotoOperator()
|
||||
}
|
||||
$45 { // -
|
||||
$45 : { // -
|
||||
^ weak self.newDifference().gotoOperator()
|
||||
}
|
||||
$47 { // /
|
||||
$47 : { // /
|
||||
^ weak self.newFraction().gotoOperator()
|
||||
}
|
||||
! {
|
||||
! : {
|
||||
^ weak self.append(ch)
|
||||
}
|
||||
}
|
||||
|
|
@ -134,13 +134,13 @@ singleton startState
|
|||
eval(ch)
|
||||
{
|
||||
ch =>
|
||||
$40 { // (
|
||||
$40 : { // (
|
||||
^ weak self.newBracket().gotoStarting()
|
||||
}
|
||||
$45 { // -
|
||||
$45 : { // -
|
||||
^ weak self.newToken().append("0").newDifference().gotoOperator()
|
||||
}
|
||||
! {
|
||||
! : {
|
||||
^ weak self.newToken().append(ch).gotoToken()
|
||||
}
|
||||
}
|
||||
|
|
@ -148,11 +148,11 @@ singleton startState
|
|||
|
||||
class Scope
|
||||
{
|
||||
object _state;
|
||||
int _level;
|
||||
object _parser;
|
||||
object _token;
|
||||
object _expression;
|
||||
object _state;
|
||||
int _level;
|
||||
object _parser;
|
||||
object? _token;
|
||||
object _expression;
|
||||
|
||||
constructor new(parser)
|
||||
{
|
||||
|
|
@ -327,15 +327,15 @@ public program()
|
|||
var text := new StringWriter();
|
||||
var parser := new Parser();
|
||||
|
||||
while (console.readLine().writeTo(text).Length > 0)
|
||||
while (Console.readLine().writeTo(text).Length > 0)
|
||||
{
|
||||
try
|
||||
{
|
||||
console.printLine("=",parser.run(text))
|
||||
Console.printLine("=",parser.run(text))
|
||||
}
|
||||
catch(Exception e)
|
||||
{
|
||||
console.writeLine("Invalid Expression")
|
||||
Console.writeLine("Invalid Expression")
|
||||
};
|
||||
|
||||
text.clear()
|
||||
|
|
|
|||
|
|
@ -0,0 +1,127 @@
|
|||
type
|
||||
IExprNode = interface
|
||||
function Evaluate: real;
|
||||
end;
|
||||
|
||||
NumberNode = auto class(IExprNode)
|
||||
public
|
||||
value: real;
|
||||
function Evaluate: real := value;
|
||||
end;
|
||||
|
||||
BinaryOpNode = auto class(IExprNode)
|
||||
public
|
||||
op: char;
|
||||
left, right: IExprNode;
|
||||
|
||||
function Evaluate: real;
|
||||
begin
|
||||
case op of
|
||||
'+': Result := left.Evaluate + right.Evaluate;
|
||||
'-': Result := left.Evaluate - right.Evaluate;
|
||||
'*': Result := left.Evaluate * right.Evaluate;
|
||||
'/': Result := left.Evaluate / right.Evaluate;
|
||||
else
|
||||
raise new Exception($'Unknown operator {op}');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
ExpressionParser = class
|
||||
s: string;
|
||||
pos: integer;
|
||||
|
||||
constructor Create(input: string);
|
||||
begin
|
||||
s := input;
|
||||
pos := 1;
|
||||
end;
|
||||
|
||||
function NextChar: char :=
|
||||
if pos <= s.Length then s[pos] else #0;
|
||||
|
||||
procedure SkipSpaces :=
|
||||
while NextChar = ' ' do pos += 1;
|
||||
|
||||
function ParseNumber: IExprNode;
|
||||
begin
|
||||
SkipSpaces;
|
||||
var start := pos;
|
||||
while NextChar.IsDigit do pos += 1;
|
||||
if NextChar = '.' then
|
||||
begin
|
||||
pos += 1;
|
||||
while NextChar.IsDigit do pos += 1;
|
||||
end;
|
||||
var value := s[start:pos].ToReal;
|
||||
Result := new NumberNode(value);
|
||||
end;
|
||||
|
||||
function ParseFactor: IExprNode;
|
||||
begin
|
||||
SkipSpaces;
|
||||
if NextChar = '(' then
|
||||
begin
|
||||
pos += 1;
|
||||
Result := ParseExpr;
|
||||
SkipSpaces;
|
||||
if NextChar = ')' then
|
||||
pos += 1
|
||||
else raise new Exception('Expected )');
|
||||
end
|
||||
else
|
||||
Result := ParseNumber;
|
||||
end;
|
||||
|
||||
function ParseTerm: IExprNode;
|
||||
begin
|
||||
Result := ParseFactor;
|
||||
while true do
|
||||
begin
|
||||
SkipSpaces;
|
||||
var ch := NextChar;
|
||||
if (ch = '*') or (ch = '/') then
|
||||
begin
|
||||
pos += 1;
|
||||
Result := new BinaryOpNode(ch, Result, ParseFactor);
|
||||
end
|
||||
else break;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ParseExpr: IExprNode;
|
||||
begin
|
||||
Result := ParseTerm;
|
||||
while true do
|
||||
begin
|
||||
SkipSpaces;
|
||||
var ch := NextChar;
|
||||
if (ch = '+') or (ch = '-') then
|
||||
begin
|
||||
pos += 1;
|
||||
Result := new BinaryOpNode(ch, Result, ParseTerm);
|
||||
end
|
||||
else break;
|
||||
end;
|
||||
end;
|
||||
|
||||
function Parse: IExprNode := ParseExpr;
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
var inputs := [
|
||||
'2+3*(4-1)',
|
||||
'10 + 2 / 3',
|
||||
'(7+3)*(2+2)',
|
||||
'8*(5+(2-3))',
|
||||
'1/3',
|
||||
'2.5 + 4.1 * (3 - 1.1/2)'];
|
||||
|
||||
foreach var expr in inputs do
|
||||
begin
|
||||
var parser := new ExpressionParser(expr);
|
||||
var tree := parser.Parse;
|
||||
Println($'{expr} = {tree.Evaluate:0.###}');
|
||||
end;
|
||||
end.
|
||||
49
Task/Arithmetic-evaluation/Perl/arithmetic-evaluation-2.pl
Normal file
49
Task/Arithmetic-evaluation/Perl/arithmetic-evaluation-2.pl
Normal file
|
|
@ -0,0 +1,49 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict; # https://rosettacode.org/wiki/Arithmetic_evaluation
|
||||
use warnings;
|
||||
|
||||
sub node { bless [ splice @_, 1 ], shift }
|
||||
sub error { die s/\G.*//sr =~ tr/\t/ /cr, "^ @_ !\n" }
|
||||
sub want { /\G$_[1]/gc ? shift : error pop }
|
||||
|
||||
sub expr
|
||||
{
|
||||
/\G\h+/gc;
|
||||
my $ast =
|
||||
/\G\d+/gc ? node NUMBER => $& :
|
||||
/\G\(/gc ? want expr(0), qr/\)/, 'Missing Right Paren' :
|
||||
error 'Operand Expected';
|
||||
/\G\h+/gc, $ast =
|
||||
$_[0] <= 0 && /\G\+/gc ? node ADD => $ast, expr(1) :
|
||||
$_[0] <= 0 && /\G\-/gc ? node SUBTRACT => $ast, expr(1) :
|
||||
$_[0] <= 1 && /\G\*/gc ? node MULTIPLY => $ast, expr(2) :
|
||||
$_[0] <= 1 && /\G\//gc ? node DIVIDE => $ast, expr(2) :
|
||||
return $ast while 1;
|
||||
}
|
||||
|
||||
sub ADD::value { $_[0][0]->value + $_[0][1]->value }
|
||||
sub SUBTRACT::value { $_[0][0]->value - $_[0][1]->value }
|
||||
sub MULTIPLY::value { $_[0][0]->value * $_[0][1]->value }
|
||||
sub DIVIDE::value { $_[0][0]->value / $_[0][1]->value }
|
||||
sub NUMBER::value { $_[0][0] }
|
||||
|
||||
sub NUMBER::show { "$_[0][0]\n" }
|
||||
sub UNIVERSAL::show
|
||||
{ ref($_[0]) . "\n" . join('', map $_->show, @{$_[0]}) =~ s/^/ /gmr }
|
||||
|
||||
while( <DATA> )
|
||||
{
|
||||
eval
|
||||
{
|
||||
print;
|
||||
my $ast = want expr(0), "\n", 'Incomplete Parse';
|
||||
print $ast->show, "value of ast = ", $ast->value, "\n\n";
|
||||
} or print "$@\n";
|
||||
}
|
||||
|
||||
__DATA__
|
||||
(1+3)*7
|
||||
2 * 3 + 4 * 5
|
||||
2 + 3 * 4 + 5
|
||||
2 + 3 ** 4 + 5
|
||||
113
Task/Arithmetic-evaluation/Red/arithmetic-evaluation.red
Normal file
113
Task/Arithmetic-evaluation/Red/arithmetic-evaluation.red
Normal file
|
|
@ -0,0 +1,113 @@
|
|||
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]
|
||||
Loading…
Add table
Add a link
Reference in a new issue