Updated 2012-05-15 10:52:14 by RLE

After some experimentation with Pocket Joy 2005 (thanks to RS :), I tried to build a minimalist RPN language that could handle vectors, matrices and binary data. It is still experimental, but I think that, when coded in C, it may address an item of Tcl 9.0 Wishlist for doing some math with a fast interpreted language. Then Tcl + C (Ousterhout's Dichotomy) may become Tcl + Rpn + C, with less efforts than binding another language to Tcl. -- Sarnold 2006-04-21

SArnold 2006-11-10 The implementation has continuations with no additional keyword, though no changes have been done to this pure-Tcl implementation.

Basics

The r command evaluate RPN commands. Each numerical value is pushed on the stack, and commands pop their arguments from the stack. The . command pops a number from the stack and returns it as a Tcl string. To print the stack , just invoke the .s command:
 r .s

To clear the stack, invoke c.

Basic types

  • Numbers : accept both integers and doubles. Most of math operators and functions are implemented
 % r 1 2 +
 % r .s
 3
 % r .
 3
 % r 3 4 .s
 3 4
 % r double + .
 7.0

  • Vectors : they are just flat lists pushed after the vector keyword. To pop a vector, invoke .v. The list forming the vector is first expanded into <n> numbers and pushed on the stack, then the vector's length is pushed on the stack.
 # {1 2 4 8} -> 1 2 4 8 then the length, 4
 % r vector {1 2 4 8} .s
 1 2 4 8 4
 % r .v
 {1 2 4 8}

  • Matrices : bidimensionnal arrays as Tcl lists placed after the matrix keyword. Pop them with .m. The elements of the matrix are first expanded into <n> numbers and pushed on the stack, then the column number is pushed, and finally the length of the pushed data is pushed (<n>+1).
 # 2 columns, 4 elements, 5 numbers (the 4 elements then the column number)
 % r matrix {{1 2} {3 4}} .s
 1 2 3 4 2 5
 % r .m
 {{1 2} {3 4}}

  • Binary data : enclosed in quotes, after the binary keyword. Pop them with .b.
 % r binary 'Aa09' .s
 65 97 48 57 4
 % r .b
 Aa09

  • Scripts : any list formed by 2 or more values/commands are treated as a script, and a new command is created as a container for this script. A single command that does not require immediate evaluation can be enclosed in parentheses. The i command evaluate the top of the stack as a command.
 % r 1 ++ ++ ++ .s
 4
 % r c 1 3 (++) .s
 1 3 ++
 # times performs n times the script given as second argument
 % r times .
 4
 % r -1 (++) i .
 0

Registers

You can store the top of the stack, just for a while, into a register. Registers are *not* like CPU registers: they are implemented as a stack. sto pops the top of the stack, and pushes it on the register stack. get does exactly the opposite.
 % r 3 sto 1 .s
 1
 % r get .s
 1 3

ssto and sget are complements of sto and get : ssto stores the top of the stack without removing it from the stack, while sget retrieves a register without removing it from the register stack.
 % r c 3.14 ssto .s
 3.14
 % r drop sget sget .s
 3.14 3.14
 % r drop drop get .s
 3.14

Creating commands

def commandname parses its arguments as a script, and registers it as a command named after its first argument. When commandname is invoked, the script is evaluated as if it was entered as arguments of r. Example :
 % r 3 2 + .
 5
 % r 5 2 + .
 7
 % def 2+ 2 +
 % r 3 2+ . 5 2+ .
 5 7

defn commandname tcl_command ?arg ...? It created a new command at the Tcl level. tcl_command should be the name of a Tcl proc, and it should pop and push values explicitly via the ::rpn API. (see the source for more details)

rpn2006.tcl
    namespace eval ::rpn {
        proc r args {
            variable S
            variable C
            variable N
            variable R
            
            foreach {callstack cleanup} [refactor $args rpn] {break}
            set check ""
            set callstack [list $callstack]
            set out ""
            while {[llength $callstack]} {
                set args [lindex $callstack end]
                set callyet 0
                foreach a $args {
                    set args [lrange $args 1 end]
                    dputs [info level]:[llength $callstack]:$S\\$a
                    set cont no
                    switch -- $a {
                        debug {
                            debug [lindex $callstack end] $args
                        }
                        trace {puts $code}
                        .  {lappend out [pop]}
                        .b {lappend out [to_binary]}
                        .v {lappend out [to_vector]}
                        .m {lappend out [to_matrix]}
                        default {set cont yes}
                    }
                    if {!$cont} {
                        if {[llength $callstack]!=1} {
                            set out ""
                        }
                        continue
                    }
                    if {[info exists N($a)]} {
                        eval $N($a)
                    } elseif {[info exists C($a)]} {
                        lset callstack end $args
                        lappend callstack $C($a)
                        if {$C($a,regcheck)} {
                            lappend check [llength $R] [llength $callstack]
                        }
                        set callyet 1
                        break
                    } else {
                        # command name without evaluation: the string (+)
                        # pushes + onto the stack without
                        # performing any addition
                        push [string trim $a ()]
                        # example:  r 2 3 (+)   -> 2 3 +
                        #           r 2 3  +    -> 5
                        # evaluating the first one with i:
                        #           r 2 3 (+) i -> 5
                    }
                }
                if {$callyet} {continue}
                if {[llength $callstack] == [lindex $check end]} {
                    set nbreg [K [lindex $check end-1] [set check [lrange $check 0 end-2]]]
                    if {[llength $R] != $nbreg} {
                        return -code error -errorcode {RPN register} \
                                "register check failed : $nbreg expected, got [llength $R]"
                    }
                }
                set callstack [lrange $callstack 0 end-1]
            }
            if {[llength $callstack] != 0} {
                return -code error -errorcode {RPN callstack} "internal error : callstack still active"
            }
            foreach cmd $cleanup {
                cleansub $cmd
            }
            return $out
        }
        proc defn {name args} {
            variable N
            set N($name) $args
        }
        # cleanup subcommands created from eval bodies
        proc cleansub {n} {
            variable C
            foreach name [array names C $n,*] {
                unset C($name)
            }
            catch {unset C($n)}
        }
        proc commands {{match *}} {
            variable C
            array names C $match 
        }
        proc body {name} {
            variable C
            set C($name)
        }
        proc def {n args} {
            variable C
            cleansub $n
            set C($n) [lindex [refactor $args $n] 0]
        }
        proc interactive_debug {stack remaining} {
            while 1 {
                puts -nonewline "debug (q to leave)> "
                gets stdin input
                switch -- $input {
                    "" {
                        r .s .r
                        continue
                    }
                    q {
                        return
                    }
                    error {
                        error "operation cancelled by the user"
                    }
                    trace {
                        set msg "$stack\nremains : $remaining"
                    }
                    default {
                        if {[catch {eval r $input} msg]} {
                            puts "error in rpn expression :\n  $msg\n"
                            continue
                        }
                    }
                }
                if {$msg eq ""} {
                    r .s
                    return
                }
                puts $msg
            }
        }
        
        # That's it. Stack (list), Native and Command arrays are namespace variables
        
        variable S {}
        variable R {} ; # register stack
        variable code {}
        catch {array unset C}
        catch {array unset N}
        variable C
        variable N
        array set C {}
        array set N {}
        
        
        #-- A tiny switchable debugger:
        
        proc d+ {{type trace}} {
            switch -- $type {
                trace - stack {proc dputs s {puts $s}}
                break - breakpoint - br {
                    proc debug {s r} {interactive_debug $s $r}
                }
                default {error "unknown debug feature"}
            }
        }
        proc d- {}  {proc dputs args {}; proc debug args {}}
        d- ;#-- initially, debug mode off
        
        if 0 {Definitions are in Forth style, as they look much more compact than Joy's
            
            DEFINE n == args;
            
            Here :
                    def <name> elt ?elt ...?
                    
            or, for tcl commands :
                    defn <name> tclcommand ?arg ...?
            
        }
        # since lists are not supported, we have to refactor so that each code sequence
        # is replaced with a new command
        #
        # The -regcheck option tells the interpreter (not Tcl, RPN :)
        # to checks there are the same registers number at the end than at the beginning.
        # (because it is easy to get memory leaks when you don't tell that)
        #
        # 'def foo {dup *} for' is translated into:
        #         'def foo (foo,1) for'
        #         'def foo,1 dup *'
        proc refactor {arg name} {
            variable C
            if {[lindex $arg 0] eq "-regcheck"} {
                set C($name,regcheck) yes
                set arg [lrange $arg 1 end]
            } else  {
                set C($name,regcheck) no
            }
            set out ""
            set created ""
            set nbsub 1
            for {set i 0} {$i < [llength $arg]} {incr i} {
                set value [lindex $arg $i]
                switch -- $value {
                    vector - matrix - binary {
                        set next [lindex $arg [expr {$i+1}]]
                        eval lappend out [from_$value $next]
                        incr i
                    }
                    default {
                        if {[llength $value] > 1} {
                            while {[info exists C($name,$nbsub)]} {
                                incr nbsub
                            }
                            set C($name,$nbsub) [lindex [refactor $value $name,$nbsub] 0]
                            lappend out ($name,$nbsub)
                            lappend created $name,$nbsub
                        } else  {
                            lappend out $value
                        }
                    }
                }
            }
            return [list $out $created]
        }
        
        if 0 {expr functionality is exposed for binary operators and one-arg functions:}
        
        proc 2op op {
            set t [pop]
            push [expr {[pop]} $op {$t}]
        }
        foreach op {+ - * / > >= != <= <} {defn $op 2op $op}
        defn = 2op ==
        defn ++ radd 1
        defn -- radd -1
        proc radd {increment} {
            push [expr {[pop]+$increment}]
        }
        proc 1f  f {push [expr $f\([pop])]}
        foreach f {abs double exp int sqrt sin cos tan asin acos atan} {defn $f 1f $f}
        
        # stubs between the main stack and the register stack
        # pushes the last value into the register stack
        defn sto store
        # pop the last value from the register stack and push it
        defn get get
        # sget : get without pop; ssto : sto without pop
        defn ssto sstore
        defn sget sget
        defn rdrop rdrop
        proc store {} {
            variable R
            lappend R [pop]
        }
        proc sstore {} {
            variable R
            set var [pop]
            lappend R $var
            push $var
        }
        proc get {} {
            variable R
            push [K [lindex $R end] [set R [lrange $R 0 end-1]]]
        }
        proc rdrop {} {
            variable R
            set R [lrange $R 0 end-1]
        }
        proc sget {} {
            variable R
            push [lindex $R end]
        }
        
        # ------ rpn commands linked to procs
        
        defn .s putstack
        proc putstack {} {puts $::rpn::S}
        defn .r regput
        proc regput {} {puts $::rpn::R}
        defn and 2op &&
        defn bitand 2op &
        defn bitcomp 1f ~
        defn bitor 2op |
        defn bitxor 2op ^
        
        defn c clearstack
        proc clearstack {} {
            variable S
            variable R
            set S {}
            set R {}
        }
        
        defn cleave cleave
        proc cleave {} {
            foreach {f g} [pop 2] break
            r vdup $f
            r dupd swap insert
            r $g
        }
        defn drop pop
        
        defn dup  dup
        defn dupd dupd
        defn dupt dupt
        foreach {name number index} {
            dup 0 end
            dupd 1 end-1
            dupt 2 end-2
        } {
            proc $name {} [string map [list num $number end $index] {
                variable S
                Index num
                push [lindex $S end]
            }]
        }
        
        defn filter vfilter
        proc vfilter {} {
            foreach {len cmd} [pop 2] {break}
            foreach e [pop $len] {
                r $e $cmd
                if {[pop]} {push $e} {incr len -1}
            }
            push $len
        }
        
        defn vfold vfold
        proc vfold {} {
            foreach {size init f} [pop 3] {break}
            set vector [pop $size]
            push $init
            foreach e $vector {
                r $e $f
            }
        }
        
        # iterations : for i:=0..n do push i; f(); next i
        defn for rfor
        proc rfor {} {
            foreach {n f} [pop 2] {break}
            for {set i 0} {$i<$n} {incr i} {
                r $i $f
            }
        }
        
        # a foreach command : <vector> <code> foreach
        defn foreach rforeach
        proc rforeach {} {
            set f [pop]
            foreach e [pop [pop]] {
                push $e
                r $f
            }
        }
        
        defn i i
        proc i {} {
            r [pop]
        }
        
        # if-then-else
        defn ifte rifte
        proc rifte {} {
            foreach {cond then else} [pop 3] {break}
            r dup $cond
            r [expr {[pop]? $then: $else}]
        }
        
        defn in in
        proc in {} {
            set l [pop [pop]]
            push [expr {[lsearch $l [pop]]>=0}]
        }
        
        defn insert rinsert
        proc rinsert {} {
            variable S
            foreach {pos value} [pop 2] {break}
            Index $pos
            set S [linsert $S end-[incr pos] $value]
        }
        
        # stack manipulation : item by item
        defn itemdup ritemdup
        defn itemgrab ritemgrab
        defn itemset ritemset
        defn itempick ritempick
        proc ritemdup {} {
            variable S
            set index [pop]
            if {$index<0} {
                return -code error -errorcode {RPN stack} "negative index"
            }
            Index $index
            push [lindex $S end-$index]
        }
        proc ritemgrab {} {
            set index [pop]
            if {$index<0} {
                return -code error -errorcode {RPN stack} "negative index"
            }
            set item [Index $index]
            variable S
            set S [lreplace $S end-$index end-$index]
            push $item
        }
        proc ritemset {} {
            foreach {index value} [pop 2] {break}
            if {$index<0} {
                return -code error -errorcode {RPN stack} "negative index"
            }
            Index $index
            variable S
            lset S end-$index $value
        }
        proc ritempick {} {
            set index [pop]
            if {$index<0} {
                return -code error -errorcode {RPN stack} "negative index"
            }
            Index $index
            variable S
            set S [lreplace $S end-$index end-$index]
        }
        
        defn max max
        defn min min
        proc max {} {push [expr {[set x [pop]]>[set y [pop]]?$x:$y}]}
        proc min {} {push [expr {[set x [pop]]<[set y [pop]]?$x:$y}]}
        
        defn vmap vmap
        proc vmap {} {
            foreach {len f} [pop 2] {break}
            foreach e [pop $len] {
                push $e
                r $f
            }
            push $len
        }
        
        defn matrow matrow
        defn matcol matcol
        proc matrow {} {
            set index [pop]
            foreach {cols len} [pop 2] {break}
            # the inverse routing
            set rows [rows $len $cols]
            set index [expr {$rows - $index - 1}]
            set start [expr {$index * $cols + 2}]
            set end [expr {$start + $cols - 1}]
            push $cols $len $end $start
            range
            push $cols
        }
        proc rows {len cols} {
            incr len -1
            if {$len % $cols != 0} {
                return -code error -errorcode {RPN matrix} "rows and columns do not match"
            }
            return [expr {$len / $cols}]
        }
        proc matcol {} {
            set index [pop]
            foreach {cols len} [pop 2] {break}
            # the inverse routing
            set index [expr {$cols - 1 - $index}]
            set out ""
            for {set i 0} {$i < $len-1} {incr i $cols} {
                set pos [expr {$i+$index}]
                set out [linsert $out 0 [Index $pos]]
            }
            push $cols $len
            vpush $out
        }
        # concatenates $1 vectors on the stack to build a matrix
        # example : r vector {1 2 3} vector {4 5 6} 2 matconcat .m => {{1 2 3} {4 5 6}}
        defn matconcat matconcat
        proc matconcat {} {
            set n [pop]
            set cols [pop]
            push $cols
            set out ""
            for {set row 0} {$row < $n} {incr row} {
                if {$cols != [pop]} {
                    return -code error -errorcode {RPN matrix} "columns numbers do not match"
                }
                set out [concat [pop $cols] $out]
            }
            lappend out $cols
            vpush $out
        }
        
        defn move move
        proc move {} {
            foreach {end start} [pop 2] {break}
            if {$start<0} {
                return -code error -errorcode {RPN stack} "negative index"
            } elseif {$end<$start} {
                return -code error -errorcode {RPN stack} "range end smaller than start"
            }
            Index $end
            variable S
            foreach elt [K [lrange $S end-$end end-$start] [set S [lreplace $S end-$end end-$start]]] {
                lappend S $elt
            }
        }
        
        
        defn nop nop
        proc nop {} {}
        
        defn not 1f !
        defn or  2op ||
        
        defn pick pick
        proc pick {} {
            foreach {end start} [pop 2] {break}
            if {$start<0} {
                return -code error -errorcode {RPN stack} "negative index"
            } elseif {$end<$start} {
                return -code error -errorcode {RPN stack} "range end smaller than start"
            }
            Index $end
            variable S
            set S [lreplace $S end-$end end-$start]
        }
        defn range range
        proc range {} {
            foreach {end start} [pop 2] {break}
            if {$start<0} {
                return -code error -errorcode {RPN stack} "negative index"
            } elseif {$end<$start} {
                return -code error -errorcode {RPN stack} "range end smaller than start"
            }
            Index $end
            variable S
            foreach elt [lrange $S end-$end end-$start] {
                lappend S $elt
            }
        }
        
        defn rem rem
        proc rem {} {
            foreach {a b} [pop 2] {break}
            if {[string is integer $a] && [string is integer $b]} {
                push [expr {$a % $b}]
                return
            }
            # double do not have % operator, but fmod() function
            push [expr {fmod($a,$b)}]
        }
        
        defn reverse reverse
        proc reverse {} {
            vpush [lreverse [pop [pop]]]
        }
        proc lreverse {mylist} {
            set r ""
            foreach e $mylist {set r [concat $e $r]}
            set r
        }
        
        defn lshift 2op <<
        defn rshift 2op >>
        
        defn split vsplit
        proc vsplit {} {
            foreach {len f} [pop 2] {break}
            set list [pop $len]
            foreach e $list {
                r $e $f
                if {[pop]} {
                    lappend true $e
                } else  {
                    lappend false $e
                }
            }
            foreach l [list $false $true] {
                vpush $l
            }
        }
        defn swap swap
        proc swap {} {
            push [pop] [pop]
        }
        defn vswap vswap
        proc vswap {} {
            set v [pop [pop]]
            set x [pop]
            vpush $v
            push $x
        }
        defn vvswap vvswap
        proc vvswap {} {
            set a [pop [pop]]
            set b [pop [pop]]
            vpush $a
            vpush $b
        }
        
        # iterations : repeat $n times $f
        defn times times
        proc times {} {
            foreach {n f} [pop 2] {break}
            for {set i 0} {$i<$n} {incr i} {
                r $f
            }
        }
        
        defn vdup vdup
        proc vdup {} {
            set a [pop [pop]]
            vpush $a
            vpush $a
        }
        
        # ------ The dictionary has all one-liners:
        
        # pure-rpn commands
        
        def append swap ++
        def concat dup ++ itemdup dupd + swap ++ dup pick
        # concatenate two vectors into a list of two vectors
        def sconcat dup ++ itemdup dupd + 2 +
        # like sconcat, but with any number of vectors...
        def struct {{0 =} {drop sconcat} {drop sconcat -- swap drop} ifte} for
        def rows dupd dupd -- swap /
        def cons ++
        def vdrop dup 0 pick
        def vdup dup 0 range
        def vdupd dup ++ dup dup 2 + itemdup + swap range
        def even odd not
        def factorial {0 !=} {-- dup ++ dup -- {dupd * swap -- swap} times swap drop} (++) ifte
        def first dup itemdup swap {swap drop} times
        def gcd  swap {0 >} {swap dupd rem swap gcd} (drop) ifte
        def has -vswap in
        # matrix index : $row $col matindex
        def matindex swap 3 itemdup * + dupd swap - itemdup
        def matrix.colrange_asrows -regcheck dupd ssto - ++ ssto swap drop rswap {sget + matcol vvswap} for rdrop vdrop get matconcat
        def matrix.rowrange -regcheck dupd ssto - ++ ssto swap drop rswap {sget + matrow vvswap} for rdrop vdrop get matconcat
        def matrix.rowcolrange -regcheck sto sto matrix.rowrange get get matrix.colrange
        def matrix.colrange matrix.colrange_asrows transpose
        
        def matmul -regcheck rows sto vvswap rows sto vvswap sconcat dupt {
            sto rswap sget (_vmul) for get get swap sto drop
        } for vdrop get get swap sto dup get * ++
        # registers : rows1 rows2 index1 rows1
        def _vmul rswap sto vdup drop get matcol sconcat vvswap sget matrow vvswap vdrop vvswap drop vvswap vdrop _mulsum
        # registers : rows1 rows2 rows1 index1
        def _mulsum rswap vvmul -- (+) times dupd swap insert
        # rswap : swap the last two elements in the register stack
        def rswap get get swap sto sto
        def vvmul -regcheck dup ++ itempick dup sto {sget itemgrab *} foreach get
        def transpose dupd {matcol vvswap} for dupd -vswap vdrop matconcat
        def index ++ itemdup
        def vinsert dup dupt ++ {3 itemdup swap - 2 + itemdup swap ++ swap insert dup} for drop drop
        def newstack  c
        def odd  2 rem
        def of  swap at
        def product -- (*) times
        def rest dup dup pick --
        def vroll sconcat ssto itemdup sget + get swap move
        def roll dupt 3 itempick
        def sign {0 <} {drop -1} {{0 >} i} ifte
        def size dup 1 pick
        def sum  -- (+) times
        def -vswap dupd swap insert
        def xor  !=
        
        if 0 {Helper functions written in Tcl:}
        
        # matrix : bidimensional array
        # defn matrix rmatrix
        # proc rmatrix {} {eval push [from_matrix [pop]]}
        # vector : simple array (of doubles and ints)
        # defn vector rvector
        # proc rvector {} {eval push [from_vector [pop]]}
        # binary : binary string (char sequence)
        # defn binary rbinary
        # proc rbinary {} {eval push [from_binary [pop]]}
        
        
        # --------------- in/out tcl data
        proc from_vector {list} {
            lappend list [llength $list]
            return $list
        }
        proc from_matrix {list} {
            set out ""
            set rows [llength $list]
            set cols [llength [lindex $list 0]]
            foreach row $list {
                if {[llength $row] != $cols} {
                    return -code error -errorcode {RPN matrix} "rows may not have different lengths"
                }
                set out [concat $out $row]
            }
            return [concat $out $cols [expr {$rows * $cols + 1}]]
        }
        proc from_binary {value} {
            # value is supposed to be enclosed in parentheses
            # to prevent an arbitrary binary string to act like a command
            set value [string range $value 1 end-1]
            binary scan $value c* charlist
            set out ""
            foreach char $charlist {
                lappend out [expr {($char + 0x100)%0x100}]
            }
            lappend out [llength $out]
            set out
        }
        proc to_vector {} {
            return [pop [pop]]
        }
        proc to_matrix {} {
            foreach {cols len} [pop 2] {break}
            set out ""
            incr len -1
            set rows [expr {$len/$cols}]
            if {$rows * $cols != $len} {
                return -code error -errorcode {RPN matrix} "rows and columns numbers do not match"
            }
            for {set i 0} {$i < $rows} {incr i} {
                set out [linsert $out 0 [pop $cols]]
            }
            return $out
        }
        proc to_binary {} {
            set charlist [pop [pop]]
            set signed ""
            foreach char $charlist {
                # ensure it is a 'byte'
                set char [expr {$char & 0xff}]
                # convert unsigned chars to signed ones
                lappend signed [expr {($char & 0x80)? $char - 0x100 : $char}]
            }
            # value is supposed to be enclosed in parentheses
            # to prevent an arbitrary binary string to act like a command
            return [binary format c* $signed]
        }
        
        #------------------ Stack routines
        
        proc push args {
            variable S
            foreach a $args {lappend S $a}
        }
        proc pop {{len 1}} {
            if {$len>1} {
                return [npop $len]
            }
            Index 0
            variable S
            K [lindex $S end] [set S [lrange $S 0 end-1]]
            
        }
        proc K {a b} {set a}
        proc npop {len} {
            if {$len<2} {
                return -code error -errorcode {RPN stack} "vectors must have at least 2 elements"
            }
            Index [incr len -1]
            variable S
            K [lrange $S end-$len end] [set S [lreplace $S end-$len end]]
        }
        proc vpush {mylist} {
            set l [llength $mylist]
            foreach e $mylist {
                push $e
            }
            push $l
        }
        # get the end-index position in the stack
        proc Index {pos} {
            variable S
            if {[llength $S] <= $pos} {
                return -code error -errorcode {RPN stack} "stack underflow"
            }
            return [lindex $S end-$pos]
        }
        
        
        # ------------------------------ public procs
        namespace export r def d+ d-
    }
    
    #------------------------ The test suite:
    namespace import ::rpn::*
    
    proc ? {cmd expected} {
        if {[catch {uplevel 1 [string map [list CMD $cmd] {
                CMD
            }]
        } res]} {
            puts "$cmd->$res, not $expected"
        }
        if {[llength $res] == 0} {
            set res $::rpn::S
        }
        if {$res ne $expected} {puts "$cmd->$res, not $expected"}
    }
    def at dupd swap - ++ itemdup -vswap vdrop
    def of vswap at
    def sqr dup *
    def hypot sqr swap sqr + sqrt
    
    ? {r 2 3 +} 5
    ? {r 2 *}   10
    ? {r c 5 dup *} 25
    ? {r c 3 4 hypot} 5.0
    ? {r c vector {1 2 3} {dup *} vmap} {1 4 9 3}
    ? {r c vector {1 2 3}} {1 2 3 3}
    ? {r c vector {1 2 3} .v} {{1 2 3}}
    ? {r c vector {1 2 3} a append} {1 2 3 a 4}
    ? {r c a vector {1 2 3} cons} {a 1 2 3 4}
    ? {r c vector {1 2 3} vector {4 5 6} concat} {1 2 3 4 5 6 6}
    ? {r c vector {2 5 3} 0 (+) vfold} 10
    ? {r c vector {3 4 5} product} 60
    ? {r c vector {2 5 3} 0 {dup * +} vfold} 38
    ? {r c vector {1 2 3 4} vdup sum dupd double / swap {swap drop} times} 2.5
    ? {r c vector {1 2 3 4} (sum) {size double} cleave /} 2.5
    def if0 {1000 >} {2 /} {3 *} ifte
    ? {r c 1200 if0} 600
    ? {r c 600 if0}  1800
    ? {r c 42 sign}   1
    ? {r c 0 sign}     0
    ? {r c -42 sign} -1
    ? {r c 5 factorial} 120
    ? {r c 0 factorial} 1
    # some logic
    ? {r c 1 0 and} 0
    ? {r c 1 0 or}   1
    ? {r c 1 0 and not} 1
    # stack manipulation : vector commands
    ? {r c vector {1 2 3} hello -vswap} {hello 1 2 3 3}
    ? {r c vector {1 2 3} a append} {1 2 3 a 4}
    ? {r c a vector {1 2 3} cons} {a 1 2 3 4}
    ? {r c vector {1 2 3} first} 1
    ? {r c vector {1 2 3} rest} {2 3 2}
    # matrices...
    def mymatrix matrix {{1 2} {3 4} {5 6}}
    ? {r c mymatrix} {1 2 3 4 5 6 2 7}
    ? {r c mymatrix .m} {{{1 2} {3 4} {5 6}}}
    ? {r c mymatrix vdrop} {}
    ? {r c mymatrix 0 0 matindex .} 1
    ? {r c mymatrix 2 0 matindex .} 5
    ? {r c mymatrix 1 1 matindex .} 4
    # should put a warning ! -> index out of range
    ? {r c mymatrix 1 3 matindex .} 6
    ? {r c mymatrix 0 matrow .v} {{1 2}}
    ? {r c mymatrix 2 matrow .v} {{5 6}}
    ? {r c mymatrix 0 matcol .v} {{1 3 5}}
    ? {r c mymatrix 1 matcol .v} {{2 4 6}}
    # make a matrix out of vectors
    ? {r c vector {1 2 3} vector {4 5 6} 2 matconcat .m} {{{1 2 3} {4 5 6}}}
    # transpose a matrix
    ? {r c mymatrix 0 matcol vvswap 1 matcol vvswap vdrop 2 matconcat .m} {{{1 3 5} {2 4 6}}}
    ? {r c mymatrix vector {0 1} {matcol vvswap} foreach vdrop 2 matconcat .m} {{{1 3 5} {2 4 6}}}
    ? {r c mymatrix transpose .m} {{{1 3 5} {2 4 6}}}
    ? {r c matrix {{1 2 3 4 5} {6 7 8 9 10}} transpose .m} {{{1 6} {2 7} {3 8} {4 9} {5 10}}}
    # multiplies two matrices
    ? {r c matrix {{1 2} {3 4}} vdup matmul .m} {{{7 10} {15 22}}}
    ? {r c hello mymatrix vswap . .m} {hello {{1 2} {3 4} {5 6}}}
    ? {r c mymatrix hello -vswap .m .} {{{1 2} {3 4} {5 6}} hello}
    def mymatrix matrix {{1 2 3} {4 5 6} {7 8 9}}
    ? {r c mymatrix 0 1 matrix.colrange .m} {{{1 2} {4 5} {7 8}}}
    ? {r c mymatrix 0 1 matrix.colrange_asrows .m} {{{1 4 7} {2 5 8}}}
    ? {r c mymatrix 0 1 matrix.rowrange .m} {{{1 2 3} {4 5 6}}}
    ? {r c vector {6 1 5 2 4 3} {3 >} filter .v} {{6 5 4}}
    ? {r c 1 2 {+ 20 * 10 4 -} i} {60 6}
    ? {r c 42 ++} 43
    ? {r c 42 --} 41
    ? {r c vector {2 3 5 7} 2 at} 3
    ? {r c 2 vector {2 3 5 7} of} 3
    ? {r c 1 2 drop} 1
    ? {r c binary 'Aa'} {65 97 2}
    ? {r c binary 'Aa' .b} Aa
    ? {r c binary 'Aa' {3 +} vmap .b} Dd
    ? {r c binary 'A' swap 32 + ++ ++ swap .b} c
    ? {r c vector {1 2 3 4} reverse .v} {{4 3 2 1}}
    ? {r c 1 2 dupd} {1 2 1}
    ? {r c 6 9 gcd} 3
    ? {r c vector {1 2 3 4} (odd) split .v .v} {{1 3} {2 4}}
    ? {r c 1 vector {1 2 3} in} 1
    ? {r c 4 vector {1 2 3} in} 0
    ? {r c vector {1 2 3} 2 has} 1
    ? {r c vector {1 2 3} 5 has} 0
    ? {r c 3 4 max} 4
    ? {r c 3 4 min} 3
    ? {r c 0xff 128 bitand} 128
    ? {r c 0xff 134 bitand} 134
    ? {r c 0xff 134 bitor} 255
    ? {r c 134 0xff bitor} 255
    ? {r c 134 0xff bitxor} [expr {134^0xff}]
    ? {r c 134 0 bitxor} 134
    ? {r c 0xff bitcomp} [expr ~0xff]
    ? {r c 12 2 lshift} 48
    ? {r c 48 2 rshift} 12
    ? {r c 51 2 rshift} 12
    
    #-- Little dev. helper on the iPaq - short to type, tells the time
    
    interp alias {} s {} time {source rpn2006.tcl}
    
    #-- Useless if you have it into a versionning control system
    
    interp alias {} backup {} file copy -force rpn2006.tcl rpn.bak

See RPN, Pocket Joy 2005, TclMatrix3d.