index.shtml, last modified: Sunday, 25-Jan-2009 20:36:52 CET

An RPN calculator in 48 languages (and growing)

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

Ada

Ada is featureful language developed for the US Department of Defense.

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;

Assembler (MC68000)

The Motorola 68000 series were used in the Amigas and older Macintoshes and had an instruction set that was rather nice for assembly programming.

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      NEWLINE

Assembler (x86)

Intel syntax. Under Linux, build with nasm -f elf rpn.asm && gcc -o rpn rpn.o

Author: 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

AWK

AWK (short for Aho, Weinberger and Kernighan) is a language mainly used for text processing. It makes heavy use of regular expressions.

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;
}

Bash

The Bourne Again SHell is based on the original Bourne shell and is one of the most common command shells for Unix.

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))]}
done

Author: 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))]}
done

Author: 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'

Brainfuck

Brainfuck is an eight-instruction language that models a Turing machine.

Author: pYrania
Download

+[-,>+>+>+>+>+>+<<<<<<-------------[>-<-------------------[>>-<<----------[>>>-<
<<-[>>>>-<<<<--[>>>>>-<<<<<--[>>>>>>[-]>+<<<<<<<-]]]]]]>[->->->->->-<<<<<]>[->->
->->-<<<<<<+>>]>[->->->-<<<<<<<-<-[>[>+>+<<-]>>[<<+>>-]<<<-]+>[-]+>[<<+>>-]>>]>[
->->-<<<<<<<-[<+>-]+>>>>]>[->-<<<<<<<-[<->-]+>>>>>]>[-<<<<<<<-[>+>+<<-]>->[<<+>>
-]<<<-[>>>>+<<[>+>[-]<<-]>[<+>-]>[-<<<[>+>+<<-]>>[<<+>>-]>>+<]<<-<<-]+>[-]+>[-]>
>>[<<<<<+>>>>>-]>>]>[<+>>,>++++++++[<---->-]<[>+++++[<--->-],>++++++++[<---->-]<
]<[<]>>[<-[>++++++++++<-]+>>]<[[<]>+[>]<-]<[-<]>[<<<<<<+>>>>>>-]<<<<<+>>>>>>>]<<
<<<<<]<[>>+<<-]>+>-[>+<<[-]>-]>[<+>-]<[>+++++++++<[>>>+<<[>+>[-]<<-]>[<+>-]>[<<+
+++++++++>>>+<-]<<-<-]<++++++++++>>[<<->>-]>>[-]>[<<<+>>>-]<<<]<[>]<[->++++++++[
<++++++>-]<.[-]<]>>

C

A language that needs little introduction. Historically linked to the Unix operating system.

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;}

C#

A Java-like language for Microsoft's .NET environment.

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>");
      }
   }
}

C++

C with an object orientation system inspired by Simula.

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;
}

Chef

A language where every program is recipe.

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.

Cilk

Cilk is a multithreaded parallel programming language based on C.

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;
}

CLU

CLU was created in the 1970s at MIT. It introduced abstract datatypes, parametric polymorphism (generics), abstract iterators, and structured exception handling. CLU has objects, but lacks inheritance.

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

Common Lisp

Perhaps the most successful dialect of Lisp. Supports the functional, imperative, and object-oriented paradigms. Good compilers are available.

Author: Howard Ding
Download

Iterative:
(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

Recursive:
(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*)

D

The D programming language is a "clean" redesign of C++.

Author: Simen Kjærås
Download

Requires D 2.0
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;
	}
}

Dylan

Dylan is a dynamic, object-oriented language with strong support for functional programming. It borrows heavily from Lisp (introspection, macros, the object model of CLOS), but has Algol-like syntax. Dylan features collections and generics.

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;

Emacs Lisp

The lisp dialect used in the Emacs text editor.

Author: far
Download

This is an Emacs major mode.
(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)

Erlang

A concurrent functional programming language developed by the Ericsson telecom manufacturer. Named after Agner Krarup Erlang.

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.

Fortran

One of the first high-level languages. Still used today, mostly for numerical computations.

Author: nephros
Download

Fortran 90. Reported to build with Intel's ifc compiler.
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 

Haskell

A purely functional, statically typed language with lazy evaluation.

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

Icon

Icon was born in the late 1970s as a successor to SNOBOL4. It has unique and powerful control structuring facilities (unlike SNOBOL4, but also unlike most other programming languages), and a variety of useful and convenient data structures. It is widely used for symbolic computations, text analysis, graphics and elsewhere. Icon lacks SNOBOL4's text pattern mechanism and henceforth - some of its succinctness for dealing with text data, but this is compensated by a rich and stable `standard library' from contributing programmers. A clone of Icon called Unicon has standardized libraries for database connectivity, Internet programming, as well as for text processing.

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

INTERCAL

INTERCAL (short for "Compiler Language With No Pronounceable Acronym") is designed to be different from all other programming languages.

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$"'&#65535$"'&#65535$
	"'&#65535$"'#65535'~ '"?.1$#13"~"#0$#65535"'"'~'#65280$#65025'"'~
	'#65280$#65025'"'~'#65280$#65025'"'~'#65280$#65025'"'"'~#0$#65535"$
	"'"'&#65535$"'&#65535$"'&#65535$"'&#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

