# Arithmetic evaluation/REXX

This REXX program is the same as the REXX program on the Rosetta Code task   Arithmetic evaluation,
but this version contains considerably more whitespace, and some REXX statements have more commentation.

REXX

<lang rexx>/*REXX pgm evaluates an infix-type arithmetic expression & shows result.*/

nchars = '0123456789.eEdDqQ' /*possible parts of a #, sans ± */ e= '***error!***' \$= ' ' doubleOps = '&|*/' z=

parse arg x 1 ox1 if x= then call serr 'no input was specified.'

x=space(x) L=length(x) x=translate(x, '()()', "[]{}")

j=0

```                                      /* [↓]  the variable J is bumped */
do forever                        /*      within the DO loop below */
j=j+1                             /* [↑]  so it can't be an index. */
```
```    if j>L  then leave                /*is J pointer beyond length X ? */
```
```    _  = substr(x,j,1)                /*pick off a single character.   */
_2 = getX()
newT = pos(_, ' ()[]{}^÷')\==0
```
```    if newT  then do
z=z _ \$
iterate
end
```
```    possDouble=pos(_,doubleOps)\==0   /*is _ a possible double operator*/
```
```    if possDouble then do             /*is this a possible double oper?*/
```
```                       if _2==_  then do        /*yup, it's one of 'em.*/
_=_ || _  /*use a double operator*/
x=overlay(\$,x,Nj) /*blank out the*/
end               /*  2nd symbol.*/
z=z _ \$
iterate
end
```
```    if _=='+' | _=="-"  then do
p_=word(z, words(z))     /*last  Z  token.*/
```
```                             if p_=='('  then z=z 0   /*handle unary ±.*/
```
```                             z=z _ \$
iterate   /*forever*/
end
lets=0
sigs=0
#=_
```
```            do j=j+1  to L                   /*build a valid number.   */
_=substr(x,j,1)
/* [↓]  short-circuit  IF.*/
```
```            if lets==1 & sigs==0  then if _=='+' | _=='-'  then do
sigs=1
#=# || _
iterate
end
if pos(_, nchars)==0  then leave
```
```            lets=lets+datatype(_, 'M')      /*keep track of #exponents.*/
#=# || translate(_, 'EEEEE', 'eDdQq')    /*keep building #.*/
end   /*j*/
```
```    j=j-1
```
```    if \datatype(#, 'N')  then call  serr  'invalid number: '     #
```
```    z=z # \$
end   /*forever*/
```

_=word(z,1)

if _=='+' | _=='-' then z=0 z /*be able to handle unary cases. */

x='(' space(z) ') ' tokens=words(x) /*force stacking for expression. */

```    do i=1  for tokens                /*assign input tokens to @ array.*/
@.i=word(x, i)
end   /*i*/
```

L=max(20, length(x)) /*use 20 for the min show width. */ op = ')(-+/*^' rOp= substr(op, 3) p. = s. = n = length(op) epr= stack=

```    do i=1  for n
_= substr(op,i,1)
s._= (i+1) % 2
p._= s._   + (i==n)
end   /*i*/
```
```                                      /*[↓] assign operator priorities.*/
do #=1  for tokens                   /*process each token from @. list*/
? = @.#
```
``` if ?=='**'      then ?="^"           /*change─►REXX-type exponentation*/
```
```    select                            /*@.# is: (, operator, ), operand*/
when ?=='('  then stack='(' stack
```
```    when isOp(?) then do                        /*is token an operator?*/
!=word(stack,1)           /*get token from stack.*/
```
```                         do  while !\==')' & s.!>=p.?
epr=epr !              /*add it to expression.*/
stack=subword(stack,2) /*del token from stack.*/
!=word(stack,1)        /*get token from stack.*/
end   /*while ···)*/
```
```                      stack=? stack             /*add token  to  stack.*/
end
```
```    when ?==')' then do                         /*is token a group sep?*/
!=word(stack,1)            /*get token from stack.*/
```
```                        do  while !\=='('
epr=epr !               /*add it to expression.*/
stack=subword(stack, 2) /*del token from stack.*/
!=word(stack, 1)        /*get token from stack.*/
end   /*while ···( */
```
```                     stack=subword(stack, 2)    /*del token from stack.*/
end
```
```   otherwise  epr=epr ?                         /*add operand to  epr. */
end   /*select*/
```
``` end     /*#*/
```

