The following code processes the data in a pipeline of steps which are combined in the evaluate function.

First, the string is converted into a sequence of tokens, represented as a list. Operator tokens are represented directly by the corresponding Lisp symbols, and the integer terms are represented by Lisp integer objects. The symbols :lparen and :rparen represent the the parentheses. So for instance the input
"1*(3+2)" tokenizes as (1 * :lparen 3 + 2 :rparen).

Next, that sequence of tokens is then transformed by eliminating the parentheses. Subsequences of the form :lparen ... :rparen with a sublist containing the tokens between the :lparen and :rparen. The sequence now has an intermediate tree structure, in which parenthesized fragments like 1 + 2 * 3 + 4 / 9 still remain flat.

Finally, this infix representation can be easily converted to prefix, forming the final AST which is a Lisp expression.
(Lisp expressions are abstract syntax trees!) This representation evaluates directly with eval.

This implementation can read integers, and produce integral and rational values.

PROCEDURE DISEGNA_STACK !$RCODE="LOCATE 3,1" !$RCODE="COLOR 0,7" PRINT(TAB(35);"S T A C K";TAB(79);) !$RCODE="COLOR 7,0" FOR TT=1 TO 38 DO IF TT>=20 THEN !$RCODE="LOCATE 3+TT-19,40" ELSE !$RCODE="LOCATE 3+TT,1" END IF IF TT=NS THEN PRINT(">";) ELSE PRINT(" ";) END IF PRINT(RIGHT$(STR$(TT),2);"³ ";STACK$[TT];" ") END FOR REPEAT GET(Z$) UNTIL LEN(Z$)<>0END PROCEDURE

PROCEDURE COMPATTA_STACK IF NS>1 THEN R=1 WHILE R<NS DO IF INSTR(OP_LIST$,STACK$[R])=0 AND INSTR(OP_LIST$,STACK$[R+1])=0 THEN FOR R1=R TO NS-1 DO STACK$[R1]=STACK$[R1+1] END FOR NS=NS-1 END IF R=R+1 END WHILE END IF DISEGNA_STACKEND PROCEDURE

PROCEDURE CALC_ARITM L=NS1 WHILE L<=NS2 DO IF STACK$[L]="^" THEN IF L>=NS2 THEN GOTO 100 END IF N1#=VAL(STACK$[L-1]) N2#=VAL(STACK$[L+1]) NOP=NOP-1 IF STACK$[L]="^" THEN RI#=N1#^N2# END IF STACK$[L-1]=STR$(RI#) N=L WHILE N<=NS2-2 DO STACK$[N]=STACK$[N+2] N=N+1 END WHILE NS2=NS2-2 L=NS1-1 END IF L=L+1 END WHILE

L=NS1 WHILE L<=NS2 DO IF STACK$[L]="*" OR STACK$[L]="/" THEN IF L>=NS2 THEN GOTO 100 END IF N1#=VAL(STACK$[L-1]) N2#=VAL(STACK$[L+1]) NOP=NOP-1 IF STACK$[L]="*" THEN RI#=N1#*N2# ELSE RI#=N1#/N2# END IF STACK$[L-1]=STR$(RI#) N=L WHILE N<=NS2-2 DO STACK$[N]=STACK$[N+2] N=N+1 END WHILE NS2=NS2-2 L=NS1-1 END IF L=L+1 END WHILE

L=NS1 WHILE L<=NS2 DO IF STACK$[L]="+" OR STACK$[L]="-" THEN EXIT IF L>=NS2 N1#=VAL(STACK$[L-1]) N2#=VAL(STACK$[L+1]) NOP=NOP-1 IF STACK$[L]="+" THEN RI#=N1#+N2# ELSE RI#=N1#-N2# END IF STACK$[L-1]=STR$(RI#) N=L WHILE N<=NS2-2 DO STACK$[N]=STACK$[N+2] N=N+1 END WHILE NS2=NS2-2 L=NS1-1 END IF L=L+1 END WHILE100: IF NOP<2 THEN ! operator priority DB#=VAL(STACK$[NS1]) ELSE IF NOP<3 THEN DB#=VAL(STACK$[NS1+2]) ELSE DB#=VAL(STACK$[NS1+4]) END IF END IFEND PROCEDURE