Io

Io is a small language with a simple syntax and is primarily intended as an extension language. The OO model is prototype-based.

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")
  )
)

Java

An object-oriented language with C-like syntax. Has a large, platform-independent standard library.

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
        }
    }
} 

JavaScript

Formerly known as "Mocha" or "LiveScript", called "JScript" by Microsoft, but the official standard is called "ECMAScript". A dynamically typed language with a prototype-based OO model. Is mostly used in web pages to be executed by the browser. Has little to do with Java, despite the name.

Author: int2str
Download
Try it

[an error occurred while processing this directive]

K

K is a fast and concise functional language developed by Kx Systems.

Author: Stevan Apter
Download

Uses '%' as the division operator instead of '/'.
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)
Logo was created in the late 70s as a vehicle for introductory teaching of programming and computing, especially to children. It was advertised for its turtle graphics capabilities. This gave it a reputation for being a childish language, while it really is an extensible, general-purpose programming language, with a mixed functional/imperative flavour.

Author: Boyko Bantchev
Download

Runs in Berkeley Logo and MSWLogo.
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

Lua

Lua is a small but versatile, semantically extensible language, designed for both stand-alone use and as an extension language to be embedded in applications. Lua is popular as a scripting language for game programming.

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

Objective-C

Objective-C extends ANSI C with support for Smalltalk-style object-oriented programming.

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;
}

O'Caml

Perhaps the most popular dialect of the statically typed functional language ML. Supports object-oriented programming.

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

OmniMark

OmniMark is a text-processing language, with especially advanced features for processing SGML and XML. Programs written in OmniMark tend to look like simplified English prose. Currently, there are no free translators from this language, but there are commercially available ones for most operating systems of today.

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

Pascal

A statically typed language originally intended to be used to teach programming.

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.

Perl

A very pragmatic language that was inspired by C, AWK, sed and unix shells.

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 $@;
}

PHP

Mostly used on web servers to generate dynamic web pages, but can also be used to make stand-alone programs.

Author: int2str
Download
Try it

<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() );
?>

PostScript

A stack-based Forth-like page description language. The commands are written in postfix notation, like in an RPN calculator.

Author: far
Download

[an error occurred while processing this directive]

Author: far
Download

This version requires you to use '\' instead of '/'.
[an error occurred while processing this directive]

Prolog

A logic programming language, mostly used for AI problems. Prolog does not have functions or procedures; it has facts, rules and queries. The order of execution is implicit.

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([]).

Python

A language that aims to be readable and easy to learn. Has an extensive standard library. Indentation is used to indicate block structure.

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())

REBOL

REBOL is a modern programming language for 'scripting the Internet.' It has lots of datatypes, rich control structures, built-in graphic facilities, database connectivity and features for programming many Internet protocols.

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}] ]]]

Refal

Refal is a typeless functional language invented in the late 1960s. Computation in Refal is performed through term rewriting based on pattern matching. For function definitions, Refal's structural patterns play a similar role to that of type constructors in a typed functional language.

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 = ()};

REXX

REXX was created in the early 1980s and was used on IBM's VM/370 OS as what is now called a scripting language. Ever since, REXX has been a standard part of all IBM operating systems. It also has many implementations for other operating systems, and is still actively used.

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

Ruby

An object-oriented language inspired by Perl and Smalltalk.

Author: kram
Download

[an error occurred while processing this directive]

Author: pranyi
Download

[an error occurred while processing this directive]

Author: pranyi
Download

[an error occurred while processing this directive]

Scala

An object oriented, functional language that compiles to Java VM bytecode.

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); 
  }
}

Scheme

A minimalist dialect of Lisp that encourages functional programming.

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 '())

Sed

Sed is a non-interactive version of the Unix editor ed. It is mainly used for text processing in shell scripts.

Author: ecatmur
Download

Supports positive integers only. They can be of arbitrary size though.
#!/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

Smalltalk

A pioneer of dynamically typed, object-oriented languages.

Author: Stewart Stremler
Download

GNU Smalltalk 3
#!/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.

SNOBOL4

SNOBOL4 was the de facto standard text processing language for the mainframes. It dates back to the 1960s, and is definitely old-fashioned with respect to its program structuring, but its text manipulation features are truly powerful and convenient to use, even by modern criteria. In fact, some of these features remain still unmatched in today's languages.

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

Standard ML

SML (Standard ML) is a dialect of the ML (Meta-Language) functional language. It is statically typed, using type inference and supports imperative programming.

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")
      | _ => ()

TCL

The Tool Command Language is a weakly typed language where anything can be treated as a string. Also known as Tcl/Tk from the popular widget toolkit known as Tk.

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]
}

Unicon

Unicon is a superset of Icon that adds, among other things, support for object orientation and networking.

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

Supports unary and trinary function calls.
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