epr=space(epr stack) tokens=words(epr) x=epr z= stack=

``` do i=1  for tokens                             /*assign input tokens. */
@.i=word(epr,i)
end   /*i*/
```

dop= '/ // % ÷' /*division operands, all forms. */ bop= '& | &&' /*binary (or logical) operands. */ aop= '- + * ^ **' dop bop /*all forms of arithmetic opers. */ lop=aop '||' /*arithmetic ops + legal operands*/

``` do #=1  for tokens                   /*process each token from @. list*/
? = @.#
?? = ?
w=words(stack)                       /*the number of entries in stack.*/
b=word(stack, max(1, w))             /*B:   is the last stack entry.  */
a=word(stack, max(1, w-1))           /*the stack's  "first"  operand. */
division  =wordpos(?, dop)\==0       /*a flag for:  doing a division. */
arith     =wordpos(?, aop)\==0       /*"   "   "      "   arithmetic. */
bitOp     =wordpos(?, bop)\==0       /*"   "   "      "   binary math.*/
```
``` if datatype(?,'N')    then do
stack=stack  ?
iterate
end
```
``` if wordpos(?,lop)==0  then do
z=e  'illegal operator:'  ?
leave
end

if w<2                then do
z=e  'illegal epr expression.'
leave
end

if ?=='^'             then ??="**"   /*REXXify  ^ ──► **  (make legal)*/
```
``` if ?=='÷'             then ??="/"    /*REXXify  ÷ ──► /   (make legal)*/
```
``` if division  &  b=0   then do
z=e  'division by zero: '      b
leave
end
```
``` if bitOp & \isBit(a)  then do
z=e  "token isn't logical: "   a
leave
end
```
``` if bitOp & \isBit(b)  then do
z=e  "token isn't logical: "   b
leave
end
```
```   select                                    /*perform arith. operation*/
when ??=='+'             then y = a +  b
when ??=='-'             then y = a -  b
when ??=='*'             then y = a *  b
when ??=='/' | ??=="÷"   then y = a /  b
when ??=='//'            then y = a // b
when ??=='%'             then y = a %  b
when ??=='^' | ??=="**"  then y = a ** b
when ??=='||'            then y = a || b
```
```   otherwise           z=e 'invalid operator:' ?
leave
end   /*select*/
```
``` if datatype(y,'W')   then y=y/1      /*normalize number with  ÷  by 1.*/
```
``` _=subword(stack, 1, w-2)
stack=_  y                           /*rebuild the stack with answer. */
end   /*#*/
```

if word(z,1)==e then stack= /*handle special case of errors. */

z=space(z stack) /*append any residual entries. */ say 'answer──►' z /*display the answer (result). */ parse source upper . how . /*invoked via C.L. or REXX pgm?*/

if how=='COMMAND' | ,

```  \datatype(z,'W')  then exit         /*stick a fork in it, we're done.*/
```

return z /*return Z ──► invoker (RESULT).*/

/*──────────────────────────────────ISBIT subroutine────────────────────*/ isBit: return arg(1)==0 | arg(1)==1 /*returns 1 if arg1 is bin bit.*/

/*──────────────────────────────────ISOP subroutine─────────────────────*/ isOp: return pos(arg(1), rOp)\==0 /*is argument1 a "real" operator?*/

/*──────────────────────────────────SERR subroutine─────────────────────*/ serr: say; say e arg(1); say; exit 13 /*issue an error message with txt*/

/*──────────────────────────────────GETX subroutine─────────────────────*/ getX: do Nj=j+1 to length(x)

```              _n=substr(x, Nj, 1)
if _n==\$  then iterate     /*\$  variable contains one blank.*/
return  substr(x, Nj, 1)   /*ignore any blanks in the string*/
end   /*Nj*/
```

return \$ /*reached end-of-tokens, return \$*/</lang> execution   is identical to the condensed version on the main Rosetta Code task page.