PROCEDURE SVOLGI_PAR NPA=NPA-1 FOR J=NS TO 1 STEP -1 DO EXIT IF STACK$[J]="(" END FOR IF J=0 THEN NS1=1 NS2=NS CALC_ARITM NERR=7 ELSE FOR R=J TO NS-1 DO STACK$[R]=STACK$[R+1] END FOR NS1=J NS2=NS-1 CALC_ARITM IF NS1=2 THEN NS1=1 STACK$[1]=STACK$[2] END IF NS=NS1 COMPATTA_STACK END IFEND PROCEDURE

FOR W=1 TO LEN(EXPRESSION$) DO LOOP CODE=ASC(MID$(EXPRESSION$,W,1)) IF (CODE>=48 AND CODE<=57) OR CODE=46 THEN K$=K$+CHR$(CODE) W=W+1 IF W>LEN(EXPRESSION$) THEN GOTO 98 END IF ELSE EXIT IF K$="" IF NS>1 OR (NS=1 AND STACK$[1]<>"@") THEN NS=NS+1 END IF IF FLAG=0 THEN STACK$[NS]=K$ ELSE STACK$[NS]=STR$(VAL(K$)*FLAG) END IF K$="" FLAG=0 EXIT END IF END LOOP IF CODE=43 THEN K$="+" END IF IF CODE=45 THEN K$="-" END IF IF CODE=42 THEN K$="*" END IF IF CODE=47 THEN K$="/" END IF IF CODE=94 THEN K$="^" END IF

CASE CODE OF 43,45,42,47,94-> IF MID$(EXPRESSION$,W+1,1)="-" THEN FLAG=-1 W=W+1 END IF IF INSTR(OP_LIST$,STACK$[NS])<>0 THEN NERR=5 ELSE NS=NS+1 STACK$[NS]=K$ NOP=NOP+1 IF NOP>=2 THEN FOR J=NS TO 1 STEP -1 DO IF STACK$[J]<>"(" THEN CONTINUE FOR END IF IF J<NS-2 THEN EXIT ELSE GOTO 110 END IF END FOR NS1=J+1 NS2=NS CALC_ARITM NS=NS2 STACK$[NS]=K$ REGISTRO_X#=VAL(STACK$[NS-1]) END IF END IF110: END ->

40-> IF NS>1 OR (NS=1 AND STACK$[1]<>"@") THEN NS=NS+1 END IF STACK$[NS]="(" NPA=NPA+1 IF MID$(EXPRESSION$,W+1,1)="-" THEN FLAG=-1 W=W+1 END IF END ->

41-> SVOLGI_PAR IF NERR=7 THEN NERR=0 NOP=0 NPA=0 NS=1 ELSE IF NERR=0 OR NERR=1 THEN DB#=VAL(STACK$[NS]) REGISTRO_X#=DB# ELSE NOP=0 NPA=0 NS=1 END IF END IF END ->

OTHERWISE NERR=8 END CASE K$="" DISEGNA_STACKEND FOR

