SArnold 2006-11-10 The implementation has continuations with no additional keyword, though no changes have been done to this pure-Tcl implementation.
BasicsThe 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 .sTo 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
RegistersYou 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 3ssto 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 commandsdef 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 7defn 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.bakSee RPN, Pocket Joy 2005, TclMatrix3d.
