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
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 ==
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.