2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,14 +1,21 @@
|
|||
Create a stack-based evaluator for an expression in [[wp:Reverse Polish notation|reverse Polish notation]] that also shows the changes in the stack
|
||||
as each individual token is processed ''as a table''.
|
||||
;Task:
|
||||
Create a stack-based evaluator for an expression in [[wp:Reverse Polish notation|<u>r</u>everse <u>P</u>olish <u>n</u>otation (RPN)]] that also shows the changes in the stack as each individual token is processed ''as a table''.
|
||||
|
||||
|
||||
* Assume an input of a correct, space separated, string of tokens of an RPN expression
|
||||
* Test with the RPN expression generated from the [[Parsing/Shunting-yard algorithm]] task <code>'3 4 2 * 1 5 - 2 3 ^ ^ / +'</code> then print and display the output here.
|
||||
* Test with the RPN expression generated from the [[Parsing/Shunting-yard algorithm]] task: <br>
|
||||
<big><big><code> 3 4 2 * 1 5 - 2 3 ^ ^ / + </code></big></big>
|
||||
* Print or display the output here
|
||||
|
||||
|
||||
;Notes:
|
||||
* <big><b> '''^''' </b></big> means exponentiation in the expression above.
|
||||
* <big><b> '''/''' </b></big> means division.
|
||||
|
||||
;Note:
|
||||
* '^' means exponentiation in the expression above.
|
||||
|
||||
;See also:
|
||||
* [[Parsing/Shunting-yard algorithm]] for a method of generating an RPN from an infix expression.
|
||||
* Several solutions to [[24 game/Solve]] make use of RPN evaluators (although tracing how they work is not a part of that task).
|
||||
* [[Parsing/RPN to infix conversion]].
|
||||
* [[Arithmetic evaluation]].
|
||||
* [[Parsing/Shunting-yard algorithm]] for a method of generating an RPN from an infix expression.
|
||||
* Several solutions to [[24 game/Solve]] make use of RPN evaluators (although tracing how they work is not a part of that task).
|
||||
* [[Parsing/RPN to infix conversion]].
|
||||
* [[Arithmetic evaluation]].
|
||||
<br><br>
|
||||
|
|
|
|||
|
|
@ -1,21 +1,42 @@
|
|||
open string console list format read
|
||||
open string generic monad io
|
||||
|
||||
eval str = writen "Input\tOperation\tStack after" $
|
||||
eval' (split " " str) []
|
||||
where eval' [] (s::_) = printfn "Result: {0}" s
|
||||
eval' (x::xs) sta | "+"? = eval' xs <| op (+)
|
||||
| "-"? = eval' xs <| op (-)
|
||||
| "^"? = eval' xs <| op (**)
|
||||
| "/"? = eval' xs <| op (/)
|
||||
| "*"? = eval' xs <| op (*)
|
||||
| else = eval' xs <| conv x
|
||||
where c? = x == c
|
||||
op (^) = out "Operate" st' $ st'
|
||||
where st' = (head ss ^ s) :: tail ss
|
||||
conv x = out "Push" st' $ st'
|
||||
where st' = readStr x :: sta
|
||||
(s,ss) | sta == [] = ((),[])
|
||||
| else = (head sta,tail sta)
|
||||
out op st' = printfn "{0}\t{1}\t\t{2}" x op st'
|
||||
type OpType = Push | Operate
|
||||
deriving Show
|
||||
|
||||
eval "3 4 2 * 1 5 - 2 3 ^ ^ / +"
|
||||
type Op = Op (OpType typ) input stack
|
||||
deriving Show
|
||||
|
||||
parse str = split " " str
|
||||
|
||||
eval stack [] = []
|
||||
eval stack (x::xs) = op :: eval nst xs
|
||||
where (op, nst) = conv x stack
|
||||
conv "+"@x = operate x (+)
|
||||
conv "-"@x = operate x (-)
|
||||
conv "*"@x = operate x (*)
|
||||
conv "/"@x = operate x (/)
|
||||
conv "^"@x = operate x (**)
|
||||
conv x = \stack ->
|
||||
let n = gread x::stack in
|
||||
(Op Push x n, n)
|
||||
operate input fn (x::y::ys) =
|
||||
let n = (y `fn` x) :: ys in
|
||||
(Op Operate input n, n)
|
||||
|
||||
print_line (Op typ input stack) = do
|
||||
putStr input
|
||||
putStr "\t"
|
||||
put typ
|
||||
putStr "\t\t"
|
||||
putLn stack
|
||||
|
||||
print ((Op typ input stack)@x::xs) lv = print_line x `seq` print xs (head stack)
|
||||
print [] lv = lv
|
||||
|
||||
print_result xs = do
|
||||
putStrLn "Input\tOperation\tStack after"
|
||||
res <- return $ print xs 0
|
||||
putStrLn ("Result: " ++ show res)
|
||||
|
||||
res = parse "3 4 2 * 1 5 - 2 3 ^ ^ / +" |> eval []
|
||||
print_result res ::: IO
|
||||
|
|
|
|||
|
|
@ -0,0 +1,48 @@
|
|||
REAL FUNCTION EVALRP(TEXT) !Evaluates a Reverse Polish string.
|
||||
Caution: deals with single digits only.
|
||||
CHARACTER*(*) TEXT !The RPN string.
|
||||
INTEGER SP,STACKLIMIT !Needed for the evaluation.
|
||||
PARAMETER (STACKLIMIT = 6) !This should do.
|
||||
REAL*8 STACK(STACKLIMIT) !Though with ^ there's no upper limit.
|
||||
INTEGER L,D !Assistants for the scan.
|
||||
CHARACTER*4 DEED !A scratchpad for the annotation.
|
||||
CHARACTER*1 C !The character of the moment.
|
||||
WRITE (6,1) TEXT !A function that writes messages... Improper.
|
||||
1 FORMAT ("Evaluation of the Reverse Polish string ",A,// !Still, it's good to see stuff.
|
||||
1 "Char Token Action SP:Stack...") !Such as a heading for the trace.
|
||||
SP = 0 !Commence with the stack empty.
|
||||
STACK = -666 !This value should cause trouble.
|
||||
DO L = 1,LEN(TEXT) !Step through the text.
|
||||
C = TEXT(L:L) !Grab a character.
|
||||
IF (C.LE." ") CYCLE !Boring.
|
||||
D = ICHAR(C) - ICHAR("0") !Uncouth test to check for a digit.
|
||||
IF (D.GE.0 .AND. D.LE.9) THEN !Is it one?
|
||||
DEED = "Load" !Yes. So, load its value.
|
||||
SP = SP + 1 !By going up one.
|
||||
IF (SP.GT.STACKLIMIT) STOP "Stack overflow!" !Or, maybe not.
|
||||
STACK(SP) = D !And stashing the value.
|
||||
ELSE !Otherwise, it must be an operator.
|
||||
IF (SP.LT.2) STOP "Stack underflow!" !They all require two operands.
|
||||
DEED = "XEQ" !So, I'm about to do so.
|
||||
SELECT CASE(C) !Which one this time?
|
||||
CASE("+"); STACK(SP - 1) = STACK(SP - 1) + STACK(SP) !A + B = B + A, so it is easy.
|
||||
CASE("-"); STACK(SP - 1) = STACK(SP - 1) - STACK(SP) !A is in STACK(SP - 1), B in STACK(SP)
|
||||
CASE("*"); STACK(SP - 1) = STACK(SP - 1)*STACK(SP) !Again, order doesn't count.
|
||||
CASE("/"); STACK(SP - 1) = STACK(SP - 1)/STACK(SP) !But for division, A/B becomes A B /
|
||||
CASE("^"); STACK(SP - 1) = STACK(SP - 1)**STACK(SP) !So, this way around.
|
||||
CASE DEFAULT !This should never happen!
|
||||
STOP "Unknown operator!" !If the RPN script is indeed correct.
|
||||
END SELECT !So much for that operator.
|
||||
SP = SP - 1 !All of them take two operands and make one.
|
||||
END IF !So much for that item.
|
||||
WRITE (6,2) L,C,DEED,SP,STACK(1:SP) !Reveal the state now.
|
||||
2 FORMAT (I4,A6,A7,I4,":",66F14.6) !Aligned with the heading of FORMAT 1.
|
||||
END DO !On to the next symbol.
|
||||
EVALRP = STACK(1) !The RPN string being correct, this is the result.
|
||||
END !Simple enough!
|
||||
|
||||
PROGRAM HSILOP
|
||||
REAL V
|
||||
V = EVALRP("3 4 2 * 1 5 - 2 3 ^ ^ / +") !The specified example.
|
||||
WRITE (6,*) "Result is...",V
|
||||
END
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
calcRPN :: String -> [Double]
|
||||
calcRPN = foldl interprete [] . words
|
||||
|
||||
interprete s x
|
||||
| x `elem` ["+","-","*","/","^"] = operate x s
|
||||
| otherwise = read x:s
|
||||
where
|
||||
operate op (x:y:s) = case op of
|
||||
"+" -> x + y:s
|
||||
"-" -> y - x:s
|
||||
"*" -> x * y:s
|
||||
"/" -> y / x:s
|
||||
"^" -> y ** x:s
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
calcRPNLog :: String -> ([Double],[(String, [Double])])
|
||||
calcRPNLog input = mkLog $ zip commands $ tail result
|
||||
where result = scanl interprete [] commands
|
||||
commands = words input
|
||||
mkLog [] = ([], [])
|
||||
mkLog res = (snd $ last res, res)
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
import Control.Monad (foldM)
|
||||
|
||||
calcRPNIO :: String -> IO [Double]
|
||||
calcRPNIO = foldM (verbose interprete) [] . words
|
||||
|
||||
verbose f s x = write (x ++ "\t" ++ show res ++ "\n") >> return res
|
||||
where res = f s x
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
class Monad m => Logger m where
|
||||
write :: String -> m ()
|
||||
|
||||
instance Logger IO where write = putStr
|
||||
instance a ~ String => Logger (Writer a) where write = tell
|
||||
|
||||
verbose2 f x y = write (show x ++ " " ++
|
||||
show y ++ " ==> " ++
|
||||
show res ++ "\n") >> return res
|
||||
where res = f x y
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
calcRPNM :: Logger m => String -> m [Double]
|
||||
calcRPNM = foldM (verbose interprete) [] . words
|
||||
|
|
@ -1,15 +0,0 @@
|
|||
import Data.List (elemIndex)
|
||||
|
||||
-- Show results
|
||||
main = mapM_ (\(x, y) -> putStrLn $ x ++ " ==> " ++ show y) $ reverse $ zip b (a:c)
|
||||
where (a, b, c) = solve "3 4 2 * 1 5 - 2 3 ^ ^ / +"
|
||||
|
||||
-- Solve and report RPN
|
||||
solve = foldl reduce ([], [], []) . words
|
||||
reduce (xs, ps, st) w =
|
||||
if i == Nothing
|
||||
then (read w:xs, ("Pushing " ++ w):ps, xs:st)
|
||||
else (([(*),(+),(-),(/),(**)]!!o) a b:zs, ("Performing " ++ w):ps, xs:st)
|
||||
where i = elemIndex (head w) "*+-/^"
|
||||
Just o = i
|
||||
(b:a:zs) = xs
|
||||
|
|
@ -1,12 +1,9 @@
|
|||
calc[rpn_] :=
|
||||
Module[{tokens = StringSplit[rpn], steps},
|
||||
steps = FoldList[
|
||||
Switch[#2, _?DigitQ, Append[#, FromDigits[#2]], "^",
|
||||
Append[#[[;; -3]], #[[-2]]^#[[-1]]], "*",
|
||||
Append[#[[;; -3]], #[[-2]] #[[-1]]], "/",
|
||||
Append[#[[;; -3]], #[[-2]]/#[[-1]]], "+",
|
||||
Append[#[[;; -3]], #[[-2]] + #[[-1]]], "-",
|
||||
Append[#[[;; -3]], #[[-2]] - #[[-1]]]] &, {}, tokens][[2 ;;]];
|
||||
Grid[Transpose[{# <> ":" & /@ tokens,
|
||||
Module[{tokens = StringSplit[rpn], s = "(" <> ToString@InputForm@# <> ")" &, op, steps},
|
||||
op[o_, x_, y_] := ToExpression[s@x <> o <> s@y];
|
||||
steps = FoldList[Switch[#2, _?DigitQ, Append[#, FromDigits[#2]],
|
||||
_, Append[#[[;; -3]], op[#2, #[[-2]], #[[-1]]]]
|
||||
] &, {}, tokens][[2 ;;]];
|
||||
Grid[Transpose[{# <> ":" & /@ tokens,
|
||||
StringRiffle[ToString[#, InputForm] & /@ #] & /@ steps}]]];
|
||||
Print[calc["3 4 2 * 1 5 - 2 3 ^ ^ / +"]];
|
||||
|
|
|
|||
|
|
@ -0,0 +1,132 @@
|
|||
function Invoke-Rpn
|
||||
{
|
||||
<#
|
||||
.SYNOPSIS
|
||||
A stack-based evaluator for an expression in reverse Polish notation.
|
||||
.DESCRIPTION
|
||||
A stack-based evaluator for an expression in reverse Polish notation.
|
||||
|
||||
All methods in the Math and Decimal classes are available.
|
||||
.PARAMETER Expression
|
||||
A space separated, string of tokens.
|
||||
.PARAMETER DisplayState
|
||||
This switch shows the changes in the stack as each individual token is processed as a table.
|
||||
.EXAMPLE
|
||||
Invoke-Rpn -Expression "3 4 Max"
|
||||
.EXAMPLE
|
||||
Invoke-Rpn -Expression "3 4 Log2"
|
||||
.EXAMPLE
|
||||
Invoke-Rpn -Expression "3 4 2 * 1 5 - 2 3 ^ ^ / +"
|
||||
.EXAMPLE
|
||||
Invoke-Rpn -Expression "3 4 2 * 1 5 - 2 3 ^ ^ / +" -DisplayState
|
||||
#>
|
||||
[CmdletBinding()]
|
||||
Param
|
||||
(
|
||||
[Parameter(Mandatory=$true)]
|
||||
[AllowEmptyString()]
|
||||
[string]
|
||||
$Expression,
|
||||
|
||||
[Parameter(Mandatory=$false)]
|
||||
[switch]
|
||||
$DisplayState
|
||||
)
|
||||
Begin
|
||||
{
|
||||
function Out-State ([System.Collections.Stack]$Stack)
|
||||
{
|
||||
$array = $Stack.ToArray()
|
||||
[Array]::Reverse($array)
|
||||
$array | ForEach-Object -Process { Write-Host ("{0,-8:F3}" -f $_) -NoNewline } -End { Write-Host }
|
||||
}
|
||||
|
||||
function New-RpnEvaluation
|
||||
{
|
||||
$stack = New-Object -Type System.Collections.Stack
|
||||
|
||||
$shortcuts = @{
|
||||
"+" = "Add"; "-" = "Subtract"; "/" = "Divide"; "*" = "Multiply"; "%" = "Remainder"; "^" = "Pow"
|
||||
}
|
||||
|
||||
:ARGUMENT_LOOP foreach ($argument in $args)
|
||||
{
|
||||
if ($DisplayState -and $stack.Count)
|
||||
{
|
||||
Out-State $stack
|
||||
}
|
||||
|
||||
if ($shortcuts[$argument])
|
||||
{
|
||||
$argument = $shortcuts[$argument]
|
||||
}
|
||||
|
||||
try
|
||||
{
|
||||
$stack.Push([decimal]$argument)
|
||||
continue
|
||||
}
|
||||
catch
|
||||
{
|
||||
}
|
||||
|
||||
$argCountList = $argument -replace "(\D+)(\d*)",‘$2’
|
||||
$operation = $argument.Substring(0, $argument.Length – $argCountList.Length)
|
||||
|
||||
foreach($type in [Decimal],[Math])
|
||||
{
|
||||
if ($definition = $type::$operation)
|
||||
{
|
||||
if (-not $argCountList)
|
||||
{
|
||||
$argCountList = $definition.OverloadDefinitions |
|
||||
Foreach-Object { ($_ -split ", ").Count } |
|
||||
Sort-Object -Unique
|
||||
}
|
||||
|
||||
foreach ($argCount in $argCountList)
|
||||
{
|
||||
try
|
||||
{
|
||||
$methodArguments = $stack.ToArray()[($argCount–1)..0]
|
||||
$result = $type::$operation.Invoke($methodArguments)
|
||||
|
||||
$null = 1..$argCount | Foreach-Object { $stack.Pop() }
|
||||
|
||||
$stack.Push($result)
|
||||
|
||||
continue ARGUMENT_LOOP
|
||||
}
|
||||
catch
|
||||
{
|
||||
## If error, try with the next number of arguments
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ($DisplayState -and $stack.Count)
|
||||
{
|
||||
Out-State $stack
|
||||
if ($stack.Count)
|
||||
{
|
||||
Write-Host "`nResult = $($stack.Peek())"
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
$stack
|
||||
}
|
||||
}
|
||||
}
|
||||
Process
|
||||
{
|
||||
Invoke-Expression -Command "New-RpnEvaluation $Expression"
|
||||
}
|
||||
End
|
||||
{
|
||||
}
|
||||
}
|
||||
|
||||
Invoke-Rpn -Expression "3 4 2 * 1 5 - 2 3 ^ ^ / +" -DisplayState
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
a=[]
|
||||
b={'+': lambda x,y: y+x, '-': lambda x,y: y-x, '*': lambda x,y: y*x,'/': lambda x,y:y/x,'^': lambda x,y:y**x}
|
||||
for c in '3 4 2 * 1 5 - 2 3 ^ ^ / +'.split():
|
||||
if c in b: a.append(b[c](a.pop(),a.pop()))
|
||||
else: a.append(float(c))
|
||||
print c, a
|
||||
|
|
@ -1,27 +1,29 @@
|
|||
/*REXX program evaluates a Reverse Polish notation (RPN) expression.*/
|
||||
parse arg x; if x='' then x = '3 4 2 * 1 5 - 2 3 ^ ^ / +'; ox=x
|
||||
showSteps=1 /*set to 0 (zero) if working steps not wanted.*/
|
||||
x=space(x); tokens=words(x)
|
||||
do i=1 for tokens; @.i=word(x,i); end /*i*/ /*assign input tokens*/
|
||||
L=max(20,length(x)) /*use 20 for the min show width. */
|
||||
numeric digits L /*ensure enough digits for answer*/
|
||||
say center('operand',L,'─') center('stack',L*2,'─'); e='***error!***'
|
||||
op='- + / * ^'; add2s='add to───►stack'; z=; stack=
|
||||
|
||||
do #=1 for tokens; ?=@.#; ??=? /*process each token from @. list*/
|
||||
w=words(stack) /*stack count (# entries).*/
|
||||
if datatype(?,'N') then do; stack=stack ?; call show add2s; iterate; end
|
||||
if ?=='^' then ??="**" /*REXXify ^ ──► ** (make legal)*/
|
||||
interpret 'y=' word(stack,w-1) ?? word(stack,w) /*compute.*/
|
||||
if datatype(y,'W') then y=y/1 /*normalize the number with ÷ */
|
||||
_=subword(stack,1,w-2); stack=_ y /*rebuild the stack with answer. */
|
||||
call show ?
|
||||
end /*#*/
|
||||
|
||||
z=space(z stack) /*append any residual entries. */
|
||||
say; say ' RPN input:' ox; say ' answer──►' z /*show input & ans.*/
|
||||
parse source upper . y . /*invoked via C.L. or REXX pgm?*/
|
||||
if y=='COMMAND' | \datatype(z,'W') then exit /*stick a fork in it, done.*/
|
||||
else return z /*RESULT ──► invoker.*/
|
||||
/*──────────────────────────────────SHOW subroutine─────────────────────*/
|
||||
show: if showSteps then say center(arg(1),L) left(space(stack),L); return
|
||||
/*REXX program evaluates a ═════ Reverse Polish notation (RPN) ═════ expression. */
|
||||
parse arg x /*obtain optional arguments from the CL*/
|
||||
if x='' then x= "3 4 2 * 1 5 - 2 3 ^ ^ / +" /*Not specified? Then use the default.*/
|
||||
tokens=words(x) /*save the number of tokens " ". */
|
||||
showSteps=1 /*set to 0 if working steps not wanted.*/
|
||||
ox=x /*save the original value of X. */
|
||||
do i=1 for tokens; @.i=word(x,i) /*assign the input tokens to an array. */
|
||||
end /*i*/
|
||||
x=space(x) /*remove any superfluous blanks in X. */
|
||||
L=max(20, length(x)) /*use 20 for the minimum display width.*/
|
||||
numeric digits L /*ensure enough decimal digits for ans.*/
|
||||
say center('operand', L, "─") center('stack', L+L, "─") /*display title*/
|
||||
$= /*nullify the stack (completely empty).*/
|
||||
do k=1 for tokens; ?=@.k; ??=? /*process each token from the @. list.*/
|
||||
#=words($) /*stack the count (the number entries).*/
|
||||
if datatype(?,'N') then do; $=$ ?; call show "add to───►stack"; iterate; end
|
||||
if ?=='^' then ??= "**" /*REXXify ^ ───► ** (make legal).*/
|
||||
interpret 'y='word($,#-1) ?? word($,#) /*compute via the famous REXX INTERPRET*/
|
||||
if datatype(y,'N') then y=y/1 /*normalize the number with ÷ by unity.*/
|
||||
$=subword($, 1, #-2) y /*rebuild the stack with the answer. */
|
||||
call show ? /*display steps (tracing into), maybe.*/
|
||||
end /*k*/
|
||||
say /*display a blank line, better perusing*/
|
||||
say ' RPN input:' ox; say " answer──►"$ /*display original input; display ans.*/
|
||||
parse source upper . y . /*invoked via C.L. or via a REXX pgm?*/
|
||||
if y=='COMMAND' | \datatype($,"W") then exit /*stick a fork in it, we're all done. */
|
||||
else exit $ /*return the answer ───► the invoker.*/
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
show: if showSteps then say center(arg(1), L) left(space($), L); return
|
||||
|
|
|
|||
|
|
@ -1,42 +1,43 @@
|
|||
/*REXX program evaluates a Reverse Polish notation (RPN) expression.*/
|
||||
parse arg x; if x='' then x = '3 4 2 * 1 5 - 2 3 ^ ^ / +'; ox=x
|
||||
showSteps=1 /*set to 0 (zero) if working steps not wanted.*/
|
||||
x=space(x); tokens=words(x) /*elide extra blanks;count tokens*/
|
||||
do i=1 for tokens; @.i=word(x,i); end /*i*/ /*assign input tokens*/
|
||||
L=max(20,length(x)) /*use 20 for the min show width. */
|
||||
numeric digits L /*ensure enough digits for answer*/
|
||||
say center('operand',L,'─') center('stack',L*2,'─'); e='***error!***'
|
||||
add2s='add to───►stack'; z=; stack=
|
||||
dop='/ // % ÷'; bop='& | &&' /*division ops; binary operands*/
|
||||
aop='- + * ^ **' dop bop; lop=aop '||' /*arithmetic ops; legal operands*/
|
||||
|
||||
do #=1 for tokens; ?=@.#; ??=? /*process each token from @. list*/
|
||||
w=words(stack); b=word(stack,max(1,w)) /*stack count; last entry.*/
|
||||
a=word(stack,max(1,w-1)) /*stack's "first" operand.*/
|
||||
division =wordpos(?,dop)\==0 /*flag: doing a division.*/
|
||||
arith =wordpos(?,aop)\==0 /*flag: doing arithmetic.*/
|
||||
bitOp =wordpos(?,bop)\==0 /*flag: doing binary math*/
|
||||
if datatype(?,'N') then do; stack=stack ?; call show add2s; iterate; end
|
||||
if wordpos(?,lop)==0 then do; z=e 'illegal operator:' ?; leave; end
|
||||
if w<2 then do; z=e 'illegal RPN 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
|
||||
interpret 'y=' a ?? b /*compute with two stack operands*/
|
||||
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. */
|
||||
call show ?
|
||||
end /*#*/
|
||||
|
||||
if word(z,1)==e then stack= /*handle special case of errors. */
|
||||
z=space(z stack) /*append any residual entries. */
|
||||
say; say ' RPN input:' ox; say ' answer──►' z /*show input & ans.*/
|
||||
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).*/
|
||||
/*──────────────────────────────────subroutines─────────────────────────*/
|
||||
isBit: return arg(1)==0 | arg(1)==1 /*returns 1 if arg1 is bin bit.*/
|
||||
show: if showSteps then say center(arg(1),L) left(space(stack),L); return
|
||||
/*REXX program evaluates a ═════ Reverse Polish notation (RPN) ═════ expression. */
|
||||
parse arg x /*obtain optional arguments from the CL*/
|
||||
if x='' then x= "3 4 2 * 1 5 - 2 3 ^ ^ / +" /*Not specified? Then use the default.*/
|
||||
tokens=words(x) /*save the number of tokens " ". */
|
||||
showSteps=1 /*set to 0 if working steps not wanted.*/
|
||||
ox=x /*save the original value of X. */
|
||||
do i=1 for tokens; @.i=word(x,i) /*assign the input tokens to an array. */
|
||||
end /*i*/
|
||||
x=space(x) /*remove any superfluous blanks in X. */
|
||||
L=max(20, length(x)) /*use 20 for the minimum display width.*/
|
||||
numeric digits L /*ensure enough decimal digits for ans.*/
|
||||
say center('operand', L, "─") center('stack', L+L, "─") /*display title*/
|
||||
Dop= '/ // % ÷'; Bop='& | &&' /*division operators; binary operands.*/
|
||||
Aop= '- + * ^ **' Dop Bop; Lop=Aop "||" /*arithmetic operators; legal operands.*/
|
||||
$= /*nullify the stack (completely empty).*/
|
||||
do k=1 for tokens; ?=@.k; ??=? /*process each token from the @. list.*/
|
||||
#=words($); b=word($, max(1, #) ) /*the stack count; the last entry. */
|
||||
a=word($, max(1, #-1) ) /*stack's "first" operand. */
|
||||
division =wordpos(?, Dop)\==0 /*flag: doing a some kind of division.*/
|
||||
arith =wordpos(?, Aop)\==0 /*flag: doing arithmetic. */
|
||||
bitOp =wordpos(?, Bop)\==0 /*flag: doing some kind of binary oper*/
|
||||
if datatype(?, 'N') then do; $=$ ?; call show "add to───►stack"; iterate; end
|
||||
if wordpos(?, Lop)==0 then do; $=e 'illegal operator:' ?; leave; end
|
||||
if w<2 then do; $=e 'illegal RPN expression.'; leave; end
|
||||
if ?=='^' then ??= "**" /*REXXify ^ ──► ** (make it legal). */
|
||||
if ?=='÷' then ??= "/" /*REXXify ÷ ──► / (make it legal). */
|
||||
if division & b=0 then do; $=e 'division by zero.' ; leave; end
|
||||
if bitOp & \isBit(a) then do; $=e "token isn't logical: " a; leave; end
|
||||
if bitOp & \isBit(b) then do; $=e "token isn't logical: " b; leave; end
|
||||
interpret 'y=' a ?? b /*compute with two stack operands*/
|
||||
if datatype(y, 'W') then y=y/1 /*normalize the number with ÷ by unity.*/
|
||||
_=subword($, 1, #-2); $=_ y /*rebuild the stack with the answer. */
|
||||
call show ? /*display (possibly) a working step. */
|
||||
end /*k*/
|
||||
say /*display a blank line, better perusing*/
|
||||
if word($,1)==e then $= /*handle the special case of errors. */
|
||||
say ' RPN input:' ox; say " answer───►"$ /*display original input; display ans.*/
|
||||
parse source upper . y . /*invoked via C.L. or via a REXX pgm?*/
|
||||
if y=='COMMAND' | \datatype($,"W") then exit /*stick a fork in it, we're all done. */
|
||||
else exit $ /*return the answer ───► the invoker.*/
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
isBit: return arg(1)==0 | arg(1)==1 /*returns 1 if arg1 is a binary bit*/
|
||||
show: if showSteps then say center(arg(1), L) left(space($), L); return
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue