Valid XHTML 1.1?
index.shtml, last modified: Sunday, 25-Jan-2009 20:36:52 CET
You may have heard of things such as the 99 Bottles of Beer, Hello World!, The Quine Page, Accumulator Generator, ROT13 or Mindstab Multi Language Prime Number Projects. This is a similar project. The goal is to implement a reverse polish notation calculator in as many different programming languages as possible. There are two reasons for doing this. One, it lets you compare the power and elegance (or lack thereof) of different languages (in a way a simple Hello World program won't let you do). Two, it is fun! This started out as thread in the Gentoo forums.
An RPN (a.k.a. postfix) calculator should be able to take an expression like
19 2.14 + 4.5 2 4.3 / - *
which is usually expressed as "(19 + 2.14) * (4.5 - 2 / 4.3)", and respond with
85.2974
The program should (where applicable) read expressions from standard input and print the top of the stack to standard output when a newline is encountered. The program should, but is not required to, retain the state of the operand stack between expressions.
Not all of the programs below have been confirmed to actually work.
We all want this list to grow, so please send your contributions to arnerup@kth.se.
Languages in the wishlist include, but are not limited to: ALGOL, AppleScript, Basic, Befunge, Cobol, Forth, F#, Eiffel, Modula-2, Modula-3, Oberon, PL/1 and Simula.
Honorable mention: A Unix one-liner submitted by conio:
sed -ru 's/(.+)/10k & p/' | dc
Ada
Assembler (MC68000)
Assembler (x86)
AWK
Bash
Brainfuck
C
C#
C++
Chef
Cilk
CLU
Common Lisp
D
Dylan
Emacs Lisp
Erlang
Fortran
Haskell
Icon
INTERCAL
Io
Java
JavaScript
K
Logo
Lua
Objective-C
O'Caml
OmniMark
Pascal
Perl
PHP
PostScript
Prolog
Python
REBOL
Refal
REXX
Ruby
Scala
Scheme
Sed
Smalltalk
SNOBOL4
Standard ML
TCL
Unicon
Author: nrl
Download
Uses "_" to signify negative numbers.
with Ada.Text_IO, Ada.Float_Text_IO;
use Ada.Text_IO, Ada.Float_Text_IO;
procedure rpncalc is
generic type T is private;
package stack is
type stack is limited private;
procedure push( s : in out stack; e : in T);
-- push an item onto the stack
procedure pop( s : in out stack; e : out T);
-- pop an item off the stack
procedure top( s : in stack; e : out T; n : out boolean);
-- show (without popping) the top element of a stack
-- a boolean is returned indicating if the stack is empty
function length( s : in stack) return natural;
-- Return the length of a specified stack
private
type stack_element;
type stack is access stack_element;
type stack_element is record
val : T;
next : stack := null;
end record;
end stack;
package body stack is
procedure push( s : in out stack; e : in T) is
new_element : stack;
begin
new_element := new stack_element;
new_element.all.val := e;
new_element.all.next := s;
s := new_element;
end push;
procedure pop( s : in out stack; e : out T) is
begin
e := s.all.val;
s := s.all.next;
end pop;
procedure top( s : in stack; e : out T; n : out boolean) is
begin
if s /= null then
e := s.all.val;
n := false;
else
n := true;
end if;
end top;
function length( s : in stack) return natural is
c : natural := 0;
tmp : stack := s;
begin
while tmp /= null loop
c := c + 1;
tmp := tmp.all.next;
end loop;
return c;
end length;
end stack;
-- Instantiate float version of stack
package var_stack is new stack(T => float);
use var_stack;
-- Variable declerations
vars : var_stack.stack; -- stack of floats
var : float; -- current operand
l,r,a : float; -- temp floats for operations
ch : character; -- current character
eol : boolean; -- end of line
empty : boolean; -- is the stack empty
empty_stack : exception; -- raise if stack is empty
unrec_input : exception; -- raise on unrecognised input
div_by_zero : exception; -- raise if user tries to divide by 0
num_error : exception; -- raise if user gives '_' not followed by a num
begin
while not end_of_file loop
while not end_of_line loop
INPUT:
begin
look_ahead(ch, eol);
while ch = ' ' loop
-- eat whitespace
get(ch);
look_ahead(ch, eol);
end loop;
look_ahead(ch, eol);
if ch = '+' then
get(ch);
if length(vars) >= 2 then
pop(vars, r); pop(vars, l);
push(vars, l + r);
else
raise empty_stack;
end if;
elsif ch = '-' then
get(ch);
if length(vars) >= 2 then
pop(vars, r); pop(vars, l);
push(vars, l - r);
else
raise empty_stack;
end if;
elsif ch = '/' then
get(ch);
if length(vars) >= 2 then
top(vars, r, empty);
if r = 0.0 then
raise div_by_zero;
else
pop(vars, r);
end if;
pop(vars, l);
push(vars, l / r);
else
raise empty_stack;
end if;
elsif ch = '*' then
get(ch);
if length(vars) >= 2 then
pop(vars, r); pop(vars, l);
push(vars, l * r);
else
raise empty_stack;
end if;
elsif (ch >= '0' and ch <= '9') or ch = '_' then
if ch = '_' then
get(ch);
look_ahead(ch, eol);
if ch >= '0' and ch <= '9' then
get(var);
var := -var;
else
raise num_error;
end if;
else
get(var);
end if;
push(vars, var);
else
raise unrec_input;
end if;
exception
when empty_stack =>
put_line("Warning: not enough operands! Skipping operator...");
when unrec_input =>
put_line("Warning: unrecognised operator! skipping...");
when div_by_zero =>
put_line("Warning: You asked to divide by zero! Ignoring.");
when num_error =>
put_line("Warning: Expecting a number after '_'!");
end input;
end loop;
top(vars, a, empty);
if not empty then
put(a); new_line;
end if;
look_ahead(ch, eol);
if eol then
skip_line;
end if;
end loop;
pop(vars, a);
put(a);
new_line;
end rpncalc;
Author: steel300
Download
ORG $5000
BUFSIZ EQU 80 ;input buffer size
OPSTK DS.B 20 ;size of operations stack
INPUTBUF DS.B BUFSIZ
START LEA INPUTBUF,A0 ;load address of input buffer into A0
MOVE.W #BUFSIZ,D0 ;set D0 to size of input buffer
;(A0) = address of input,
;(D0.W) = max number of characters to read
;on input (D0.W) is # of characters to input
JSR STRIN ;get input
JSR STROUT ;echo input
SUBQ #2,D0 ;adjust character count for DB instruction
LEA INPUTBUF,A1 ;set A1 to top of stack
SCANNEXT CMPI.B #'0',(A0) ;input='0'?
BLT.S EVALUATE ;if input<0 then input is operator
MOVE.B (A0)+,-(A1) ;push input onto stack
SUBI.B #'0',(A1) ;convert stack entry to binary
BRA.S CHKCNT ;test for more input
EVALUATE MOVE.B (A1)+,D2 ;pop the operand stack
MOVE.B (A1)+,D1
CMPI.B #'*',(A0)+ ;is operand an '*'?
BEQ ANDOP ;Yes it is - goto AND operand
OR.B D1,D2 ;otherwise OR arguements
BRA.S PUSHOP
ANDOP AND.B D1,D2 ;AND arguements
PUSHOP MOVE.B D2,-(A1) ;push result onto stack
CHKCNT DBF D0,SCANNEXT
PUTANS ADDI.B #'0',(A1) ;convert stack to ASCII
MOVEA.L A1,A0 ;set up pointer to output, i.e. A0
MOVE.W #1,D0 ;set up # of characters to output, i.e. D0.W
JSR STROUT
JSR NEWLINEAuthor: Joris Huizer
Download
[section .bss]
state: resd 2
buffer: resb 0x100000
[section .data]
p: dd buffer + 1
[section .rodata]
printFormat:
scanFormat: db "%lf",10,0
error: db "error",10,0
[section .text]
extern sscanf, getchar, printf
%macro ifnspace 1
cmp eax, 32
je %%skip
cmp eax, 9
jne %1
%%skip:
%endmacro
%macro ifspace 1
cmp eax, 32
je %1
cmp eax, 9
je %1
%endmacro
%macro sethandler 1
mov [state], esp
mov dword [state + 4], %1
%endmacro
%macro longret 0
mov esp, [state]
jmp [state + 4]
%endmacro
eval:
sub esp, 12
.next:
sub ebx, 1
movsx eax, byte [ebx]
ifnspace .found
cmp ebx, buffer
jg .next
.error:
longret
.found:
cmp byte [ebx], '+'
je .add
cmp byte [ebx], '-'
je .sub
cmp byte [ebx], '*'
je near .mul
cmp byte [ebx], '/'
je near .div
.skip:
sub ebx, 1
movsx eax, byte [ebx]
ifnspace .skip
add ebx, 1
lea eax, [esp]
mov [esp + 8], eax
mov eax, scanFormat
mov [esp + 4], eax
mov [esp], ebx
call sscanf
cmp eax, 0
je .error
fld qword [esp]
add esp, 12
ret
%macro operandhandler 1
.%1:
call eval
; pop value
fstp qword [esp]
call eval
fld qword [esp]
f%1p st1, st0
add esp, 12
ret
%endmacro
operandhandler add
operandhandler sub
operandhandler mul
operandhandler div
global main
main:
sub esp, 12
mov byte [buffer], ' '
sethandler .error
mov ebx, [p]
.scanloop:
call getchar
cmp eax, -1
je near .exit
cmp eax, 10
je .calc
cmp eax, 13
je .calc
mov [ebx], al
add ebx, 1
jmp short .scanloop
.calc:
sub ebx, 1
cmp ebx, buffer
jle near .tonext
movsx eax, byte [ebx]
ifspace .calc
add ebx, 1
mov byte [ebx], ' '
add ebx, 1
call eval
.getend:
sub ebx, 1
cmp ebx, buffer
jle .print
movsx eax, byte [ebx]
ifspace .getend
.print:
cmp ebx, buffer
jne .error
fstp qword [esp + 4]
mov eax, printFormat
mov [esp], eax
call printf
jmp short .tonext
.error:
fstp qword [esp + 4]
mov eax, error
mov [esp], eax
call printf
.tonext:
mov eax, buffer
add eax, 1
mov ebx, eax
jmp .scanloop
.exit:
add esp, 12
ret
Author: far
Download
#!/bin/awk -f
function push(x) { stack[++sp] = x; }
function pop() { if(sp > 0) sp--; else err = "Stack underflow"; }
function top(){ if(sp > 0) print stack[sp]; }
function eval(x) {
if(x != "-" && (x ~ /^[-.0-9][0-9]*[.0-9]?[0-9]*$/)) push(x);
else {
second = stack[sp]; pop();
first = stack[sp]; pop();
if(x == "+") push(first + second);
else if(x == "-") push(first - second);
else if(x == "*") push(first * second);
else if(x == "/") push(first / second);
else err = "Bad operator: " + x;
}
}
BEGIN { sp = 0; }
{
err = "";
for(i = 1; i <= NF; i++) { eval($i); if(err) break; }
if(!err) top();
else print "Error:", err;
}
Author: ecatmur
Download
With floating point:
#!/bin/bash
shopt -s extglob
# Bash arithmetic is in 64-bit integers, from -2^63 to 2^63-1.
# We emulate floating point arithmetic with paired integers for integer and
# fractional part; we work to 9 figures as 2^63~=9.22e18.
# A better implementation would use true floating-point arithmetic.
function flop() {
local op=$2
local x=$1
local y=$3
local sig mod num ipart fpart places raise
local a
for a in x y; do
if [[ ${!a} == -* ]]; then
sig=-
mod=${!a:1}
elif [[ ${!a} == +* ]]; then
sig=+
mod=${!a:1}
else
sig=+
mod=${!a}
fi
mod=${mod/#+(0)}; [[ "$mod" ]] || mod=0
num=${mod/.}
case ${mod} in
+([[:digit:]])?(.))
ipart=${mod/.}; fpart=0; places=0;;
.+([[:digit:]]))
ipart=0; fpart=${mod/.}; places=${#fpart};;
+([[:digit:]]).+([[:digit:]]))
ipart=${mod/%.*}; fpart=${mod/#*.}; places=${#fpart};;
*)
num=0; ipart=0; fpart=0; places=0;;
esac
fpart=${fpart/#+(0)}; [[ "$fpart" ]] || fpart=0
ipart=$sig$ipart; fpart=$sig$fpart
# Pure evil {^_^}
local name
for name in sig mod num ipart fpart places; do
eval $a$name=${!name}
done
done
case $op in
[+-])
ipart=$((xipart $op yipart))
places=$((xplaces > yplaces ? xplaces : yplaces))
if [[ $places -ge 17 ]]; then
# Include sign in length
xfpart=${xfpart:0:17}
yfpart=${yfpart:0:17}
xplaces=$((xplaces > 16 ? 16 : xplaces))
yplaces=$((yplaces > 16 ? 16 : yplaces))
places=16
fi
fpart=$((xfpart * 10 ** (places - xplaces) $op yfpart * 10 ** (places - yplaces)))
if [[ $fpart -lt 0 ]]; then
ipart=$((ipart - 1))
fpart=$((10 ** places + fpart))
elif [[ $fpart -gt $((10 ** places)) ]]; then
ipart=$((ipart + 1))
fpart=$((fpart - 10 ** places))
fi
if [[ ${#fpart} -lt $places ]]; then
fpart=$((10 ** (places - ${#fpart})))$fpart
fpart=${fpart:1}
fi
ipart=${ipart/#+}
fpart=${fpart/%+(0)}
echo $ipart.$fpart
;;
[m])
places=$((xplaces + yplaces))
if [[ $places -ge 18 ]]; then
xnum=${xnum:0:9}
ynum=${ynum:0:9}
places=$(((xplaces > 8 ? 8 : xplaces) + (yplaces > 8 ? 8 : yplaces)))
fi
num=$((xnum * ynum))
if [[ ${#num} -ge $places ]]; then
ipart=${num:0:$((${#num} - places))}
fpart=${num:$((${#num} - places))}
elif [[ ${#num} -eq $places ]]; then
ipart=0
fpart=$num
else
ipart=0
fpart=$((10 ** (places - ${#num})))$num
fpart=${fpart:1}
fi
if [[ $xsig == $ysig ]]; then sig=; else sig=-; fi
fpart=${fpart/%+(0)}
echo $sig$ipart.$fpart
;;
[d])
if [[ $ynum -eq 0 ]]; then
echo "Division by zero" >&2
return 1
fi
raise=$((19 - ${#xnum}))
num=$(((xnum * 10 ** raise) / ynum))
places=$((raise + xplaces - yplaces))
if [[ ${#num} -ge $places ]]; then
ipart=${num:0:$((${#num} - places))}
fpart=${num:$((${#num} - places))}
elif [[ ${#num} -eq $places ]]; then
ipart=0
fpart=$num
else
ipart=0
fpart=$((10 ** (places - ${#num})))$num
fpart=${fpart:1}
fi
if [[ $xsig == $ysig ]]; then sig=; else sig=-; fi
fpart=${fpart/%+(0)}
echo $sig$ipart.$fpart
;;
esac
}
declare -a stack
while read line; do
[[ "$line" ]] || exit 0
stack=( )
line=${line//\\*/m}
for token in ${line//\//d}; do
case $token in
[dm+-])
if [[ ${#stack[@]} -gt 1 ]]; then
result=$(flop ${stack[1]} $token ${stack[0]})
stack=( $result ${stack[@]:2} )
else
echo "Stack underflow"
fi
;;
?(-)+([[:digit:].]))
stack=( $token ${stack[@]} )
;;
*)
echo "Bad operator: $token"
esac
done
[[ ${#stack[@]} -gt 0 ]] \
&& echo ${stack[$((${#stack[@]}-1))]}
doneAuthor: ecatmur
Download
Without floating point:
#!/bin/bash
shopt -s extglob
while read line; do
stack=()
for token in ${line//\\*/m}; do
case $token in
[/m+-]) stack=($((${stack[1]} ${token/m/*} ${stack[0]})) ${stack[@]:2});;
?(-)+([[:digit:]])) stack=($token ${stack[@]});;
*) echo "Bad operator: $token"
esac
done
echo ${stack[$((${#stack[@]}-1))]}
doneAuthor: ecatmur
Download
Obfuscated:
bash -c 'set -f;g(){ read l&&(s=();for t in $l;do [[ $t<0 ]]&&s=($((${s[1]}$t$s)) ${s[@]:2})||s=($t ${s[@]});done;echo $s;g)};g'Author: pYrania
Download
+[-,>+>+>+>+>+>+<<<<<<-------------[>-<-------------------[>>-<<----------[>>>-< <<-[>>>>-<<<<--[>>>>>-<<<<<--[>>>>>>[-]>+<<<<<<<-]]]]]]>[->->->->->-<<<<<]>[->-> ->->-<<<<<<+>>]>[->->->-<<<<<<<-<-[>[>+>+<<-]>>[<<+>>-]<<<-]+>[-]+>[<<+>>-]>>]>[ ->->-<<<<<<<-[<+>-]+>>>>]>[->-<<<<<<<-[<->-]+>>>>>]>[-<<<<<<<-[>+>+<<-]>->[<<+>> -]<<<-[>>>>+<<[>+>[-]<<-]>[<+>-]>[-<<<[>+>+<<-]>>[<<+>>-]>>+<]<<-<<-]+>[-]+>[-]> >>[<<<<<+>>>>>-]>>]>[<+>>,>++++++++[<---->-]<[>+++++[<--->-],>++++++++[<---->-]< ]<[<]>>[<-[>++++++++++<-]+>>]<[[<]>+[>]<-]<[-<]>[<<<<<<+>>>>>>-]<<<<<+>>>>>>>]<< <<<<<]<[>>+<<-]>+>-[>+<<[-]>-]>[<+>-]<[>+++++++++<[>>>+<<[>+>[-]<<-]>[<+>-]>[<<+ +++++++++>>>+<-]<<-<-]<++++++++++>>[<<->>-]>>[-]>[<<<+>>>-]<<<]<[>]<[->++++++++[ <++++++>-]<.[-]<]>>
Author: far
Download
My original implementation.
#include <stdio.h>
#include <ctype.h>
#define STACK_SIZE 50
#define LINE_MAX 300
#define TOKEN_MAX 20
#define _Str(x) #x
#define Str(x) _Str(x)
float stack[STACK_SIZE];
float *sp = stack-1;
float *sp_max = &stack[STACK_SIZE-1];
#define full() (sp == sp_max)
#define empty() (sp == (stack-1))
void push(float value) {
if(!full()) *(++sp) = value;
else fprintf(stderr, "Stack overflow\n");
}
float pop() {
if(!empty()) return *(sp--);
fprintf(stderr, "Stack underflow\n");
return 0;
}
float apply_operator(char op, float first, float second) {
switch(op) {
case '+': return first + second;
case '-': return first - second;
case '*': return first * second;
case '/': return first / second;
default: fprintf(stderr, "Bad operator: %c\n", op);
return 0;
}
}
char *next_token(char *linep) {
while(isspace(*(linep++)));
while(*linep && !isspace(*(linep++)));
return linep;
}
int main() {
for(;;) {
float value;
char line[LINE_MAX];
char *linep;
if(feof(stdin))
return 0;
fgets(line, LINE_MAX, stdin);
linep = line;
for(;;) {
char token[TOKEN_MAX+1];
if(!linep) break;
if(sscanf(linep, "%" Str(TOKEN_MAX) "s", token) != 1)
break;
if(sscanf(token, "%f", &value)) push(value);
else {
float second = pop();
float first = pop();
push(apply_operator(token[0], first, second));
}
linep = next_token(linep);
}
if(!empty()) printf("%f\n", *sp);
}
}
Author: Boyko Bantchev
Download
This implementation uses a recursive approach instead of an explicit stack.
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <setjmp.h>
char *pb, *p;
jmp_buf env;
double eval() {
double x;
if (isspace(*--p)) {
while (p>pb && isspace(*p)) --p;
if (p>pb) switch (*p) {
case '+': return eval()+eval();
case '*': return eval()*eval();
case '-': return x=eval(),eval()-x;
case '/': return x=eval(),eval()/x;
default: while (!isspace(*--p)) ;
if (sscanf(++p,"%lf",&x)) return x;
}
}
longjmp(env,0);
}
int main() {
int sz,c,n;
double x;
pb = (char*)malloc(sz=4);
*pb = ' ';
p = pb+1;
while ((c=getchar())!=EOF)
if (c!='\n' && c!='\r') {
n = p-pb;
if (n+2==sz) pb = (char*)realloc(pb,sz*=2);
p = pb+n;
*p++ = c;
} else {
while (--p>pb && isspace(*p)) ;
if (p>pb) {
*++p = ' '; ++p;
if (!setjmp(env)) {
x = eval();
while (--p>pb && isspace(*p)) ;
if (p>pb) longjmp(env,0);
printf("%f\n",x);
}
else printf("error\n");
p = pb+1;
}
}
return 0;
}
Author: Boyko Bantchev
Download
C with lex & yacc
Lex and yacc are the classic syntax analyzer generators. Lex transforms an input text into a token series, where tokens are defined by means of regular expressions. Given a grammar (defining which sequences of tokens are correct), yacc generates a parser.
***** lex part *****
%{
#include <stdlib.h>
#define NUM 257
double yylval;
%}
INT [0-9]+
NUM ([+-]?)(\.{INT}|{INT}(\.{INT}?)?)
%%
{NUM} {yylval = atof(yytext); return NUM;}
[ \t]* ;
.|\n {return yytext[0];}
%%
int yywrap() {return 1;}
***** yacc part *****
%{
#include <stdio.h>
void yyerror(char*s) {printf("%s\n",s);}
extern int yylex();
extern int yywrap();
#define YYSTYPE double
%}
%token NUM
%%
input: /**/ | input line
;
line: '\n' | rpn '\n' {printf("%f\n",$1);}
| error '\n' {yyerrok;}
;
rpn: NUM
| rpn rpn '+' {$$=$1+$2;}
| rpn rpn '-' {$$=$1-$2;}
| rpn rpn '*' {$$=$1*$2;}
| rpn rpn '/' {$$=$1/$2;}
;
%%
int main() {yyparse(); return 0;}
Author: carambola5
Download
I modified this to have better error handling.
using System;
using System.Collections;
class RPN
{
static void Main()
{
Stack s = new Stack();
string line;
while((line = Console.In.ReadLine()) != null)
{
foreach(string a in line.Split(new char[] {' '}))
{
if(a.Length == 0)
continue;
try{ s.Push(Double.Parse(a) + ""); }
catch (Exception e)
{
try
{
double d2 = Double.Parse((string)s.Pop());
double d1 = Double.Parse((string)s.Pop());
switch (a)
{
case "+": s.Push(d1 + d2 + ""); break;
case "-": s.Push(d1 - d2 + ""); break;
case "*": s.Push(d1 * d2 + ""); break;
case "/": s.Push(d1 / d2 + ""); break;
default: Console.WriteLine("unknown operator: " + a);
break;
}
}
catch (Exception e2) { Console.WriteLine("stack underflow"); }
}
}
Console.WriteLine(s.Count != 0 ? s.Peek() : "<empty>");
}
}
}
Author: int2str
Download
#include <iostream>
#include <string>
#include <stack>
using namespace std;
class CTokenizer
{
public:
CTokenizer( string &s )
{
_s = s;
_ch = strtok( (char*)_s.c_str(), " " );
}
char * get() { return _ch; }
bool next() { _ch = strtok( NULL, " " ); return _ch; }
bool is_value() { return sscanf( _ch, "%f", &_f ); }
float get_value() { return _f; }
protected:
string _s;
float _f;
char *_ch;
};
class CRpnCalc
{
public:
CRpnCalc( string &s ) { _tok = new CTokenizer( s ); }
~CRpnCalc() { delete _tok; }
float eval()
{
while ( NULL != _tok->get() )
{
if ( _tok->is_value() )
_st.push( _tok->get_value() );
else
{
float f2 = _pop();
float f1 = _pop();
_st.push( _calc( f1, f2, _tok->get() ) );
}
_tok->next();
}
if ( !_st.empty() )
return _pop();
return 0;
}
protected:
stack < float > _st;
CTokenizer * _tok;
float _pop()
{
float f = 0;
if ( !_st.empty() )
{
f = _st.top();
_st.pop();
}
else
cout << "Buffer underrun!" << endl;
return f;
}
float _calc( float f1, float f2, char * op )
{
float f = 0;
switch( op[0] )
{
case '+': f = f1 + f2; break;
case '-': f = f1 - f2; break;
case '*': f = f1 * f2; break;
case '/': f = f1 / f2; break;
default:
cout << "Invalid operator '" << op[0] << "'" << endl;
break;
}
return f;
}
};
int main()
{
while ( true )
{
string s;
getline( cin, s );
if ( strlen( s.c_str() ) > 0 )
{
CRpnCalc rpn( s );
cout << rpn.eval() << endl;
}
}
return 0;
}
Author: int2str
Download
#include <iostream>
#include <string>
#include <stack>
using namespace std;
stack < float > st;
#define POP(f) if ( st.empty() ) cout << "Buffer underrun" << endl; else { f=st.top(); st.pop(); }
int main()
{
while ( true )
{
string s;
char *tok;
float f;
getline( cin, s );
tok = strtok( (char*)s.c_str(), " " );
while ( NULL != tok )
{
if ( sscanf( tok, "%f", &f ))
st.push( f );
else
{
float f1, f2;
POP(f2); POP(f1);
switch( tok[0] )
{
case '+': st.push( f1+f2 ); break;
case '-': st.push( f1-f2 ); break;
case '*': st.push( f1*f2 ); break;
case '/': st.push( f1/f2 ); break;
default: cout << "invalid operation" << endl;
}
}
tok = strtok( NULL, " " );
}
if ( st.size() == 1 )
{
cout << st.top() << endl;
st.pop();
} else
return 1;
}
return 0;
}
Author: ecatmur
Download
As far as I know, there is no Chef implementation that can run this.
Reverse Polish Notation Bigos with Herring in Sour Cream, Polish Almond Soup,
and Polish Apple Cake.
Bigos is Poland's national dish. There is a variety in ingredients - some have
mushrooms and juniper berries, while others contain apples, lamb or beef. It is
best made a two days in advance and reheated on low heat before serving. Its
flavor improves as it matures, tastes best on the third day. There are as many
variations of Bigos as there are Polish kitchens.
Ingredients.
1 cup chopped bacon
454 g boneless pork, cut into small cubes
3 cloves of garlic, minced
3 onions, quartered
681 g mushrooms, quartered
2 cups beef stock
2 tablespoons sugar
2 cups sauerkraut, rinsed under cold water and drained
Cooking time: 3 hours.
Pre-heat oven to 220 degrees Celsius (gas mark 9).
Method.
Take boneless pork, cut into small cubes from refrigerator. Simmer the boneless
pork, cut into small cubes. Put onions, quartered into 1st mixing bowl. Remove
onions, quartered from 1st mixing bowl. Fold sauerkraut, rinsed under cold
water and drained into 1st mixing bowl. Put chopped bacon into 1st mixing bowl.
Add boneless pork, cut into small cubes to 1st mixing bowl. Fold boneless pork,
cut into small cubes into 1st mixing bowl. Put chopped bacon into 1st mixing
bowl. Fold cloves of garlic, minced into 1st mixing bowl. Brown the boneless
pork, cut into small cubes.
Clean 1st mixing bowl. Put chopped bacon into 1st mixing bowl. Fold cloves of
garlic, minced into 1st mixing bowl. Parboil the boneless pork, cut into small
cubes. Saut\x{0418} the boneless pork, cut into small cubes. Mull the boneless pork,
cut into small cubes. Decoct the boneless pork, cut into small cubes. Spoil the
cloves of garlic, minced.
Put boneless pork, cut into small cubes into 2nd mixing bowl. Cremate the
cloves of garlic, minced until spoiled. Devil the boneless pork, cut into
small cubes until decocted. Steam the cloves of garlic, minced. Fold mushrooms,
quartered into 2nd mixing bowl. Fold beef stock into 2nd mixing bowl. Put
chopped bacon into 1st mixing bowl. Fold cloves of garlic, minced into 1st
mixing bowl. Sear the mushrooms, quartered. Grill the cloves of garlic, minced.
Put beef stock into 1st mixing bowl. Divide mushrooms, quartered into 1st
mixing bowl. Fold sugar into 1st mixing bowl. Put sugar into 2nd mixing bowl.
Griddle the cloves of garlic, minced until grilled. Reduce the mushrooms,
quartered until seared. Brew the cloves of garlic, minced.
Serve with Herring in Sour Cream.
Put mushrooms, quartered into 2nd mixing bowl. Percolate the cloves of garlic,
minced until brewed. Braise the cloves of garlic, minced until steamed. Imbue
the boneless pork, cut into small cubes until mulled. Steep the cloves of
garlic, minced. Fold mushrooms, quartered into 2nd mixing bowl. Fold beef stock
into 2nd mixing bowl. Put beef stock into 1st mixing bowl. Combine mushrooms,
quartered into 1st mixing bowl. Fold sugar into 1st mixing bowl. Put sugar
into 2nd mixing bowl. Bake the cloves of garlic, minced until steeped.
Seethe the boneless pork, cut into small cubes until saut\x{0418}ed. Stew the cloves
of garlic, minced. Fold mushrooms, quartered into 2nd mixing bowl. Fold beef
stock into 2nd mixing bowl. Put beef stock into 1st mixing bowl. Remove
mushrooms, quartered from 1st mixing bowl. Fold sugar into 1st mixing bowl.
Put sugar into 2nd mixing bowl. Coddle the cloves of garlic, minced until
stewed.
Fry until the boneless pork, cut into small cubes parboiled. Toast the cloves
of garlic, minced. Fold mushrooms, quartered into 2nd mixing bowl. Fold beef
stock into 2nd mixing bowl. Put beef stock into 1st mixing bowl. Add mushrooms,
quartered to 1st mixing bowl. Fold sugar into 1st mixing bowl. Put sugar into
2nd mixing bowl. Curry the cloves of garlic, minced until toasted. Take
boneless pork, cut into small cubes from refrigerator. Barbecue the boneless
pork, cut into small cubes until browned. Fold sauerkraut, rinsed under cold
water and drained into 2nd mixing bowl.
Clean 1st mixing bowl. Put sauerkraut, rinsed under cold water and drained into
1st mixing bowl.
Serve with Polish Almond Soup.
Sizzle the boneless pork, cut into small cubes until simmered.
Serve with Polish Apple Cake.
Pour contents of the 1st mixing bowl into the 1st baking dish.
Serves 1.
Herring in Sour Cream.
Poland has one of the world's great cuisines, which have evolved over the
centuries. Polish food reflects the history and geography of the country - it
is mix of influences: Russian, German, Italian, Ukrainian, Lithuanian, and
Jewish traditions have left their mark. The blending of this diversity with
traditional favorites results in a cuisine that is diverse and delicious.
Ingredients.
32 salted herring fillets
3 large onion, peeled and chopped
3 garlic cloves, crushed
1 cup sour cream
1 teaspoon lemon juice
6 hard-boiled eggs, peeled and chopped
14 teaspoons salt
25 teaspoons pepper
2 tablespoons dill or parsley
Method.
Put salted herring fillets into 1st mixing bowl. Combine large onion, peeled
and chopped into 1st mixing bowl. Fold garlic cloves, crushed into 1st mixing
bowl.
Clean 1st mixing bowl.
Put salted herring fillets into 2nd mixing bowl. Add lemon juice to 2nd mixing
bowl. Fold sour cream into 2nd mixing bowl. Put sour cream into 1st mixing bowl.
Put garlic cloves, crushed into 2nd mixing bowl. Add salt to 2nd mixing bowl.
Add lemon juice to 2nd mixing bowl. Fold sour cream into 2nd mixing bowl. Put
sour cream into 1st mixing bowl. Fold sour cream into 2nd mixing bowl. Add
large onion, peeled and chopped to 1st mixing bowl. Add hard-boiled eggs,
peeled and chopped to 2nd mixing bowl. Remove lemon juice from 2nd mixing
bowl. Fold sour cream into 2nd mixing bowl. Put sour cream into 1st mixing
bowl. Fold sour cream into 2nd mixing bowl. Add pepper to 2nd mixing bowl. Add
lemon juice to 2nd mixing bowl. Fold sour cream into 2nd mixing bowl. Put sour
cream into 1st mixing bowl. Fold sour cream into 2nd mixing bowl. Put salted
herring fillets into 1st mixing bowl.
Add pepper to 2nd mixing bowl. Fold sour cream into 2nd mixing bowl. Put sour
cream into 1st mixing bowl. Add dill or parsley to 2nd mixing bowl. Fold sour
cream into 2nd mixing bowl. Put sour cream into 1st mixing bowl. Put salted
herring fillets into 1st mixing bowl. Add hard-boiled eggs, peeled and chopped
to 2nd mixing bowl. Remove lemon juice from 2nd mixing bowl. Fold sour cream
into 2nd mixing bowl. Put sour cream into 1st mixing bowl. Fold sour cream into
2nd mixing bowl. Remove lemon juice from 1st mixing bowl.
Add hard-boiled eggs, peeled and chopped to 2nd mixing bowl. Add large onion,
peeled or chopped to 2nd mixing bowl. Fold sour cream into 2nd mixing bowl. Put
sour cream into 1st mixing bowl. Fold sour cream into 2nd mixing bowl. Add
pepper to 2nd mixing bowl. Remove large onion, peeled or chopped from 2nd
mixing bowl. Fold sour cream into 2nd mixing bowl. Put sour cream into 1st
mixing bowl. Fold sour cream into 2nd mixing bowl.
Add hard-boiled eggs, peeled and chopped to 2nd mixing bowl. Add large onion,
peeled or chopped to 2nd mixing bowl. Fold sour cream into 2nd mixing bowl. Put
sour cream into 1st mixing bowl. Fold sour cream into 2nd mixing bowl. Remove
salted herring fillets from 2nd mixing bowl. Add hard-boiled eggs, peeled and
chopped to 2nd mixing bowl. Remove dill or parsley from 2nd mixing bowl. Fold
sour cream into 2nd mixing bowl. Put sour cream into 1st mixing bowl.
Liquefy contents of the 1st mixing bowl.
Clean the 2nd mixing bowl.
Refrigerate for 2 hours.
Polish Almond Soup.
Soup are very important part of the Polish cuisine. Typical soups are Barszcz
or red beet soup, served with stuffed dumplings; \x{017B}urek - a fermented rye soup;
or Ch\x{0142}odnik, a soup made of cold beets and vegetables in sour milk. Some other
soups include grzybowa (wild mushroom), og\x{0443}rkowa (pickle) and kapu\x{015B}niak
(cabbage). All varieties are delicious and satisfying.
Ingredients.
227 g almonds, blanched and finely ground
5 cups milk
1 teaspoon almond extract
2 cups rice, cooked
3 tablespoons sugar
2 tablespoons butter
1 cup raisins or currants
Method.
Refrigerate for 1 hour.
Polish Apple Cake.
Traditional Polish desserts are apple cakes (szarlotka), cheesecake (sernik)
and poppy seed rolls (makowiec). There are also layer cakes, apple tarts,
Easter cakes, cream cakes and doughnuts.
Cooking time: 1 hour.
Pre-heat oven to 180 degrees Celsius (gas mark 6).
Method.
11 medium apples
3 cups sugar
4 cups raisins
5 cups toasted almonds
1 teaspoon lemon juice
2 eggs
2 tablespoons ground up flax seeds
12 cups oil
2 cups flour
1 cup quick cooking oats
1 teaspoon baking soda
1 teaspoon baking powder
4 teaspoons almond extract
2 pinches ground cinnamon
Put medium apples into 2nd mixing bowl. Combine sugar into 2nd mixing bowl.
Fold eggs into 2nd mixing bowl. Put eggs into 1st mixing bowl. Put eggs into
3rd mixing bowl. Combine sugar into 3rd mixing bowl. Add ground up flax seeds
to 3rd mixing bowl. Fold eggs into 3rd mixing bowl. Put eggs into 1st mixing
bowl. Put raisins into 3rd mixing bowl. Combine almonds into 3rd mixing bowl.
Fold eggs into 3rd mixing bowl. Add eggs to 1st mixing bowl. Put medium apples
into 2nd mixing bowl. Combine oil into 2nd mixing bowl. Divide ground cinnamon
into 2nd mixing bowl. Fold eggs into 2nd mixing bowl. Put eggs into 1st mixing
bowl.
Ponask the almond extract. Liquefy contents of the 1st mixing bowl. Mix the 3rd
mixing bowl well. Stir baking powder into the 2nd mixing bowl. Stir the 3rd
mixing bowl for 4 minutes. Put quick cooking oats into 2nd mixing bowl. Remove
baking soda from 2nd mixing bowl. Fold almond extract into 2nd mixing bowl.
Bake until ponasked.
Refrigerate.Author: Boyko Bantchev
Download
In the implementation given below, an expression is first (syntax-checked and) `compiled' so that it can then be evaluated by spawning a thread for each arithmetic operation. Otherwise it is a C program; if the keywords cilk, spawn and sync are removed, what remains is a correct C implementation.
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <cilk.h>
struct {int oper,span; double val;} * expr;
char *pb;
int isz,ssz;
#define OI(i) (expr[i-1].span)
int compile(int c) {
int n,s,k,i;
double x;
char *p,*q,*qq, op[] = "+-*/";
for (
p = pb, n = s = k = 0
; c!=EOF && c!='\n' && c!='\r'
; *p++ = c, ++n, c=getchar()
) {
if (c==' ' || c=='\t') s = 0;
else if (s==0) {s = 1; ++k;}
if (n+1==isz) {
pb = realloc(pb,isz*=2);
p = pb+n;
}
}
*p = 0; // a line just read, now parse & compile it
if (ssz<k) expr = realloc(expr,(ssz=k)*sizeof(*expr));
for (i=n=0,p=pb; i<k; p=NULL,++i) {
q = strtok(p," \t");
if (q[1]==0 && NULL!=(qq=strchr(op,*q))) {
if (n<2) return -1;
expr[i].oper = 1+(qq-op);
expr[i].span = OI(OI(i));
--n;
} else if (x=strtod(q,&qq),qq==q+strlen(q)) {
expr[i].val = x;
expr[i].oper = 0;
expr[i].span = i;
++n;
} else return -1;
}
if (n>1) return -1;
return k;
}
cilk double eval(int n) {
double x,y;
if (expr[n].oper==0) return expr[n].val;
y = spawn eval(n-1);
x = spawn eval(OI(n)-1);
sync;
switch (expr[n].oper) {
case 1: return x+y;
case 2: return x-y;
case 3: return x*y;
case 4: return x/y;
}
}
cilk int main() {
int c,k;
double x;
pb = malloc(isz=2);
expr = malloc((ssz=1)*sizeof(*expr));
while ((c=getchar())!=EOF) {
k = compile(c);
if (k>0) {
x = spawn eval(k-1); sync;
printf("%f\n",x);
} else if (k<0) printf("error\n");
}
return 0;
}
Author: Boyko Bantchev
Download
ac = array[char]
ai = array[int]
ar = array[real]
ap = sequence[proctype(real,real) returns(real)
signals(overflow,underflow,zero_divide)]
start_up = proc()
op:ap := ap$[real$add,real$sub,real$mul,real$div]
ous:stream := stream$primary_output()
rs:ar := ar$new()
skip:bool := false
for s:string in getword() do
x,y:real
if skip then exit error
elseif string$empty(s) then
if 1<ar$size(rs) then exit error
elseif ~ar$empty(rs) then
y := ar$remh(rs)
stream$putl(ous,real$unparse(y))
end
else
x := real$parse(s)
except when bad_format:
if 1=string$size(s) then
y,x := ar$remh(rs),ar$remh(rs)
x := op[string$indexc(s[1],"+-*/")](x,y)
else exit error end
end
ar$addh(rs,x)
end
except when error,bounds,overflow,underflow,zero_divide:
skip := ~string$empty(s)
if ~skip then
stream$putl(ous,"error")
ar$trim(rs,1,0)
end
end
end
end start_up
getword = iter() yields (string)
ins:stream := stream$primary_input()
cs:ac := ac$new()
w:string c:char := ' '
while true do
while c=' ' cor c='\t' do
c := stream$getc(ins)
end
if c='\n' then c := ' ' end
while 0=string$indexc(c," \t\n") do
ac$addh(cs,c)
c := stream$getc(ins)
end
w := string$ac2s(cs)
yield (w)
ac$trim(cs,1,0)
end
except when end_of_file: end
end getword
Author: Howard Ding
Download
(defun rpn (stream)
(let ((stack nil))
(loop for x = (read stream nil nil)
while x
do (if (numberp x)
(push x stack)
(let ((a (pop stack))
(b (pop stack)))
(push (funcall x b a) stack)))
do (format t "~&~a" car stack)
finally (return stack))))
(rpn *standard-input*)
Author: Howard Ding
Download
(defun rpn-2 (stream &optional stack)
(let ((x (read stream nil nil)))
(when x
(if (numberp x)
(push x stack)
(let ((a (pop stack))
(b (pop stack)))
(push (funcall x b a) stack))))
(format t "~&~a" stack)
(if x
(rpn-2 stream stack)
stack)))
(rpn-2 *standard-input*)
Author: Simen Kjærås
Download
module RPNCalc;
import std.stdio;
import std.string;
import std.conv;
alias char[] mstring;
void operator(mstring s, ref float[] stack) {
switch (s) {
case "+": stack[$-2] += stack[$-1];
break;
case "-": stack[$-2] -= stack[$-1];
break;
case "*": stack[$-2] *= stack[$-1];
break;
case "/": stack[$-2] /= stack[$-1];
break;
default:
stack ~= to!(float)(s);
return;
}
stack.length = stack.length -1;
}
void main() {
float[] stack;
while (true) {
mstring data;
readln(data);
data = data.dup;
mstring s;
while ((s = munch(data, "-0123456789.+*/")) != "") {
data = cast(mstring)strip(cast(string)data);
operator(s, stack);
}
if (data.length > 0) {
operator(data, stack);
}
writefln(stack);
stack.length = 0;
}
}Author: Boyko Bantchev
Download
module: rpn
define function rpn()
let (#rest s) = split("[ \t]",read-line(*standard-input*));
if (~s.empty?) process-line(s); end;
rpn();
end;
define function process-line(s)
block()
local method process-term(r,s)
let op = block()
assert(1 = s.size);
$ops[s[0]];
exception(<condition>) #f; end;
add!(r, if (op)
let (z,y) = values(r.pop,r.pop);
op(y,z);
else
let (x,i) = string-to-float(s);
assert(i = s.size);
x;
end);
end;
let r = reduce(process-term,make(<deque>),s);
assert(1 = r.size);
format-out("%d\n",r.pop);
exception(<condition>) format-out("error\n"); end;
force-output(*standard-output*);
end;
define table $ops =
{'+' => \+, '-' => \-, '*' => \*, '/' => \/};
block()
rpn();
exception(<end-of-stream-error>) end;
Author: far
Download
(defvar rpn-mode-map nil)
(if rpn-mode-map
()
(setq rpn-mode-map (make-sparse-keymap))
(define-key rpn-mode-map "=" 'rpn-mode-eval-at-point))
(defun rpn-mode-to-lisp (tokens)
(cond ((null tokens) (cons () ()))
((numberp (car tokens)) (cons (float (car tokens)) (cdr tokens)))
(t (let* ((sndresult (rpn-mode-to-lisp (cdr tokens)))
(fstresult (rpn-mode-to-lisp (cdr sndresult)))
(snd (car sndresult)) (fst (car fstresult)))
(if (or (null fst) (null snd))
(error "Stack underflow")
(cons (list (car tokens) fst snd) (cdr fstresult)))))))
(defun rpn-mode-eval-region (rbegin rend)
(interactive "r")
(message (prin1-to-string
(eval (car (rpn-mode-to-lisp
(mapcar (lambda (s) (car (read-from-string s)))
(reverse (split-string
(buffer-substring
rbegin rend))))))))))
(defun rpn-mode-eval-buffer ()
(interactive)
(rpn-mode-eval-region (point-min) (point-max)))
(defun rpn-mode-eval-at-point ()
(interactive)
(rpn-mode-eval-region (point-min) (point)))
(defun rpn-mode ()
"Major mode implementing an RPN calculator"
(interactive)
(kill-all-local-variables)
(use-local-map rpn-mode-map)
(setq major-mode 'rpn-mode)
(setq mode-name "RPN")
(message "Press = to evaluate expression before cursor position")
)
(provide 'rpn-mode)
Author: Julian Fondren
Download
-module(rpn_calc).
-export([eval/1, eval/2]).
-vsn('0.2').
-author('Julian Fondren <miprihas@yahoo.com>').
-license('No-advertise-clause BSD').
eval(S) -> eval(S, []).
eval(S, Stack) -> rpn(lists:map(fun parse/1, lex(S)), Stack).
rpn([], Stack) -> Stack;
rpn([{lit, X}|T], Stack) -> rpn(T, [X|Stack]);
rpn([{op, Op}|T], [A,B|Stack]) -> rpn(T, [op(Op, A, B)|Stack]).
op('-', A, B) -> B - A;
op('/', A, B) -> B / A;
op(Op, A, B) -> erlang:Op(A,B).
lex(S) -> {ok, Es} = regexp:split(S, "\s"), Es.
parse(S) when list(S) ->
case (catch list_to_integer(S)) of
{'EXIT',_} -> case (catch list_to_float(S)) of
{'EXIT',_} -> {op, list_to_atom(S)};
F -> {lit, F}
end;
N -> {lit, N}
end.
Author: nephros
Download
module globals
logical :: DEBUG;
real,allocatable :: stack(:),stackcpy(:);
integer :: stacksize;
end module
program main
use globals;
implicit none;
character(255) :: input;
integer :: cnt;
real :: r,r1,r2;
!DEBUG=.true.;
DEBUG=.false.;
!! read from fortran fileunit 5 which is STDIN
read(5,'(A255)') input;
write(*,*)'Read: "',trim(input),'"';
cnt=0; !! initialize, so we can do a +1 the fist time around
do
!! truncate beginning of input line, so we can cycle to the next space.
input=input(cnt+1:);
if (DEBUG) write(*,*)'input line reads: "',trim(input),'"';
!! exit if input line ends.
if (len_trim(input) <= 0) then
if (DEBUG) write(*,*)'End of input line.';
exit;
end if
!! search for first space in input line
cnt=index(input, ' ');
!! search for operators
select case(input(:cnt));
case('-')
call pop(r1);
call pop(r2);
r = r2 - r1;
if (DEBUG) write(*,*)'Evaluating ',r2, ' minus ',r1,', result:',r,'.'
call push(r);
cycle
case('+')
call pop(r1);
call pop(r2);
r = r2 + r1;
if (DEBUG) write(*,*)'Evaluating ',r2, ' plus ',r1,', result:',r,'.'
call push(r);
cycle
case('*')
call pop(r1);
call pop(r2);
r = r2 * r1;
if (DEBUG) write(*,*)'Evaluating ',r2, 'times ',r1,', result:',r,'.'
call push(r);
cycle
case('/')
call pop(r1);
call pop(r2);
if (r1 == 0) then
write(*,*)'AIIEEE! Division by zero!';
stop;
end if
r = r2 / r1;
if (DEBUG) write(*,*)'Evaluating ',r2, ' by ',r1,', result:',r,'.'
call push(r);
cycle
case default
!! okay, we have an number, push to stack
!! we will get a runtime error if its not a number.
read(input(:cnt),*)r;
if (DEBUG) write(*,*)'Read r: ',r;
call push(r);
cycle;
end select
!! all valid cases should be considered above !!
write(*,*)'Invalid character in input';
end do
!! all done, display result
write(*,*)'Program finished'
write(*,*)'Result: ',stack(stacksize);
end program
!! push r ontop of stack, play stupid allocation game
subroutine push(r)
use globals;
implicit none;
real,intent(in) :: r
if (DEBUG) write(*,*)'Pushing ',r,' to stack';
if (allocated(stackcpy)) deallocate(stackcpy);
allocate(stackcpy(stacksize));
stackcpy=stack;
if (allocated(stack)) deallocate(stack);
stacksize=stacksize+1;
allocate(stack(stacksize));
stack=stackcpy;
stack(stacksize)=r;
return
end subroutine
!! pop r from stack, play stupid allocation game again
subroutine pop(r)
use globals;
implicit none;
real,intent(out) :: r
r=stack(stacksize);
if (DEBUG) write(*,*)'Popping ',r,' from stack';
stacksize=stacksize-1;
if (allocated(stackcpy)) deallocate(stackcpy);
allocate(stackcpy(stacksize));
stackcpy=stack(:stacksize);
deallocate(stack);
allocate(stack(stacksize));
stack=stackcpy;
return
end subroutine
Author: far
Download
module Main where
import Numeric
import Monad
main = do contents <- getContents; foldM (evalLine) [] (lines contents)
where evalLine stack line = report $ foldl rpnEval stack
$ map toToken (words line)
report stack@(h:_) = do print h; return stack
report _ = return []
data PolyToken a = Operator (a -> a -> a) | Value a
type Token = PolyToken Float
toToken w = case readSigned readFloat w of
((value, _):_) -> Value value
_ -> Operator $ operator w
rpnEval stack (Value value) = value:stack
rpnEval (second:first:rest) (Operator op) = (op first second):rest
rpnEval _ _ = error "Stack underflow"
operator name = case name of "+" -> (+); "-" -> (-); "*" -> (*); "/" -> (/)
_ -> error $ "Bad operator: " ++ name
Author: Boyko Bantchev
Download
procedure main()
ops := "+-*/"; ws := ' \t'
while stk := [] & line := " " || read() || " " do {
line ? while tab(many(ws)) & x:=tab(upto(ws)) do {
put(stk,real(x)) |
(1=*x & find(x,ops) &
t:=pull(stk) & put(stk,proc(x,2)(pull(stk),t))) |
(write("error") & break next)
}
write((1=*stk & pull(stk)) | "error")
}
end
Author: Steve Wampler
Download
procedure main()
nws := ~' \t'; stk := []
while read() ? {
while (not pos(0)) &
push(stk, real(x := (tab(upto(nws)),tab(many(nws)))\1) |
(x:=proc(x,2),a:=pop(stk),x(pop(stk),a)))
write(stk[1] | "error")
}
end
Author: Joris Huizer
Download
DON'T REMOVE THESE LINES, THEY ARE IMPORTANT. DO (3002) NEXT DO .6 <- #0 DO (214) NEXT DON'T DESPAIR: THIS IS A SHORT MANUAL ---------------------------------------------------------------------- THIS IS THE INTERCALL RPN 16 BIT INTEGER VERSION WITH SYSLIB SUPPORT WITH SUPPORT FOR: +, -, *, / YOU MUST ENTER NUMBERS SEPERATED BY SPACES AND THE MATHEMATICAL OPERATORS. THE LINE MUST END WITH A NEWLINE CHARACTER PLEASE NOTE CARRIAGE RETURN CHARACTERS ARE IGNORED. THEY ARE NOT REGARDED AS EQUIVALENT TO A NEWLINE CHARACTER! IT IS CONSIDERED AN ERROR IF ANY OTHER CHARACTER IS ENCOUNTERED VALUES ARE PUSHED ON A STACK AS THEY ARE SCANNED. AS AN OPERATOR IS FOUND, THE LAST TWO PUSHED VALUES ARE USED AND REPLACED BY THE RESULT FOR EXAMPLE, INPUT "1254 7 -23 +" FIRST SUBSTRACTS 7 FROM 1254, AND THEN ADDS 23; THE RESULT, 1270 IN THIS CASE, IS PRINTED DO NOT LEAVE MORE THAN ONE VALUE STACKED AT THE END OF THE INPUT LINE. IT IS CONSIDERED AN ERROR. IT IS ALSO AN ERROR IF LESS THEN TWO VALUES ARE AVAILABLE FOR A MATHEMATICAL OPERATOR. IF AN ERROR OCCURS EXECUTION STOPS IMMEDIATELY WITH AN ERROR MESSAGE THERE ARE SOME 16-BIT LIMITATIONS. BE AWARE THAT NEGATIVE VALUES WILL BE PRINTED AS VALUES ABOVE (32767) PLEASE ALSO BE AWARE THAT THERE ARE NO VALUES ABOVE (65535) DON'T FORGET THAT INPUT "-23" WILL TRY TO SUBSTRACT TWO VALUES, AND PUSH 23; IF YOU WANT TO PUSH THE VALUE -23, YOU MUST WRITE "0 23 -" OR SIMILAR; DON'T CONFUSE + OR - WITH UNARY OPERATORS; THEY ARE STRICTLY BINARY. ---------------------------------------------------------------------- DON'T REMOVE ANY OF THE LINES BELOW, IT'S ALL NECESSARY FOR CALCULATIONS PLEASE GIVE UP (210) DO NOT GIVE UP (214) PLEASE FORGET #8 (219) DO (212) NEXT DO (211) NEXT (212) DO (100) NEXT DO STASH .1 + .2 DO .1 <- .6 DO (1020) NEXT DO .6 <- .1 PLEASE RETRIEVE .1 (211) DO FORGET #1 PLEASE NOTE: HIGHLY COMPRESSED CODE (IN TERMS OF STATEMENT COUNT) TO DEAL WITH CURRENT CHAR .1: FIRST '\r' IS REPLACED WITH ' '. SEVEN POSSIBLE VALUES ARE MINGLED INTO THE LOWEST BITS OF .5 THE SEVEN VALUES ARE: EOF, ' ', '\n', +, -, *, / THEN THIS BITSET IS TRANSLATED INTO THE RANGE 1 TILL 8 DO .1 <- '#32$.1'~'"'?#65535$"'"'$"'$"'$ "'$"'#65535'~ '"?.1$#13"~"#0$#65535"'"'~'#65280$#65025'"'~ '#65280$#65025'"'~'#65280$#65025'"'~'#65280$#65025'"'"'~#0$#65535"$ "'"'$"'$"'$"'$"'#65535'~ '"?.1$#13"~ "#0$#65535"'"'~'#65280$#65025'"'~ '#65280$#65025'"'~'#65280$#65025'"'~ '#65280$#65025'"'"' DO .5 <- "V'"V'"V'"?'"'#65535'~'"?.1$#256"~"#0$#65535"'"~"'#65535'~ '"?.1$#256"~"#0$#65535"'"'$#1"~#1'$'"?'"'#65535'~'"?.1$#32"~ "#0$#65535"'"~"'#65535'~'"?.1$#32"~"#0$#65535"'"'$#1"~#1'"~#3'$ '"V'"?'"'#65535'~'"?.1$#10"~"#0$#65535"'"~"'#65535'~'"?.1$#10"~ "#0$#65535"'"'$#1"~#1'$'"?'"'#65535'~'"?.1$#43"~"#0$#65535"'"~"'#65535'~ '"?.1$#43"~"#0$#65535"'"'$#1"~#1'"~#3'"~#15'$'"V'"V'"?'"'#65535'~ '"?.1$#45"~"#0$#65535"'"~"'#65535'~'"?.1$#45"~"#0$#65535"'"'$#1"~#1'$ '"?'"'#65535'~'"?.1$#42"~"#0$#65535"'"~"'#65535'~'"?.1$#42"~ "#0$#65535"'"'$#1"~#1'"~#3'$'"?'"'#65535'~'"?.1$#47"~"#0$#65535"'"~ "'#65535'~'"?.1$#47"~"#0$#65535"'"'$#1"~#1'"~#15'"~#255 DO .5 <- '"'"'"'?'"'#65535'~'"?.1$#47"~"#0$#65535"'"~"'#65535'~ '"?.1$#47"~"#0$#65535"'"'$#1'~#1"$#0'~'#32767$#1'"$#0'~'#32767$#1'"$ "'"'"'"V"'"V'"'?'"'#65535'~'"?.1$#42"~"#0$#65535"'"~"'#65535'~ '"?.1$#42"~"#0$#65535"'"'$#1'~#1"'$'"'?'"'#65535'~'"?.1$#45"~ "#0$#65535"'"~"'#65535'~'"?.1$#45"~"#0$#65535"'"'$#1'~#1"'"~ "#0$#65535"'~#1"$'"'"V'"'?'"'#65535'~'"?.1$#43"~"#0$#65535"'"~ "'#65535'~'"?.1$#43"~"#0$#65535"'"'$#1'~#1"'$'"'?'"'#65535'~ '"?.1$#10"~"#0$#65535"'"~"'#65535'~'"?.1$#10"~"#0$#65535"'"'$#1'~#1" '"~"#0$#65535"'~#1"'"~"#0$#65535"'~#1"$#0'~'#32767$#1'"$ "'"'"V"'"V'"'?'"'#65535'~'"?.1$#42"~"#0$#65535"'"~"'#65535'~ '"?.1$#42"~"#0$#65535"'"'$#1'~#1"'$'"'?'"'#65535'~'"?.1$#45"~ "#0$#65535"'"~"'#65535'~'"?.1$#45"~"#0$#65535"'"'$#1'~#1"'"~ "#0$#65535"'~#1"$'"'"V'"'?'"'#65535'~'"?.1$#32"~"#0$#65535"'"~ "'#65535'~'"?.1$#32"~"#0$#65535"'"'$#1'~#1"'$'"'?'"'#65535'~ '"?.1$#256"~"#0$#65535"'"~"'#65535'~'"?.1$#256"~"#0$#65535"'" '$#1'~#1"'"~"#0$#65535"'~#1"'"~"#0$#65535"'~#1"$"'"V'"'?'"'#65535'~ '"?.1$#42"~"#0$#65535"'"~"'#65535'~'"?.1$#42"~"#0$#65535"'"'$#1'~#1" '$'"'"V'"'?'"'#65535'~'"?.1$#43"~"#0$#65535"'"~"'#65535'~'"?.1$#43"~ "#0$#65535"'"'$#1'~#1"'$'"'"V'"'?'"'#65535'~'"?.1$#32"~"#0$#65535"'"~ "'#65535'~'"?.1$#32"~"#0$#65535"'"'$#1'~#1"'$'"'?"'.5~.5'~#1" $#1'~#1"'"~"#0$#65535"'~#1"'"~"#0$#65535"'~#1"'"~ "#0$#65535"'~#1"'~#3"'~#13"'~#53 DO NOT " PLEASE DO NOT REMOVE THIS LINE (236) DO (237) NEXT DO (224) NEXT (237) DO (238) NEXT DO (223) NEXT (238) DO (239) NEXT DO (222) NEXT (239) DO (240) NEXT DO (221) NEXT (240) DO (241) NEXT DO (215) NEXT (241) DO (242) NEXT DO (210) NEXT (242) DO (243) NEXT DO REINSTATE (220) DO (213) NEXT (243) DO (1001) NEXT PLEASE, WOULD YOU BE SO KIND TO ENTER VALID INPUT? (215) DO ABSTAIN FROM (220) (213) DO .5 <- '?"'#65535'~ '"?.6$#1"~"#0$#65535"'"$#1'~#3 DO (217) NEXT (220) DO (32767) NEXT DON'T BE SO FUNNY; DO YOU REALISE THAT ISN'T A VALID INPUT? (217) DO (1001) NEXT PLEASE RETRIEVE .2 DO .1 <- .2 DO (50) NEXT DO .1 <- #10 DO (3001) NEXT DO .6 <- #0 DO (214) NEXT (225) DO (1001) NEXT PLEASE REALISE YOU MUST HAVE AT LEAST TWO VALUES TO USE (221) DO (250) NEXT DO (1009) NEXT DO (251) NEXT (222) DO (250) NEXT DO (1010) NEXT DO (251) NEXT (223) DO (250) NEXT DO (1039) NEXT DO (251) NEXT (224) DO (250) NEXT DO (1040) NEXT DO (251) NEXT (250) DO .5 <- .6~#65534 DO .5 <- "?!5~.5'$#1"~#3 DO (225) NEXT PLEASE RETRIEVE .2 DO .3 <- .2 PLEASE RETRIEVE .2 DO .1 <- .2 DO .2 <- .3 PLEASE RESUME #1 (251) DO .2 <- .3 DO STASH .2 DO .1 <- .6 DO .2 <- #1 DO (1010) NEXT DO .6 <- .3 DO (214) NEXT (50) DO STASH .1 + .2 + .3 + .4 + .6 + ,1 DO ,1 <- #1000 DO .2 <- #1 DO .6 <- #1 DO (51) NEXT (51) PLEASE FORGET #1 DO (2030) NEXT DO ,1 SUB.6 <- .4 DO .1 <- .6 DO (1020) NEXT DO .6 <- .1 DO .5 <- '?.3$#9'~'#0$#65535' DO .5 <- "?'"&'".3~.5"~"'?"?.5~.5"$#32768'~'#0$#65535'"'$'.5~.5'"~#1'$#2"~#3 DO NOT ' PLEASE DO NOT REMOVE THIS LINE DO (55) NEXT DO .5 <- "?!3~.3'$#1"~#3 DO (52) NEXT DO ,1 SUB.6 <- .3 DO (57) NEXT (52) DO (1001) NEXT DO FORGET #1 DO (56) NEXT (57) PLEASE FORGET #1 DO .1 <- '#48$",1 SUB.6"'~#2645 DO (3001) NEXT DO (56) NEXT (56) PLEASE FORGET #1 DO .1 <- .6 DO (1010) NEXT DO .6 <- .3 DO .5 <- "?!6~.6'$#1"~#3 DO (58) NEXT DO (57) NEXT (58) DO (1001) NEXT PLEASE RETRIEVE .1 + .2 + .3 + .4 + .6 + ,1 PLEASE RESUME #2 (55) DO (1001) NEXT PLEASE FORGET #1 DO .1 <- .3 DO (51) NEXT (100) DO STASH .3 + .4 DO .2 <- #0 DO .99 <- #2 DO (101) NEXT (101) PLEASE FORGET #1 DO (106) NEXT PLEASE RETRIEVE .3 + .4 PLEASE RESUME .99 (106) DO (3000) NEXT DO STASH .2 DO .2 <- #48 DO (1010) NEXT DO .5 <- '?.3$#9'~'#0$#65535' DO .5 <- "?"'&"!3~.5'~'"?'?.5~.5'$#32768"~"#0$#65535"'"$".5~.5"'~#1"$#1"~#3 DO NOT " PLEASE DO NOT REMOVE DO (107) NEXT PLEASE RETRIEVE .2 PLEASE RESUME #1 (107) DO (1001) NEXT DO .99 <- #1 PLEASE FORGET #2 DO .5 <- .3 PLEASE RETRIEVE .2 DO .1 <- #10 DO (1039) NEXT DO .1 <- .3 DO .2 <- .5 DO (1009) NEXT DO .2 <- .3 DO (101) NEXT (2030) DO STASH :1 + :2 + :3 + :4 + ,1 + .2 + .1 DO ,1 <- #16 DO ,1 SUB#1 <- #0 DO ,1 SUB#2 <- #1 DO ,1 SUB #3 <- #2 DO ,1 SUB #4 <-#2 DO ,1 SUB#5 <- #3 DO ,1 SUB#6 <- #3 DO ,1 SUB #7 <- #4 DO ,1 SUB #8 <-#5 DO ,1 SUB#9 <- #5 DO ,1 SUB#10<- #6 DO ,1 SUB#11 <- #7 DO ,1 SUB#12 <-#7 DO ,1 SUB#13<- #8 DO ,1 SUB#14<- #8 DO ,1 SUB#15 <- #9 DO ,1 SUB#16 <-#0 DO :1 <- .1 DO :2 <- #10922$#21845 DO (1549) NEXT DO .1 <- :3~'#49152$#49152' DO (1020) NEXT DO .4 <- ,1SUB.1 PLEASE RETRIEVE .1 DO .2 <- .4 DO (1010) NEXT DO :1 <- .3~#65534 DO :2 <- #43690$#43691 DO (1549) NEXT DO .3 <- :3 PLEASE RETRIEVE :1 + :2 + :3 + :4 + ,1 + .2 PLEASE RESUME #1 (3000) DO STASH .2 + .3 + .4 DO .1 <- ,3000 SUB#1 DO WRITE IN ,3000 DO .2 <- ,3000 SUB#1 DO (3004) NEXT DO .1 <- #256 PLEASE RETRIEVE .2 + .3 + .4 PLEASE RESUME #2 (3005) PLEASE RESUME '?.2$#256'~'#256$#256' (3004) DO (3005) NEXT DO (1009) NEXT DO .1 <- .3~#255 DO ,3000 SUB#1 <- .1 PLEASE RETRIEVE .2 + .3 + .4 PLEASE RESUME #2 (3001) DO STASH .1 + .2 + .3 DO .2 <- '"'"!1~#15'$!1~#240'"~#15'$'"!1~#15'$!1~#240'"~#240'"~#15'$ '"'"!1~#15'$!1~#240'"~#15'$'"!1~#15'$!1~#240'"~#240'"~#240' DO .1 <- ,3001 SUB#1 DO (1010) NEXT DO ,3001 SUB#1 <- .3 DO READ OUT ,3001 DO ,3001 SUB#1 <- .2 PLEASE RETRIEVE .1 + .2 + .3 PLEASE RESUME #1 (3002) DO ,3000 <- #1 DO ,3000 SUB#1 <- #0 DO ,3001 <- #1 DO ,3001 SUB#1 <- #0 PLEASE ABSTAIN FROM (32767) PLEASE RESUME #1 PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE DO NOT BE INSUFFICIENTLY POLITE
Author: far
Download
#!/usr/bin/env io
Stack := List clone
Stack evalToken := method(token,
if(token == "", return) // a bug in String split?
num := token asNumber
if(num, push(num), applyOperator(token))
)
Stack top := method(at(count - 1))
Stack applyOperator := method(op,
if(Number hasSlot(op),
if(count < 2, Error raise("pop", "Stack underflow"))
num2 := pop; num1 := pop
push(num1 perform(op, num2)),
Error raise("operator", "Unknown operator: " + op)
)
)
while(line := File standardInput readLine,
tokens := line split(" ", "\t")
try(
tokens foreach(i, token, Stack evalToken(token))
if(Stack top, write(Stack top, "\n"))
) catch(Exception, e,
write(e description, "\n")
)
)
Author: RobMcM
Download
import java.io.BufferedReader;
import java.io.InputStreamReader;
import java.io.IOException;
import java.util.StringTokenizer;
import java.util.Stack;
public class rpn {
// easy way to get a line at a time
static final BufferedReader stdin = new BufferedReader(
new InputStreamReader(System.in));
// a Stack class, how convenient :)
static final Stack stack = new Stack();
public static void main(String args[]) throws IOException {
while (true) {
final String line = stdin.readLine(); // input line
if (line.length() == 0) {
System.exit(0);
}
// Java makes it so easy... Tokenise it with spaces as deliminators:
final StringTokenizer stok = new StringTokenizer(line, " ", false);
while (stok.hasMoreElements()) {
final String token = stok.nextToken();
final Double value;
try {
value = Double.valueOf(token);
// if get this far its a number
stack.push(value);
}
catch (NumberFormatException e) {
// else its not, so assume its an operator
final double rhs = ((Double)stack.pop()).doubleValue();
final double lhs = ((Double)stack.pop()).doubleValue();
final char operator = token.charAt(0);
final Double result;
switch (operator) {
case '+': result = new Double(lhs + rhs); break;
case '-': result = new Double(lhs - rhs); break;
case '*': result = new Double(lhs * rhs); break;
case '/': result = new Double(lhs / rhs); break;
default: System.out.println("unkown op");
result = null; // so result can be final
System.exit(-1); break;
}
stack.push(result);
}
}
System.out.println((Double)stack.pop()); // we're done, show answer
}
}
}
<script type="text/JavaScript">
function doRpn()
{
s = document.rpn.rpn.value;
ar = s.split( " " );
r = 0;
st = new Array;
for ( i=0; i<ar.length; i++ )
{
if (!isNaN( ar[i] ) )
{
st.push( parseFloat( ar[i] ));
} else {
if ( st.length < 2 )
alert ( "Buffer underrun!" );
else {
f2 = st.pop();
st.push( eval( st.pop() + ar[i] + f2 ));
}
}
}
if ( st.length == 1 )
document.rpn.rpn.value = st.pop();
else
document.rpn.rpn.value = "Error!";
return false;
}
</script>
<form name="rpn" onSubmit="return doRpn();">
<input type="text" name="rpn">
</form>
Author: Stevan Apter
Download
p:{(. 1_)'(&x=" ")_ x:" ",x} / parse
e:{:[7=4:y;(-2_ x),y .-2#x;x,y]} / evaluate
s:();.m.r:{`0:,5:s::s e/p x} / read-eval-print loop (s is the stack)
Author: Boyko Bantchev
Download
to rpn
if eof? [stop]
make "s reverse rl
if not empty? :s ~
[ make "r catch "err [eval]
pr catch "err
[ifelse empty? :s [:r] [(throw "err "error)]] ]
rpn
end
to eval
(local "x "y "t)
if not empty? :s ~
[ make "t first :s make "s bf :s
if member? :t [+ - * /] ~
[ make "y eval make "x eval
op run (list :x :t :y) ]
if number? :t [op :t] ]
(throw "err "error)
end
Author: Boyko Bantchev
Download
for s in io.lines() do
tb = {} z = 0
for tk in string.gfind(s,'%S+') do
if string.find(tk,'^[-+*/]$') then
if 2>table.getn(tb) then z = nil break end
y,x = table.remove(tb),table.remove(tb)
loadstring('z=x'..tk..'y')()
else
z = tonumber(tk) if z==nil then break end
end
table.insert(tb,z)
end
n = table.getn(tb)
if n==1 and z then print(z)
elseif n>1 or z==nil then print('error') end
end
Author: Boyko Bantchev
Download
#include <stdio.h>
#include <string.h>
#import <Foundation/NSData.h>
#import <Foundation/NSValue.h>
#import <Foundation/NSArray.h>
int main() {
int c,err;
double x,y;
char *p,*q;
NSMutableData *line = [NSMutableData new];
NSMutableArray *stk = [NSMutableArray new];
#define POP(z) z = [[stk lastObject] doubleValue]; \
[stk removeLastObject]
while ((c=getchar())!=EOF) {
if (c=='\n' || c=='\r') c = 0;
[line appendBytes:(void*)&c length:1];
if (c) continue;
[stk removeAllObjects];
p = [line mutableBytes];
err = 0;
while (NULL!=(q=strtok(p," \t"))) {
x = strtod(q,&p); err = p!=q+strlen(q);
p = NULL;
if (err) {
err = q[1] || NULL==strchr("+-*/",*q) || 2>[stk count];
if (err) break;
POP(y); POP(x);
switch (*q) {
case '+': x += y; break;
case '-': x -= y; break;
case '*': x *= y; break;
case '/': x /= y;
}
}
[stk addObject:[NSNumber numberWithDouble:x]];
}
if (err || 1<[stk count]) puts("error");
else if ([stk count]) {POP(x); printf("%f\n",x);}
[line setLength:0];
}
return 0;
}
Author: pranyi
Download
open List
let _ = while true do
match fold_left
(fun s w ->
let f op = match s with
| h1 :: h2 :: t -> op h2 h1 :: t
| _ -> failwith "Stack underflow"
in
match w with
| "+" -> f ( +. )
| "-" -> f ( -. )
| "*" -> f ( *. )
| "/" -> f ( /. )
| _ -> (float_of_string w) :: s)
[] (Str.split (Str.regexp "[ \t]+") (read_line ())) with
| h :: [] -> print_endline (string_of_float h)
| _ -> failwith "Malformed expression"
done
Author: Boyko Bantchev
Download
include "ombcd.xin"
declare #main-input has unbuffered
declare #main-output has unbuffered
macro int is (digit+) macro-end
macro num is (["+-"]? ((int ("." int?)?) | ("." int))) macro-end
global bcd nums variable initial-size 0
declare catch syntax-wrong
define function push(value bcd x) as set new nums to x
define bcd function pop() as
local bcd x
throw syntax-wrong when number of nums = 0
set x to nums remove nums
return x
define switch function rpn as
local stream x
repeat scan #current-input
match blank* num => x push(bcd(x))
match blank* "+" push(pop()+pop())
match blank* "-" push(0-pop()+pop())
match blank* "*" push(pop()*pop())
match blank* "/" push(1/pop()*pop())
match blank* "%n" return true
match any-text throw syntax-wrong
again
halt
catch syntax-wrong
do scan #current-input match any-text* "%n" done
return false
process repeat
repeat scan #main-input
match rpn
local integer n set n to number of nums
do when n = 1 output "d" % pop() || "%n"
else when n > 1 throw syntax-wrong
done
match any-text* throw syntax-wrong
again
catch syntax-wrong
output "error%n"
clear nums
again
Author: Haplo
Download
The indentation has been changed.
program rpn;
const STACK_SIZE = 255;
type
TStackType = (NUM, PLUS, MINUS, DIVIDE, MULTIPLY);
TStackItem = record
t : TStackType;
i : Double;
end;
TStack = record
stack : array [1..STACK_SIZE] of TStackItem;
len : Integer;
end;
var
stack : TStack;
cmd : String;
procedure pushStack(si : TStackItem);
begin
stack.stack[stack.len] := si;
inc(stack.len);
end;
procedure parseCmd(cmd : String);
var
i : Integer;
si : TStackItem;
tmp : String;
begin
tmp := '';
cmd := cmd + ' ';
for i := 1 to length(cmd) do begin
if cmd[i] = ' ' then begin
case tmp[1] of
'+' : si.t := PLUS;
'-' : si.t := MINUS;
'*' : si.t := MULTIPLY;
'/' : si.t := DIVIDE;
otherwise begin
si.t:= NUM;
val(tmp, si.i);
end;
end;
pushStack(si);
tmp := '';
end else begin
tmp := tmp + cmd[i];
end;
end;
end;
function popStack() : TStackItem;
begin
if stack.len = 0 then begin
WriteLn('Error: pop Stack(): stack empty');
exit;
end;
dec(stack.len);
popStack := stack.stack[stack.len];
end;
procedure opStack();
var
r : double;
s1, s2, s3 : TStackItem;
begin
{ operator }
s1 := popStack();
if s1.t = NUM then begin
WriteLn('Error: opStack(): Operator expected, number found');
exit;
end;
s3 := popStack();
while s3.t <> NUM do begin
pushStack(s3);
opStack();
s3 := popStack();
end;
s2 := popStack();
while s2.t <> NUM do begin
pushStack(s2);
opStack();
s2 := popStack();
end;
case s1.t of
PLUS : r := s2.i + s3.i;
MINUS : r := s2.i - s3.i;
MULTIPLY : r := s2.i * s3.i;
DIVIDE : r := s2.i / s3.i;
otherwise begin
WriteLn('Error: opStack(): Unrecognized command');
exit;
end;
end;
s1.t := NUM;
s1.i := r;
pushStack(s1);
end;
var
i : Integer;
s : String;
si : TStackItem;
begin
stack.len := 0;
cmd := '';
ReadLn(cmd);
while(cmd <> '') do begin
parseCmd(cmd);
opStack();
{ SHOOT off stack to detect errors }
for i := stack.len-1 downto 0 do begin
si := popStack();
Str(si.i:9:4, s);
WriteLn(s);
end;
{ RESET just in case }
stack.len := 0;
cmd := '';
ReadLn(cmd);
end;
end.
Author: jklmnop
Download
perl -lape 'for(@F){if(m:^([\+\*/-])$:){splice@S,-2,2,eval"$S[-2]$1$S[-1]";next}@S=(@S,$_)}$_="@S";@S=()'
Author: John Nurick
Download
#Simple extensible RPN calculator
use strict;
#globals
my @queue; #list of tokens from STDIN waiting to be processed
my @stack = qw( 0 );
my $lastx;
#magic words to break out of the exception handler in order to quit
my $exitSesame = "Exiting on request";
#RPN instructions stored as a hash of anonymous functions
#add more as needed
my %stdprocs = (
'+' => sub { $lastx = shift @stack; $stack[0] += $lastx; },
'-' => sub { $lastx = shift @stack; $stack[0] -= $lastx; },
'*' => sub { $lastx = shift @stack; $stack[0] *= $lastx; },
'/' => sub { $lastx = shift @stack; ($stack[0] /= $lastx); },
'drop' => sub { shift @stack; push @stack, 0 if @stack < 5; },
'dup' => sub { unshift @stack, $stack[0]; },
'lastx' => sub { unshift @stack, $lastx; },
'ln' => sub { $lastx = $stack[0]; $stack[0] = log($stack[0]); },
'quit' => sub { die "$exitSesame\n"; },
'sqr' => sub { $lastx = $stack[0]; $stack[0] *= $stack[0]; },
'sqrt' => sub { $lastx = $stack[0]; $stack[0] = sqrt($stack[0]); },
);
while (<>) { #main loop
chomp;
@queue = tokenise($_);
my $token;
while (length ($token = shift @queue)) {
if (isnumeric($token)) { #number
unshift @stack, $token;
next;
}
if (exists ($stdprocs{$token})) {
execStdproc($token);
next;
}
print "Unknown function $token!\n";
}
print "$stack[0]\n";
} # END of main routine
sub tokenise {
#splits STDIN into a list of numbers and procs to execute
my @queue = $_[0] =~ m/
(?:-?(?:\d*\.?\d+|\d+\.?\d*)(?:[eE][+-]?\d+)?) #integer or float
|
[-+\/\\*] #operators
|
(?:\w+) #a word
/igx;
return @queue;
}
sub isnumeric {
if ($_[0] =~ m/^-?(\d*\.?\d+|\d+\.?\d*)([eE][+-]?\d+)?$/) {
return 1
} else {
return 0
}
}
sub execStdproc { #look up and execute sub from %stdprocs
my $name = $_[0];
eval { $stdprocs{$name}() };
die "$exitSesame\n" if $@ =~ m/$exitSesame/ ; #normal exit
warn "Exception raised by built-in operator/function '$name':\n$@\n" if $@;
}
<form method="GET">
<input type="text" name="s" />
</form>
<?php
$st = array();
function isFloat( $f ) {
return( is_numeric( $f ) ? floatval( $f ) == $f : false );
}
function pop()
{
global $st;
$f = 0;
if ( count( $st ) > 0 )
$f = array_pop( $st );
else
print( "<b>Buffer underrun!</b><br />" );
return $f;
}
$s = trim( $_GET['s'] );
$ar = explode( " ", $s );
foreach( $ar as $tok )
{
if ( isFloat( $tok ) )
$st[] = floatval( $tok );
else
{
$f2 = pop();
$f1 = pop();
$op = $tok[0];
switch( $op )
{
case '+': $st[] = $f1 + $f2; break;
case '-': $st[] = $f1 - $f2; break;
case '*': $st[] = $f1 * $f2; break;
case '/': $st[] = $f1 / $f2; break;
default:
printf( "Unknown operator '%s'!<br />", $op );
break;
}
}
}
if ( count( $st ) > 0 )
printf( "Result: <b>%f</b>", pop() );
?>
Author: far
Download
%!
% in ghostscript, stdin seems to be defined only if you run this from the
% interactive shell:
% GS>(rpn.ps) run
/+ { add } def
/- { sub } def
/* { mul } def
/\ { div } def % can't use '/' since it is used to signify literals
/stdin (%stdin) (r) file def
% substitute '/' for '\' in a string
/subst {
dup length 1 sub 0 1 3 -1 roll {
dup 3 -1 roll
dup 4 -1 roll
get 47 eq { % '/' ascii
dup 3 -1 roll
92 put % '\' ascii
} {
exch pop
} ifelse
% s
} for
} def
/buffer 200 string def
{
stdin buffer readline not { exit } if
subst
/line exch def
{
line token not { exit } if
exch /line exch def
cvx exec
} loop
exec dup =
} loopAuthor: far
Download
%!
/+ { add } /- { sub } /* { mul } /\ { div } /stdin (%stdin) (r) file
def def def def def
{ stdin token not { exit } if cvx exec } loop stack
Author: far
Download
Works with SWI-Prolog.
rpn('+', [B, A | R], [Res | R]) :- Res is A + B.
rpn('-', [B, A | R], [Res | R]) :- Res is A - B.
rpn('*', [B, A | R], [Res | R]) :- Res is A * B.
rpn('/', [B, A | R], [Res | R]) :- Res is A / B.
rpn('', Stack, Stack).
rpn(A, Instack, [Num | Instack]) :- atom_number(A, Num).
rpn(_, Stack, Stack) :- write(error), nl.
top(_, C) :- not(newline(C)).
top([], _) :- nl.
top([X | _], _) :- write(X), nl.
last_char([L], [], L).
last_char([F | R], [F | R2], L) :- last_char(R, R2, L).
gettoken(Token, LastChar) :-
gettoken1(Chars),
last_char(Chars, TokenChars, LastChar),
string_to_list(S, TokenChars),
string_to_atom(S, Token)
.
gettoken1(Token) :- get0(C), gettoken2(C, Token).
gettoken2(C, [C]) :- whitespace(C).
gettoken2(C, [C | Token]) :- gettoken1(Token).
whitespace(C) :- newline(C); space(C).
newline(10).
newline(13).
space(32).
exec(Instack) :-
gettoken(Token, LastChar),
rpn(Token, Instack, Outstack),
top(Outstack, LastChar),
exec(Outstack)
.
main :- exec([]).
Author: Mirrorball
Download
def apply_operator(op, first, second):
if op == '+':
return first + second
elif op == '-':
return first - second
elif op == '*':
return first * second
elif op == '/':
return first / second
else:
print "Bad operator: " + op
while 1:
line = raw_input()
if not line:
break
stack = []
tokens = line.rstrip().split(' ')
for token in tokens:
try:
value = float(token)
stack.append(value)
except ValueError:
second = stack.pop()
first = stack.pop()
stack.append(apply_operator(token, first, second))
print stack[-1]
Author: Mirrorball
Download
while 1:
line = raw_input()
if not line:
break
stack = []
tokens = line.rstrip().split(' ')
for token in tokens:
try:
value = float(token)
stack.append(token)
except ValueError:
second = stack.pop()
first = stack.pop()
try:
stack.append(str(eval(first + token + second)))
except SyntaxError:
raise ValueError, "Bad operator: " + token
print stack[-1]
Author: Michael Fuks
Download
from sys import stdin
def rpn_l(l):
try:
if len(l)==1: return l[0]
for i in xrange(len(l)):
if i>1 and l[i] in ['+','-','/','*']:
return rpn_l(l[:i-2]+[str(eval(l[i-2]+l[i]+l[i-1]))]+l[i+1:])
except: return "Bad input"
def rpn(s):
return rpn_l(s.split())
print rpn(stdin.read())
Author: Boyko Bantchev
Download
prn: func [s] [print s line: []]
forever
[line: to-block form parse/all trim/lines input { ^-}
while [not empty? line: head line]
[either parse line [set x number!]
[prn x]
[forall line
[if parse copy/part line 3
[set x number! set y number! set o word!]
[either find {+-*/} to-string o
[change/part line do reform [x o y] 3]
[prn {error}]
break ]]
if empty? line [prn {error}] ]]]
Author: Boyko Bantchev
Download
$ENTRY RPN = <Rpn>;
Rpn { = <EOF *STDIN>:
{ T =;
F = <Tks <Wds <READ_LINE>' '>>: {=; ex = <PRINTLN <Eval ex>>}
= <Rpn> } };
Wds { = ;
' ' er = <Wds er>;
ew ' ' er = (ew) <Wds er> };
Tks {=; (et) er = <Tok et> <Tks er> };
Tok {
'+' = *"+"; '-' = *"-"; '*' = *"*"; '/' = *"/";
'+' en = <Num en>;
'-' en = <REAL 0> <Num en> *SUB;
en = <Num en> };
Eval {
sn, <MODE sn>:REAL = sn;
eh sa sb so er, <MODE sa><MODE sb><MODE so>: REAL REAL FUNC
= <Eval eh <so sa sb> er>;
ea = <PRINTLN 'error'> };
Num {en = <Num2 <Num1 0 () en>>};
Num1 {
sc (en) sd er, <TYPE sd>: 'D' sd = <Num1 <+ 1 sc> (en sd) er>;
ea = ea };
Num2 {
sc (en) '.' ef = <Num3 <Num1 0 (en) ef>>;
sc () ea = ();
sc (en) = <REAL <NUMB en>>;
sc (en) ea = () };
Num3 {sc (sd en) = </ <REAL <NUMB sd en>> <POW sc 10>>; ea = ()};
Author: Boyko Bantchev
Download
do while lines()
i = 0
line = linein()
do while line\=''
parse var line s.i line
if datatype(s.i,'N') then i = i+1
else do
if 1<length(s.i) | 0=pos(s.i,'+-*/') then
do; i = 2; leave; end
i = i-1
interpret 's.'||(i-1)'=s.'||(i-1) value('s.'||(i+1)) 's.'i
end
end
if i=1 then say value('s.'||(i-1))
else if i>1 then say 'error'
end
Author: kram
Download
stack = Array.new
while line = gets
line.split(' ').each { |token|
if "+-*/".include? token and token.length == 1
if stack.length > 1
second = stack.pop
stack.push(eval("stack.pop #{token} second"))
else
puts "Stack underflow"
end
elsif token =~ /^[\d\.]*$/
stack.push token.to_f
else
puts "Bad operator: #{token}"
end
}
puts stack.last if stack.last
end
Author: pranyi
Download
ruby -ane 's=[];$F.each{|w|(w=~/^[+*\/-]$/)?s.push((a,b=s.pop,s.pop;b.send(w,a))):s.push(Float(w))};p s[0]'
Author: pranyi
Download
#!/usr/bin/env ruby
File.foreach(ARGV[0]) do |l|
s = []
l.split.each do |w|
if w =~ /^[+*\/-]$/
a,b = s.pop,s.pop
s.push(b.send(w,a))
else
s.push(Float(w))
end
end
if s.length == 1 then
puts s[0]
else
$stderr.puts "malformed expression #{l}"
end
end
Author: far
Download
Based on a program by iuli.
object rpn with Application {
val stack = new scala.collection.mutable.Stack[double];
def pop = { val tmp = stack top; stack pop; tmp }
def apply_op(op: (double, double) => double)
= { val second = pop; stack push op(pop, second) }
while(true) {
Console.readLine split(" ") foreach( (token) => {
token match {
case "+" => apply_op((x, y) => x + y);
case "-" => apply_op((x, y) => x - y);
case "*" => apply_op((x, y) => x * y);
case "/" => apply_op((x, y) => x / y);
case _ => stack.push(java.lang.Double.parseDouble(token));
}
});
Console.println(stack.top);
}
}
Author: doro
Download
I modified this code to make it a complete program.
(define (rpn expression)
(define (operator? exp)
(let ((token (car exp)))
(or (eqv? '+ token)
(eqv? '- token)
(eqv? '* token)
(eqv? '/ token))))
(define (operator exp) (car exp))
(if (null? expression)
"there is nothing to calculate!"
(let calculate ((exp expression)
(stack '()))
(cond ((null? exp) (car stack))
((operator? exp)
(let* ((first-operand (cadr stack))
(second-operand (car stack))
(result (eval (list (operator exp)
first-operand second-operand)
;; eval needs a second arg
;; this works for guile, at least:
(interaction-environment))))
(calculate (cdr exp) (cons result (cddr stack)))))
(else (calculate (cdr exp) (cons (car exp) stack)))))))
(define (reached-newline?)
(let ((c (peek-char)))
(cond ((eq? c #\newline)
(read-char)
#t)
((char-whitespace? c)
(read-char)
(reached-newline?))
(else #f))))
(define (main expression)
(cond ((reached-newline?)
(write (rpn expression))
(newline)
(main '()))
(else (main (append expression (list (read)))))))
(main '())
Author: ecatmur
Download
#!/bin/sed -f
# Convert to unary
s: :_:g;s:^:_:;s:$:_:
s:[^0-9_*/+-]::g
ta;:a;s:__:_:;ta
tb;:b;s:\([0-9]\+\)\([0-9]\):\1_A_*_\2_+:;tb
s:0::g;s:1:I:g;s:2:II:g;s:3:III:g;s:4:IIII:g;s:5:IIIII:g;s:6:IIIIII:g
s:7:IIIIIII:g;s:8:IIIIIIII:g;s:9:IIIIIIIII:g;s:A:IIIIIIIIII:g
# Calculate
tc;:c
s:_\(I*\)_\(I*\)_+:_\1\2:
s:_\(I*\)_\1I*_-:_:
s:\(I*\)_\1_-::
s:__I*_\*:_:
s:_\(I*\)I_\(I*\)_\*:_\1_\2_*_\2_+:
\:__/:{cDivision by zero!
b}
s:_\(I*\)_\1I\+_/:_:
s:\(I*\)_\1_/:_\1_/_I_+:
tc
# Back to decimal
td;:d
s:_\(\(IIIIIIIIII\)\+\)\(I*\)_:_\1_\3_:
s:IIIIIIIIII:I:g
td
te;:e
s:__:_0_:;s:_I_:_1_:;s:_II_:_2_:;s:_III_:_3_:;s:_IIII_:_4_:;s:_IIIII_:_5_:
s:_IIIIII_:_6_:;s:_IIIIIII_:_7_:;s:_IIIIIIII_:_8_:;s:_IIIIIIIII_:_9_:
te
s:_::g
Author: Stewart Stremler
Download
#!/bin/sh
"exec" "gst" "-f" "$0" "$@"
"
Written for the RPN Calculator at http://www.stacken.kth.se/~foo/rpn/
by Stewart Stremler, January 2009, using GST 3.0.
This code is released to the public domain.
"
"I prefer a basic stack class that looks like a stack"
Object subclass: Stack [ | data |
<comment: 'stacklike objects should use push and pop'>
]
Stack class extend [
new [ | me |
me := super new.
^me init
]
]
Stack extend [
init [ data := OrderedCollection new. ^self ]
size [ ^data size ]
isEmpty [ ^data isEmpty ]
pop [ data isEmpty ifFalse: [ ^data removeLast ]. ^nil ]
push: anObject [ data addLast: anObject. ^self ]
peek [ | anObject |
anObject := self pop.
anObject = nil ifFalse: [ self push: anObject ].
^anObject
]
]
"----------------------------------------------------------------"
"An RPN Calculator"
Object subclass: RPNCalculator [ | stack ops |
<comment: 'I am a simple little calculator.'>
]
RPNCalculator class extend [
new [ | me |
me := super new.
^me init
]
]
RPNCalculator extend [
init [
ops := Dictionary new.
stack := Stack new.
ops at: '+' put: [ :s | s push: ( s pop + ( s pop ) ) ].
ops at: '*' put: [ :s | s push: ( s pop * ( s pop ) ) ].
ops at: '-'
put: [ :s | | x y | x := s pop. y := s pop. s push: ( y - x ) ].
ops at: '/'
put: [ :s | | x y | x := s pop. y := s pop. s push: ( y / x ) ].
ops at: '_' put: [ :s | s push: (s pop asFloat) ].
^self
]
compute: aStream [ | line |
( aStream = stdin ) ifTrue: [
'A blank line exits, Newline computes.' displayNl ].
line := aStream nextLine.
[ line isEmpty ] whileFalse: [
(line tokenize: ' ') do: [ :token | self process: token ].
'result = ' display. stack peek displayNl.
line := aStream nextLine.
]. "loop"
stack isEmpty ifTrue: [ ^'empty stack' ] ifFalse: [ ^stack pop ].
]
process: aString [
(ops at: aString
ifAbsent: [ [:s | s push: (aString asNumber) ]]
) value: stack.
]
]
!
" ---------------------------------------------------------- "
|rpnc|
rpnc := RPNCalculator new.
"(rpnc compute: (ReadStream on: '10 20 30 + 4 + \n +')) displayNl ."
(rpnc compute: stdin) displayNl.
Author: Boyko Bantchev
Download
d = '0123456789'; op = any('+-*/'); ws = ' ' char(9)
sp1 = span(ws); sp0 = sp1 | ''
int = span(d)
num = (any('+-') | '') int ('.' (int | '') | '')
xpr = num . x sp1 num . y sp1 op . o (sp1 | rpos(0))
read line = input :f(end)
line pos(0) sp0 rpos(0) :s(read)
zapp line (pos(0) | notany(d)) . p '.' any(d) . q
+ = p '0.' q :s(zapp)
doop line sp0 xpr = ' ' eval(x + 0. ' ' o ' ' y) ' ' :s(doop)
line pos(0) sp0 (num . output) sp0 rpos(0) :s(read)
output = 'error' :(read)
end
Author: far
Download
load "Real";
open TextIO Char String Real
exception Eof
exception StackUnderflow
exception BadOperator of string
fun applyOperator operator (s::f::r) =
(case operator of
"+" => f + s
| "-" => f - s
| "*" => f * s
| "/" => f / s
| _ => raise BadOperator operator)::r
| applyOperator operator _ = raise StackUnderflow
fun handleToken (token, stack) =
case fromString token of
NONE => applyOperator token stack
| SOME(value) => value::stack
fun handleInput inStack =
(if not (endOfStream stdIn) then
let
val outStack =
foldl handleToken inStack (tokens isSpace (inputLine stdIn))
in
if not (null outStack) then
(print (toString (hd outStack)); print "\n")
else ();
handleInput outStack
end
else raise Eof)
handle BadOperator operator => (print ("Bad operator: \""
^ operator ^ "\"\n");
handleInput inStack)
| StackUnderflow => (print "Stack underflow\n";
handleInput inStack)
val _ =
handleInput nil
handle Eof => ()
Author: far
Download
A near-literal translation from pranyi's O'Caml version.
load "Real";
open TextIO Char String Real
exception StackUnderflow
exception BadOperator of string
val _ = while not (endOfStream stdIn) do
case foldl
(fn (w, s) =>
let
fun f opr = case s of
h1 :: h2 :: t => opr (h2, h1) :: t
| _ => raise StackUnderflow
in
case w of
"+" => f (op +)
| "-" => f (op -)
| "*" => f (op * )
| "/" => f (op /)
| _ => case fromString w of
NONE => raise BadOperator w
| SOME(value) => value :: s
end)
nil (tokens isSpace (inputLine stdIn)) of
h :: _ => print ((toString h) ^ "\n")
| _ => ()
Author: Kieran Elby
Download
set stack [list]
while {1} {
set line [gets stdin]
foreach x [split $line " "] {
if {[regexp {^\d+\.?\d*$} $x]} {
lappend stack $x
} else {
if {[llength $stack] < 2} {
error "Not enough operands on stack for $x"
}
set a [lindex $stack end-1]
set b [lindex $stack end]
set stack [concat \
[lrange $stack 0 end-2]\
[list [expr "\$a $x \$b"]]]
}
}
puts [lindex $stack end]
}
Author: Kieran Elby
Download
proc + {a b} {return [expr {$a + $b}]}
proc - {a b} {return [expr {$a - $b}]}
proc * {a b} {return [expr {$a * $b}]}
proc / {a b} {return [expr {$a / $b}]}
set stack [list]
while {1} {
set line [gets stdin]
foreach x [split $line " "] {
# Use introspection to see if we've been given the name
# of a procedure and, if so, find out how many args it
# wants, then pop them and evaluate it.
if {[info proc $x] != ""} {
set num_args [llength [info args $x]]
if {[llength $stack] < $num_args} {
error "Not enough operands on stack for $x"
}
set op_args [lrange $stack end-[expr {$num_args-1}] end]
set stack [concat \
[lrange $stack 0 end-$num_args]\
[eval [list $x] $op_args]]
} else {
lappend stack $x
}
}
puts [lindex $stack end]
}
Author: conio
Download
set stack [list]
proc K {x y} {return $x}
proc pop {} {K [lindex $::stack end] [set ::stack [lrange $::stack 0 end-1]]}
interp alias {} push {} lappend stack
while {![eof stdin]} {
foreach token [split [gets stdin]] {
if [catch {switch -regexp -- $token {
{^[-+]?(\d*\.)?\d+([Ee][-+]?\d+)?$} {push $token}
{^[+*/-]$} {set n [pop]; push [expr "[pop] $token $n"]}
}}] {error "stack underflow"}
}
puts [lindex $stack end]
}
Author: Steve Wampler
Download
invocable all
procedure main(stk,ws:' \t')
while write("-> ",read() ? (while (pos(0) & break stk) |
push(stk, numeric(x := (tab(upto(~ws)),tab(many(~ws)))\1) |
proc(x,2)!push([],pop(stk),pop(stk))) |
break ["error"] )[1])
end
Author: Steve Wampler
Download
invocable all
procedure main(stk,ws:' \t')
while write("-> ",read() ? (while (pos(0) & break stk) |
push(stk,numeric(x := (tab(upto(~ws)),tab(many(~ws)))\1) |
(p := proc(x,3|2|1))!getArgs(stk,args(p),[]) ) |
break ["error"] )[1])
end
procedure getArgs(stk, i, a) # need args in reverse of stack order
every 1 to i do push(a, pop(stk)|fail)
return a
end