Arithmetic evaluation: Difference between revisions

<lang algol68>INT base=10;

MODE FIXED = LONG REAL; # numbers in the format 9,999.999 #

#IF build abstract syntax tree and then EVAL tree #

MODE AST = UNION(NODE, FIXED);

MODE NUM = REF AST;

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))

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) );

#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

MODE LEX = PROC (TOK)NUM;

MODE MONADIC =PROC (NUM)NUM;

MODE DIADIC = PROC (NUM,NUM)NUM;

MODE TOK = CHAR;

MODE ACTION = UNION(STACKACTION, LEX, MONADIC, DIADIC);

MODE OPVAL = STRUCT(INT prio, ACTION action);

MODE OPITEM = STRUCT(TOK token, OPVAL opval);

[256]STACKITEM stack;

MODE STACKITEM = STRUCT(NUM value, OPVAL op);

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)),

("*", (7, (NUM a,b)NUM: a*b)),

("/", (7, (NUM a,b)NUM: a/b)),

("+", (6, (NUM a,b)NUM: a+b)),

("-", (6, (NUM a,b)NUM: a-b)),

("(",(+10, begin)),

(")",(-10, end)),

("?", (9, LEX:SKIP))

);

PROC op dict = (TOK op)REF OPVAL:(

# This can be unrolled to increase performance #

REF OPITEM candidate;

FOR i TO UPB op list WHILE

candidate := op list[i];

# WHILE # op /= token OF candidate DO

SKIP

OD;

opval OF candidate

);

PROC build ast = (STRING expr)NUM:(

INT top:=0;

PROC compress ast stack = (INT prio, NUM in value)NUM:(

NUM out value := in value;

FOR loc FROM top BY -1 TO 1 WHILE

REF STACKITEM stack top := stack[loc];

# WHILE # ( top >= LWB stack | prio <= prio OF op OF stack top | FALSE ) DO

top := loc - 1;

out value :=

CASE action OF op OF stack top IN

(MONADIC op): op(value OF stack top), # not implemented #

(DIADIC op): op(value OF stack top,out value)

ESAC

OD;

out value

);

NUM value := NIL;

FIXED num value;

INT decimal places;

FOR i TO UPB expr DO

TOK token = expr[i];

REF OPVAL this op := op dict(token);

CASE action OF this op IN

(STACKACTION action):(

IF prio OF thisop = -10 THEN

value := compress ast stack(0, value)

FI;

IF top >= LWB stack THEN

action(stack[top])

FI

),

(LEX):( # a crude lexer #

SHORT INT digit = ABS token - ABS "0";

IF 0<= digit AND digit < base THEN

IF NUM(value) IS NIL THEN # first digit #

decimal places := 0;

value := HEAP AST := num value := digit

ELSE

NUM(value) := num value := IF decimal places = 0

THEN

num value * base + digit

ELSE

decimal places *:= base;

num value + digit / decimal places

FI

FI

ELIF token = "." THEN

decimal places := 1

ELSE

SKIP # and ignore spaces and any unrecognised characters #

FI

),

(MONADIC): SKIP, # not implemented #

(DIADIC):(

value := compress ast stack(prio OF this op, value);

IF top=UPB stack THEN index error FI;

stack[top+:=1]:=STACKITEM(value, this op);

value:=NIL

)

ESAC

OD;

compress ast stack(-max int, 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"))</lang>

<lang algol68>euler's number is about: 2.71828182845899446428546958</lang>

};</lang>

<lang haskell>import Text.ParserCombinators.Parsec

import Text.ParserCombinators.Parsec.Expr

data Exp = Num Int

| Add Exp Exp

| Sub Exp Exp

| Mul Exp Exp

| Div Exp Exp

expr = buildExpressionParser table factor

table = [[op "*" (Mul) AssocLeft, op "/" (Div) AssocLeft]

,[op "+" (Add) AssocLeft, op "-" (Sub) AssocLeft]]

where op s f assoc = Infix (do string s; return f) assoc

factor = do char '(' ; x <- expr ; char ')'

return x

<|> do ds <- many1 digit

return $ Num (read ds)

evaluate (Num x) = fromIntegral x

evaluate (Add a b) = (evaluate a) + (evaluate b)

evaluate (Sub a b) = (evaluate a) - (evaluate b)

evaluate (Mul a b) = (evaluate a) * (evaluate b)

evaluate (Div a b) = (evaluate a) `div` (evaluate b)

solution exp = case parse expr [] exp of

Right expr -> evaluate expr

Left _ -> error "Did not parse"</lang>

arith_eval(do_expr()) =></lang>

<lang prolog> % Lexer

<lang Ursala>#import std

<lang Ursala>#cast %eL