proc Pi {} {return 3.14159}but in Postscript, and this current take at RPN, it looks more minimal, and less procedural:

/Pi 3.14159 defSo on a sunny Sunday afternoon (and the following rainy weekend), 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 "quoted" 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 evalled 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 *} defwhich, 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} defThe language developed herein is a mix of Forth, Postscript and Joy (with much reuse of Tcl functionality, especially with lists), so I just give it the generic name rpn. After setting up timing, let's start with the central proc: }

set t0 [clock clicks] proc timed args { puts $args:[expr {[clock clicks]-$::t0}] set ::t0 [clock clicks] } proc rpn args { if {$::cmd(debug)} {puts stdout ---[info level 0]} if {[llength $args]==1} {set args [lindex $args 0]} if {[lindex $args 0] eq "tcl"} { eval [lindex $args 1] } else { foreach word $args { if {$::cmd(debug)} {puts $::S} if {[regexp ^/(.+) $word -> word]} { push $word ;# "/" quoting } elseif [info ex ::cmd($word)] { rpn $::cmd($word) } else {push $word} } } lindex $::S end ;#return top(stack) } #----------- Stack routines: interp alias {} push {} lappend ::S proc pop {} { global S if {![llength $S]} {error underflow} K [lindex $S end] [set S [lrange $S 0 end-1]] } proc K {a b} {set a} #-- Boolean selectors", see [If we had no if] proc 0 {then else} {rpn $else} proc 1 {then else} {rpn $then} #-- stack reverters proc swap {} {push [pop] [pop]} proc 3sw {} {push [pop] [pop] [pop]} proc 4sw {} {push [pop] [pop] [pop] [pop]}A base set of command words is implemented in Tcl. For the first time I could make good use of multiple bracketed commands, as in [swap;pop]:

array unset ::cmd array set ::cmd { .s {tcl {puts $::S}} $ {tcl {push $::cmd([pop])}} debug 0 def {tcl {set ::cmd([swap;pop]) [pop]}} drop {tcl pop} dup {tcl {push [lindex $::S end]}} filter {tcl {set cond [pop] set res {} foreach i [pop] { push $i if [rpn $cond;pop] {lappend res $i} } push $res} } for {tcl {set body [pop] set max [pop]; set inc [pop] for {set i [pop]} {$i<=$max} {incr i $inc} { push $i; rpn $body } }} lappend {tcl {push [concat [swap;pop] [list [pop]]]}} map {tcl {set body [pop] set res {} foreach i [pop] { push $i lappend res [rpn $body;pop] } push $res }} pick {tcl {set i end-[expr {[pop]-1}] push [lindex $::S $i]}} primrec {tcl {set op [pop] set b0 [pop]; set x [pop] if {$x>0} { push $x [incr x -1] $b0 $op rpn primrec $op } else { rpn $b0 }}} roll {tcl {global S set i end-[expr {[pop]-1}] push [K [lindex $S $i] [set S [lreplace $S $i $i]]]}} [email protected] {tcl {push [llength $::S]}} swap {tcl swap} #while {tcl {set b [pop];set e [pop] while {[pop]} {rpn $b; rpn $e}}} } #--------- 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])]}}] } #----- rpn "library functions": rpn { /# /drop def {for comments} #Tcl commands can be invoked generically, but the "arity" (number of arguments) must be specified: #

/tcl0 {tcl {push [[pop]]}} def /tcl1 {tcl {push [[pop] [pop]]}} def /tcl2 {tcl {push [[pop] [swap;pop] [pop]]}} def /tcl3 {tcl {push [[pop] [3sw;pop] [pop] [pop]]}} def /tcl4 {tcl {push [[pop] [4sw;pop] [pop] [pop] [pop]]}} def /. {putc " " putc} def{Range generator, 1 3 ..-> {1 2 3}} #

/.. {{} 3 roll 1 4 roll /lappend for} def /and //&& def {delete stack until given mark} # /clear {dup rot == [email protected] 2 < or {} /clear if} def /close {//close tcl1} def /concat {//concat tcl2} def /cons {swap swons} def /emit {%c swap /format tcl2 putc} def /eval {//rpn tcl1 drop} def /even {odd not} def /expr {//expr tcl1} def /fac2 {1 2 1 4 roll /* for} def /first {1 nth} def /if {rot 0 != tcl2 drop} def /incr {swap dup $ 3 roll + def} def /join {//join tcl2} def /length {//llength tcl1} def /nth {1 - /lindex tcl2} def /not {0 ==} def /lrange {//lrange tcl3} def /odd {2 %} def /open {//open tcl1} def /or //|| def /over {2 pick} def /putc {-nonewline swap /puts tcl2 drop} def /rand {rand() expr} def /read {//read tcl1} def /readfile {open dup read swap close drop} def /rest {1 end lrange} def /rot {3 roll} def /sgn {dup 0 > swap 0 < -} def /sq {dup *} def /sum {//+ join expr} def /swons {0 swap /linsert tcl3} def /uncons {dup first swap rest} def /unswons {dup rest swap first} def }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 #-- ...or in Joy style: rpn /fac2 {1 /* primrec} def#--- Average of a list of numbers:

rpn /avg {dup sum swap length double /} def# Celsius centigrades <> Fahrenheit:

rpn /c2f {9 * 5 / 32 +} def rpn /f2c {32 - 5 * 9 /} defif 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 {}} ;# clear stack#---------------- Test suite (usage examples), now also with stack leak control:

proc must {cmd exp} { catch [list uplevel 1 $cmd] res if {$res ne $exp} { error "$cmd -> $res, expected $exp" } pop ;# don't let the stack leak if [llength $::S] {error "$cmd leaked $::S"} #timed $cmd->$res } timed definitions cs 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 6 fac2} 720 must {rpn {1 2 3} length} 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 must {rpn {a b} c lappend} {a b c} must {rpn {a b c} 2 nth} b #-- "must" pops one result; more must be popped manually for leak control must {K [rpn a b c 3 roll] [pop;pop]} a must {K [rpn x y z over] [pop;pop;pop]} y must {rpn 3+4 expr} 7 must {rpn {5 6 +} eval} 11 must {rpn {1 2 3} /sq map} {1 4 9} must {rpn {1 2 3 4} /odd filter} {1 3} must {rpn {1 2 3 4} {2 %} filter} {1 3} must {rpn -- /i 22 def} -- must {rpn /i $} 22 must {rpn /i 3 incr i} 25 must {rpn /sq $} {dup *} ;#info body must {rpn {a b c d} 1 2 lrange} {b c} must {rpn {2 3 4} /sum eval} 9 must {rpn 1 5 ..} {1 2 3 4 5} must {rpn 5 1 /* primrec} 120 must {rpn {a b} {c d} concat} {a b c d} must {rpn 42 even} 1 must {rpn {a b c} first} a must {rpn {a b c} rest} {b c} must {rpn a {b c} cons} {a b c} must {rpn {b c} a swons} {a b c} must {rpn {1 2 3} uncons cons} {1 2 3} must {rpn {1 2 3} unswons swons} {1 2 3} .s timed tests

RS A year later, re-reading papers on Joy, a remake was needed - see Pocket Joy 2005