98: IF K$<>"" THEN IF NS>1 OR (NS=1 AND STACK$[1]<>"@") THEN NS=NS+1 END IF IF FLAG=0 THEN STACK$[NS]=K$ ELSE STACK$[NS]=STR$(VAL(K$)*FLAG) END IF END IF DISEGNA_STACK IF INSTR(OP_LIST$,STACK$[NS])<>0 THEN NERR=6 ELSE WHILE NPA<>0 DO SVOLGI_PAR END WHILE IF NERR<>7 THEN NS1=1 NS2=NS CALC_ARITM END IF END IF NS=1 NOP=0 NPA=0 !$RCODE="LOCATE 23,1" IF NERR>0 THEN PRINT("Internal Error #";NERR) ELSE PRINT("Value is ";DB#) END IFEND PROGRAM

This solution is based on a stack: as a plus there is a power (^) operator. Unary operator "-" is accepted. Program shows the stack after every operation and you must press a key to go on (this feature can be avoided by removing the final REPEAT..UNTIL loop at the end of "DISEGNA_STACK" procedure).

'Arithmetic evaluation''Create a program which parses and evaluates arithmetic expressions.''Requirements'' * An abstract-syntax tree (AST) for the expression must be created from parsing the' input.' * The AST must be used in evaluation, also, so the input may not be directly evaluated' (e.g. by calling eval or a similar language feature.)' * The expression will be a string or list of symbols like "(1+3)*7".' * The four symbols + - * / must be supported as binary operators with conventional' precedence rules.' * Precedence-control parentheses must also be supported.''Standard mathematical precedence should be followed:'' Parentheses' Multiplication/Division (left to right)' Addition/Subtraction (left to right)'' test cases:' 2*-3--4+-0.25 : returns -2.25' 1 + 2 * (3 + (4 * 5 + 6 * 7 * 8) - 9) / 10 : returns 71

Note that once you get beyond a few basic arithmetic operations, what we commonly call "mathematical precedence" stops making sense, and primary value for this kind of precedence has been that it allows polynomials to be expressed simply (but expressing polynomials as a sequence of coefficients, one for each exponent, is even simpler).

Nevertheless, this task deals only with simple arithmetic, so this kind of precedence is an arguably appropriate choice for this task.

The implementation here uses a shift/reduce parser to build a tree structure (which J happens to support) for evaluation:

At the top level, the first box is a list of terminals, and the second box represents their parsed structure within the source sentence, with numbers indexing the respective terminals. Within the list of terminals - each terminal is contained with a box. Punctuation is simply the punctuation string (left or right parenthesis). Operators are strings inside of boxes (the leading $ "operator" in this example is not really an operator - it's just a placeholder that was used to help in the parsing). Numeric values are a box inside of a box where the inner box carries two further boxes. The first indicates data type ('0' for numbers) and the second carries the value.

selectcasecase token$ ="("'If the token is a left parenthesis, then push it onto the stack.call stack.push token$

case token$ =")"'If the token is a right parenthesis:'Until the token at the top of the stack is a left parenthesis, pop operators off the stack onto the output queue.'Pop the left parenthesis from the stack, but not onto the output queue.'If the stack runs out without finding a left parenthesis, then there are mismatched parentheses.while stack.peek$()<>"("'if stack is emptyif stack$=""thenprint"Error: no matching '(' for token ";i:end'add operator node to tree child2=node.pop() child1=node.pop()call node.push addOpNode(child1,child2,stack.pop$())wend discard$=stack.pop$()'discard "("

case isOperator(token$)'If the token is an operator, o1, then:'while there is an operator token, o2, at the top of the stack, and'either o1 is left-associative and its precedence is equal to that of o2,'or o1 has precedence less than that of o2,' pop o2 off the stack, onto the output queue;'push o1 onto the stack op1$=token$while(isOperator(stack.peek$())) op2$=stack.peek$()if(op2$<>"^"and precedence(op1$)= precedence(op2$)) _OR(precedence(op1$)< precedence(op2$))then'"^" is the only right-associative operator'add operator node to tree child2=node.pop() child1=node.pop()call node.push addOpNode(child1,child2,stack.pop$())elseexitwhileendifwendcall stack.push op1$

caseelse'number'actually, wrohg operator could end up here, like say %'If the token is a number, then'add leaf node to tree (number)call node.push addNumNode(val(token$))endselect

wend

'When there are no more tokens to read:'While there are still operator tokens in the stack:' If the operator token on the top of the stack is a parenthesis, then there are mismatched parentheses.' Pop the operator onto the output queue.while stack$<>""if stack.peek$()="("thenprint"no matching ')'":end'add operator node to tree child2=node.pop() child1=node.pop()call node.push addOpNode(child1,child2,stack.pop$())wend

-- create an executable expression from the input, printing out any-- errors if they are raised.::routine createExpressionusearg inputString-- signal on syntaxreturn.ExpressionParser~parseExpression(inputString)

-- a base class for tree nodes in the tree-- all nodes return some sort of value. This can be constant,-- or the result of additional evaluations::class evaluatornode-- all evaluation is done here::method evaluate abstract

-- node for numeric values in the tree::class constant::method initexposevalueuseargvalue

::method evaluateexposevaluereturnvalue

::method stringexposevaluereturnvalue

-- node for a parenthetical group on the tree::class parens::method initexpose subexpressionusearg subexpression

::method evaluateexpose subexpressionreturn subexpression~evaluate

::method stringexpose subexpressionreturn"("subexpression~string")"

-- base class for binary operators::class binaryoperator::method initexposeleftright-- the left and right sides are set after the left and right sides have-- been resolved.left = .nilright = .nil

-- a class to parse the expression and build an evaluation tree::class expressionParser-- create a resolved operand from an operator instance and the top-- two entries on the operand stack.::method createNewOperand classuse strict arg operator, operands-- the operands are a stack, so they are in inverse order current operator~right = operands~pull operator~left = operands~pull-- this goes on the top of the stack now operands~push(operator)

loop currentIndex = 1to inputString~length char = inputString~subChar(currentIndex)-- skip over whitespaceif char == ' 'theniterate currentIndex-- If the last thing we parsed was an operand, then-- we expect to see either a closing paren or an-- operator to appear hereif afterOperand thendoif char == ')'thendoloopwhile\operators~isempty operator = operators~pull-- if we find the opening paren, replace the-- top operand with a paren group wrapper-- and stop popping itemsif operator == '('thendo operands~push(.parens~new(operands~pull))leaveend-- collapse the operator stack a bit self~createNewOperand(operator, operands)end-- done with this characteriterate currentIndexend afterOperand = .false operator = .nilif char == "+"then operator = .addoperator~newelseif char == "-"then operator = .subtractoperator~newelseif char == "*"then operator = .multiplyoperator~newelseif char == "/"then operator = .divideoperator~newif operator \= .nil thendoloopwhile\operators~isEmpty top = operators~peek-- start of a paren group stops the poppingif top == '('thenleave-- or the top operator has a lower precedenceif top~precedence < operator~precedence thenleave-- process this pending one self~createNewOperand(operators~pull, operands)end-- this new operator is now top of the stack operators~push(operator)-- and back to the topiterate currentIndexendraisesyntax98.900 array("Invalid expression character" char)end-- if we've hit an open paren, add this to the operator stack-- as a phony operatorif char == '('thendo operators~push('(')iterate currentIndexend-- not an operator, so we have an operand of some type afterOperand = .true startindex = currentIndex-- allow a leading minus sign on thisif inputString~subchar(currentIndex) == '-'then currentIndex += 1-- now scan for the end of numbersloopwhile currentIndex <= inputString~length-- exit for any non-numeric valueif\inputString~matchChar(currentIndex, "0123456789.")thenleave currentIndex += 1end-- extract the string value operand = inputString~substr(startIndex, currentIndex - startIndex)if\operand~datatype('Number')thenraisesyntax98.900 array("Invalid numeric operand '"operand"'")-- back this up to the last valid character currentIndex -= 1-- add this to the operand stack as a tree element that returns a constant operands~push(.constant~new(operand))end

We can create a simple, but slow parser using logic programming.
Every procedure reads the input characters from X0 and returns the remaining characters in X. The AST is returned as the regular return value.

The Do procedure automatically threads the input state through a sequence of procedure calls.

To improve performance, the number of choice points should be limited, for example by reading numbers deterministically instead.
For real parsing with possible large input, it is however recommended to use Gump, Mozart's parser generator.

sub astize# Constructs an abstract syntax tree by recursively# transforming textual arithmetic expressions into array# references of the form [operator, left oprand, right oprand].{my$exp=shift;# If $exp is just a number, return it as-is.$exp=~/[^0-9.]/orreturn$exp;# If parentheses surround the entire expression, get rid of# them.$exp=substr($exp,1,-1)while$exp=~/\A($balanced_paren_regex)\z/;# Replace stuff in parentheses with placeholders.my@paren_contents;$exp=~s{($balanced_paren_regex)}{push(@paren_contents,$1);"[p$#paren_contents]"}eg;# Scan for operators in order of increasing precedence,# preferring the rightmost.$exp=~m{(.+)([+-])(.+)}x or$exp=~m{(.+)([*/])(.+)}x or# The expression must've been malformed somehow.# (Note that unary minus isn't supported.)die"Eh?: [$exp]\n";my($op,$lo,$ro)=($2,$1,$3);# Restore the parenthetical expressions.s{\[p(\d+)\]}{($paren_contents[$1])}egforeach$lo,$ro;# And recurse.return[$op, astize($lo), astize($ro)];}}

sub ev_ast# Evaluates an abstract syntax tree of the form returned by# &astize.{my$ast=shift;# If $ast is just a number, return it as-is.ref$astorreturn$ast;# Otherwise, recurse.my($op,@operands)=@$ast;$_= ev_ast($_)foreach@operands;return$ops{$op}->(@operands);}}

This is really just a simplification of the one in the heart of Phix,
which of course by now is thousands of lines spread over several files,
plus this as asked for has an AST, whereas Phix uses cross-linked flat IL.

procedure skipspaces() while find(ch," \t\r\n")!=0 do nxtch(0) end whileend procedure

procedure get_token()atom n, fractioninteger dec skipspaces() if ch=-1 then token = "eof" return end if if ch>='0' and ch<='9' then n = ch-'0' while 1 do nxtch(0) if ch<'0' or ch>'9' then exit end if n = n*10+ch-'0' end while if ch='.' then dec = 1 fraction = 0 while 1 do nxtch(0) if ch<'0' or ch>'9' then exit end if fraction = fraction*10 + ch-'0' dec *= 10 end while n += fraction/dec end if-- if find(ch,"eE") then -- you get the idea-- end if token = n return end if if find(ch,"+-/*()^%")=0 then err("syntax error") end if token = s[sidx..sidx] nxtch(0) returnend procedure

procedure Match(string t) if token!=t then err(t&" expected") end if get_token()end procedure

procedure Expr(integer p)---- Parse an expression, using precedence climbing.---- p is the precedence level we should parse to, eg/ie-- 4: Factor only (may as well just call Factor)-- 3: "" and ^-- 2: "" and *,/,%-- 1: "" and +,--- 0: full expression (effectively the same as 1)-- obviously, parentheses override any setting of p.--integer k, thisp Factor() while 1 do k = find(token,operators) -- *,/,+,- if k=0 then exit end if thisp = precedence[k] if thisp<p then exit end if get_token() Expr(thisp+associativity[k]) PushOp(operators[k]) end whileend procedure

The built-in function 'str' splits a string into a list of lexical tokens
(numbers and transient symbols). From that, a recursive descendent parser can
build an expression tree, resulting in directly executable Lisp code.

There are python modules, such as Ply, which facilitate the implementation of parsers. This example, however, uses only standard Python with the parser having two stacks, one for operators, one for operands.
A subsequent example uses Pythons' ast module to generate the abstract syntax tree.

def pc2(self,operchar ):# Close Parenthesis# reduce node until matching open paren found self.redeuce(1)iflen(self.operstak)>0:self.operstak.pop()# pop off open parenthesiselse:print'Error - no open parenthesis matches close parens.'self.__dict__.update(self.state2)

This implementation uses a recursive descent parser. It first lexes the input. The parser builds a Abstract Syntax Tree (AST) and the evaluator evaluates it. The parser uses sub categories.
The parsing is a little bit tricky because the grammar is left recursive.