index.shtml, last modified: Saturday, 24-Apr-2004 23:42:23 CEST

An RPN calculator in 30 languages (and growing)

You may have heard of things such as the 99 Bottles of Beer, Hello World! 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 e97_far@e.kth.se.

Languages in the wishlist include, but are not limited to: Basic, Befunge, Cobol, D, Dylan, Forth, Eiffel, LOGO, Lua, Intercal, Modula-2, Modula-3, Oberon, Objective-C, PL/1, Prolog, Rexx, and Smalltalk.

Honorable mention: A Unix one-liner submitted by conio:
sed -ru 's/(.+)/10k & p/' | dc

Ada
Assembler (MC68000)
AWK
Bash
Brainfuck
C
C#
C++
Chef
Common Lisp
Emacs Lisp
Erlang
Fortran
Haskell
Io
Java
JavaScript
K
O'Caml
Pascal
Perl
PHP
PostScript
Python
Ruby
Scala
Scheme
Sed
Standard ML
TCL

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

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

C#

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

Author: carambola5
Download

using System;
using System.Collections;
class RPN
{
   static void Main()
   {
      Stack s = new Stack();
      foreach(string a in Console.In.ReadLine().Split(new char[] {' '}))
      {
         try{ s.Push(Double.Parse(a) + ""); }
         catch (Exception e)
         {
            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("error"); break;
            }
         }
      }
      Console.WriteLine(s.Pop());
      Console.In.ReadLine();
   }
}

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.

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

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

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

<script type="text/JavaScript">

function doRpn()
{
  s = document.rpn.rpn.value;
  ar = s.split( " " );
  r = 0;

  st = new Array;

  for ( i=0; i<ar.length; i++ )
  {
    if (!isNaN( ar[i] ) )
    {
      st.push( parseFloat( ar[i] ));
    } else {
      if ( st.length < 2 )
        alert ( "Buffer underrun!" );
      else {
        f2 = st.pop();
        st.push( eval( st.pop() + ar[i] + f2 ));
      }
    }
  }

  if ( st.length == 1 )
    document.rpn.rpn.value = st.pop();
  else
    document.rpn.rpn.value = "Error!";

  return false;
}

</script>

<form name="rpn" onSubmit="return doRpn();">
<input type="text" name="rpn">
</form>

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)

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

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

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

%!
% in ghostscript, stdin seems to be defined only if you run this from the
% interactive shell:
% GS>(rpn.ps) run

/+ { add } def
/- { sub } def
/* { mul } def
/\ { div } def % can't use '/' since it is used to signify literals

/stdin (%stdin) (r) file def 

% substitute '/' for '\' in a string
/subst {
    dup length 1 sub 0 1 3 -1 roll {
        dup 3 -1 roll
        dup 4 -1 roll
        get 47 eq { % '/' ascii
            dup 3 -1 roll
            92 put % '\' ascii
        } {
            exch pop
        } ifelse
        % s
    } for
} def

/buffer 200 string def

{
    stdin buffer readline not { exit } if
    subst
    /line exch def
    {	
        line token not { exit } if
        exch /line exch def
        cvx exec
    } loop
    exec dup =
} loop

Author: far
Download

This version requires you to use '\' instead of '/'. 
%!
/+ { add } /- { sub } /* { mul } /\ { div } /stdin (%stdin) (r) file
def def def def def
{ stdin token not { exit } if cvx exec } loop stack

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]

Ruby

An object-oriented language inspired by Perl and Smalltalk.

Author: kram
Download

stack = Array.new
while line = gets
  line.split(' ').each { |token|
    if "+-*/".include? token and token.length == 1
      if stack.length > 1
        second = stack.pop
        stack.push(eval("stack.pop #{token} second"))
      else
        puts "Stack underflow"
      end
    elsif token =~ /^[\d\.]*$/
      stack.push token.to_f
    else
      puts "Bad operator: #{token}"
    end
  }
  puts stack.last if stack.last
end

Author: pranyi
Download

ruby -ane 's=[];$F.each{|w|(w=~/^[+*\/-]$/)?s.push((a,b=s.pop,s.pop;b.send(w,a))):s.push(Float(w))};p s[0]'

Author: pranyi
Download

#!/usr/bin/env ruby

File.foreach(ARGV[0]) do |l|
  s = []
  l.split.each do |w|
    if w =~ /^[+*\/-]$/
      a,b = s.pop,s.pop
      s.push(b.send(w,a))
    else
      s.push(Float(w))
    end
  end
 
  if s.length == 1 then
     puts s[0]
  else
     $stderr.puts "malformed expression #{l}"
  end
end

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

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

Disclaimer Valid XHTML 1.1?