Anonymous user
Arithmetic evaluation: Difference between revisions
m
→{{header|REXX}}: changed/added comments and whitespace, implemented some semantic changes.
m (→{{header|REXX}}: changed/added comments and whitespace, implemented some semantic changes.) |
|||
Line 4,342:
:::* 12.3D+44 ("double" precision)
:::* 12.3Q+44 ("extended" or "quad" precision)
<lang rexx>/*REXX program evaluates an
nchars = '0123456789.eEdDqQ
e='***error***'; $=" "; doubleOps= '&|*/'; z= /*handy─dandy variables.*/
parse arg x 1 ox1; if x='' then call serr "no input was specified."
Line 4,352:
possDouble=pos(_,doubleOps)\==0 /*is _ a possible double operator?*/
if possDouble then do /* " this " " " " */
if _2==_ then do /*
_=_ || _ /*create and use a double char operator
x=overlay($, x, Nj) /*blank out 2nd symbol.*/
end
z=z _ $; iterate
end
if _=='+' | _=="-" then do; p_=word(z, max(1,words(z))
if p_=='(' then z=z 0 /*handle a unary ± */
z=z _ $; iterate
Line 4,365:
do j=j+1 to L; _=substr(x,j,1) /*build a valid number.*/
if lets==1 & sigs==0 then if _=='+' | _==
#=# || _
iterate
Line 4,374:
end /*j*/
j=j-1
if \datatype(#,'N') then call serr
z=z # $
end /*forever*/
Line 4,382:
do i=1 for tokens; @.i=word(x,i); end /*i*/ /*assign input tokens. */
L=max(20,length(x)) /*use 20 for the minimum display 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 the operator priorities.*/
do #=1 for tokens; ?=@.# /*process each token from the @. list.*/
if ?=='**' then ?="^" /*convert to REXX-type exponentiation. */
select /*@.# is: ( operator ) operand*/
when ?=='(' then stack=
when isOp(?) then do /*is the token an operator ? */
!=word(stack,1) /*get token from stack.*/
Line 4,399:
end
when ?==')' then do; !=word(stack, 1) /*get token from stack*/
do while !\=='(';
stack=subword(stack, 2)
!= word(stack, 1)
end /*while*/
stack=subword(stack, 2) /*del token from stack*/
Line 4,410:
epr=space(epr stack); tokens=words(epr); x=epr; z=; stack=
do i=1 for tokens; @.i=word(epr,i); end /*i*/ /*assign input tokens.*/
Dop='/ // % ÷'; Bop=
Aop='- + * ^ **' Dop Bop; Lop=Aop
do #=1 for tokens; ?=@.#; ??=?
w=words(stack); b=word(stack, max(1, w ) ) /*stack count; the last entry. */
a=word(stack, max(1, w-1) ) /*stack's "first" operand. */
Line 4,421:
bitOp =wordpos(?, Bop)\==0 /*flag: doing binary mathematics. */
if datatype(?, 'N') then do; stack=stack ?; iterate; end
if wordpos(?,Lop)==0 then do; z=e
if w<2 then do; z=e
if ?=='^' then ??="**" /*REXXify ^ ──► ** (make it legal).*/
if ?=='÷' then ??="/" /*REXXify ÷ ──► / (make it legal).*/
if division & b=0 then do; z=e
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
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
end /*select*/
if datatype(y, 'W') then y=y/1 /*normalize the number with ÷ by 1. */
_=subword(stack, 1, w-2); stack=_ y /*rebuild the stack with the answer. */
Line 4,445:
if word(z, 1)==e then stack= /*handle the special case of errors. */
z=space(z stack) /*append any residual entries. */
say 'answer──►'
parse source upper . how . /*invoked via C.L. or REXX program ? */
if how=='COMMAND' | \datatype(z, 'W') then exit /*stick a fork in it, we're all done. */
Line 4,454:
serr: say; say e arg(1); say; exit 13 /*issue an error message with some text*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
getX: do Nj=j+1 to length(x); _n=substr(x, Nj, 1);
return substr(x, Nj, 1)
end /*Nj*/
return $
To view a version of the above REXX program, see this version which has much more whitespace: ──► [[Arithmetic_evaluation/REXX]]. <br>
<br>
| |||