if 0 {[Richard Suchenwirth] 2004-02-01 - From [RPN in Tcl] via [Playing Joy] to [Minimal RPN], programming in Reverse Polish Notation (or postfix, as in "1 2 +" returning 3), as known from [Forth] and [Postscript], has ever again fascinated me. With due awareness of the stack, it is possible to write algorithms without any variables, and [constants] can be unified with commands too, as they just push their value on the stack. This is possible in [pure-Tcl] as well:
 proc Pi {} {return 3.14159}
but in Postscript, and this current take at RPN, it looks more minimal, and less procedural:
 /Pi 3.14159 def
So on a sunny Sunday afternoon, iPaq in hand, I concocted the following implementation - less minimal than [Minimal RPN], but closer to the real thing. The ''rpn'' command walks over its arguments, and pushes them on the stack if they are not known commands (or prefixed with a /, like in Postscript - to define something named /x just call it //x the first time), else it invokes the command, which typically pops its argument(s) from the stack, and pushes its result. As a gateway to the underlying language, if the first argument is "tcl", the rest are [eval]led in Tcl - somehow you have to bootstrap the functionality. The stack is a global list ::S, top at end, the dictionary a global array ::cmd, which maps command names to their RPN body. You can define commands like this:
 rpn /square {dup *} def
which, when executed, duplicates the top of stack, pops the two top elements and pushes their multiplication result. Somehow like
 proc square {x} {expr $x*$x}
but without having to make up a variable name x. Most [expr] operators and functions have been exposed as RPN commands, hence unifying the Polish Tcl and the infix [expr] into Reverse Polish.

Unlike Forth, more like Postscript or Joy, you can push arbitrarily large chunks of data on the stack at one time. This allows doing away with awkward lookahead, as in Forth
 (cond) if (thencmds) else (elsecmds) endif
 : (cmdname) (cmdbody) ;
in favor of the Postscript-like
 (cond) {thencmds} {elsecmds} if
 /(cmdname) {cmdbody} def
So let's start with the central proc:}
 proc rpn args {
    if {[llength $args]==1} {set args [lindex $args 0]}
    if {[lindex $args 0] eq "tcl"} {
       foreach cmd [lrange $args 1 end] {uplevel 1 $cmd}
    } else {
       foreach word $args {
          if {[regexp ^/(.+) $word -> word]} {
              push $word ;# / quoting
          } elseif [info ex ::cmd($word)] {
             eval rpn $::cmd($word)
          } else {push $word}
       }
    }
    lindex $::S end ;#return top(stack)
 }
#----------- Stack routines:
 interp alias {} push {} lappend ::S
 proc pop {} {
   global S
   K [lindex $S end] [set S [lrange $S 0 end-1]]
 }
 proc K {a b} {set a}
 proc swap {} {push [pop] [pop]}

if 0 {A base set of command words is implemented in Tcl, where a list of commands is executed in order - this is comparable to [Lisp]'s PROGN. For the first time I could make good use of multiple bracketed commands, as in [[swap;pop]]:}
 array unset ::cmd
 array set ::cmd {
   .  {tcl {puts -nonewline "[pop] "}}
   .s {tcl {puts $::S}}
   def {tcl {set ::cmd([swap;pop]) [pop]}}
   drop {tcl pop}
   dup {tcl {push [lindex $::S end]}}
   if {tcl {set e [pop]} {set t [pop]} {if [pop] {rpn $t} {rpn $e}}}
   rand {tcl {push [expr rand()]}}
   sum {tcl {push [expr [join [pop] +]]}}
   swap {tcl swap}
 }
#--------- expr binary operators:
 foreach op {+ - * / % > >= == != <= < && ||} {
    set ::cmd($op) [string map "@ $op" {tcl {push [expr [swap;pop]@[pop]]}}]
 }
#--------- expr one-arg functions
 foreach f {acos asin atan ceil cos cosh exp floor log log10 sin sinh sqrt tan tanh abs double int round srand} {
    set ::cmd($f) [string map "@ $f" {tcl {push [expr @([pop])]}}]
 }
#------- Importing some one-arg Tcl commands:
 foreach c {llength open read close} {
    set ::cmd($c) [string map "@ $c" {tcl {push [@ [pop]]}}]
 }

if 0 {Further words are defined in RPN itself. Note that the sgn function looks more contrapted than it would in Tcl:
 proc sgn x {expr {$x>0? 1 : $x<0? -1: 0}}
}
 rpn /sq {dup *} def
 rpn /sgn {dup 0 > {drop 1} {0 < -1 0 if} if} def
if 0 {Factorial is recursively defined (I'm not sure whether that was possible in Forth):}
 rpn /fac {dup 2 < {drop 1} {dup 1 - fac *} if} def
#--- Average of a list of numbers:
 rpn /avg {dup sum swap llength double /} def
# Celsius centigrades <> Fahrenheit:
 rpn /c2f {9 * 5 / 32 +} def
 rpn /f2c {32 - 5 * 9 /} def

if 0 {The following debugging helpers proved useful on the iPaq, where less typing is better:}
 set thisfile [info script]
 proc s {} {
    if [catch {uplevel #0 source $::thisfile}] {set ::errorInfo}
 }
 proc c name {set ::cmd($name)}
 proc .s {} {K "" [rpn .s]}
 proc cs {} {set ::S {}}

#---------------- Test suite (usage examples):
 proc must {cmd exp} {
     catch [list uplevel 1 $cmd] res
     if {$res ne $exp} {
       error "$cmd -> $res, expected $exp"
    }
 }
 must {rpn 1 2 +} 3
 must {rpn 1 2 -} -1
 must {rpn 1.4 int} 1
 must {rpn 1 0 > yes no if} yes
 must {rpn 1 0 < yes no if} no
 must {rpn 5 sq} 25
 must {rpn 42 sgn} 1
 must {rpn -42 sgn} -1
 must {rpn 0 sgn} 0
 must {rpn 4 fac} 24
 must {rpn {1 2 3} llength} 3
 must {rpn {1 2 3} sum} 6
 must {rpn {1 2 3 4} avg} 2.5
 must {rpn 0 c2f} 32
 must {rpn 100 c2f} 212
 must {rpn 212 f2c} 100

 puts "passed all tests"

----
[Arts and crafts of Tcl-Tk programming]