FM - In the page a better way to do calculations, the discussion falls into how to improve the way we access data
I explored extensively the expr algorithm, while working on a Tcl mathematical shorthand. It gave me an idea : would-it be possible to create a specific language to access data in collections ? The answer is written below.
First, it is implemented in pure Tcl, but in modified version, which included an expr shorthand (see the page Mathematical calculation improvements for details).
It's using a similar algorithm than expr, adapted from C, and to this specific domain. The "tree" of operator nodes (in expr, it's a C-array of struct node operators) is modelized as a list of dicts.
I used variables in namespaces for definition and enumerations. There is three categories of lexem (UNARY, BINARY, LEAF). Lexem have precedence. The expr shorthand was of great help here. It allows to define these variable easily.
The key procedures are following the expr logic :
The idea is to be able to translate it later into C more easily
I used the exact same parsing algorithm (with MARK and PRECEDENCE) than the C procedure ParseExpr.
I used the exact same algorithm (a loop with MARK_LEFT, MARK_RIGHT, MARK_PARENT) than the C procedure CompileExprTree, but the commands are generated in Tcl. The idea is, once translate in C, to produce bytecode instead.
We can call it with a little proc that I named get. Its argument is array-like :
get var($index)
For the moment only selection of data in a variable is possible. But, in the future, it should be able to modify the content of the variable.
My focus has been centered around this two Tcl (scalar) collections
Actually, they are :
I was thinking eventually to add to this list :
Actually, they are :
Let's create a dict of dict
set L [dict create \
r0 [dict create c0 1 c1 2 c2 3]\
r1 [dict create c0 4 c1 5 c2 6]\
r2 [dict create c0 7 c1 8 c2 9]]
# we can do it also, using "tags", and no vars :
set L [get {(
"r0",("c0","1","c1","2","c2","3"),
"r1",("c0","4","c1","5","c2","6"),
"r2",("c0","7","c1","8","c2","9")
)}]L is like a matrix 3x3, 3 rows, 3 colons. Here is what it allows to write (in comment, the generated command)
# Imbrication simple :
get L(r0.c0); #OK
# dict get [dict get [set L] r0] c0
# 1
# Imbrication complexe à droite :
get L(r0.(c0,c1)); # OK
# list [dict get [dict get [set L] r0] c0] [dict get [dict get [set L] r0] c1]
# 1 2
# Imbrication complexe à gauche (get the first colon)
get L((r0,r1,r2).c0); #OK
# lmap e [list [dict get [set L] r0] [dict get [set L] r1] [dict get [set L] r2]] {dict get $e c0}
# 1 4 7
# Imbrication complexe à gauche et à droite :
get L((r0,r1).(c0,c1)); #OK
# lmap e [list [dict get [set L] r0] [dict get [set L] r1]] {list [dict get $e c0] [dict get $e c1]}
# {1 2} {4 5}
# Collection d'imbrications simples
get L(r0.c0,r1.c1,r2.c2); #OK
# list [dict get [dict get [set L] r0] c0] [dict get [dict get [set L] r1] c1] [dict get [dict get [set L] r2] c2]
# 1 5 9
# Collection d'imbrications complexe à droite
get L(r0.(c0,c1),r1.(c1,c2)); #OK
# list [list [dict get [dict get [set L] r0] c0] [dict get [dict get [set L] r0] c1]] [list [dict get [dict get [set L] r1] c1] [dict get [dict get [set L] r1] c2]]
# {1 2} {5 6}
# Collection d'imbrications complexes à gauche
get L((r0,r1).c0,(r0,r1).c2); #OK
# list [lmap e [list [dict get [set L] r0] [dict get [set L] r1]] {dict get $e c0}] [lmap e [list [dict get [set L] r0] [dict get [set L] r1]] {dict get $e c2}]
# {1 4} {3 6}
# Collection d'imbrications complexes à droite et à gauche
get L((r0,r1).(c0,c1),(r1,r2).(c1,c2)); NOK
# list [lmap e [list [dict get [set L] r0] [dict get [set L] r1]] {list [dict get $e c0] [dict get $e c1]}] [lmap e [list [dict get [set L] r1] [dict get [set L] r2]] {list [dict get $e c1] [dict get $e c2]]}
{{1 2} {4 5}} {{5 6} {8 9}}
# create list of dict from the dict
set ListOfDict [get L(r0,r1,r2)]
# list [dict get [set L] r0] [dict get [set L] r1] [dict get [set L] r2]
# {c0 1 c1 2 c2 3} {c0 4 c1 5 c2 6} {c0 7 c1 8 c2 9}
# create the dict of the transpose matrix (mixed dict / list access) :
get L(1.0,(0,r0.c0,2,r1.c0,4,r2.c0),1.2,(0,r0.c1,2,r1.c1,4,r2.c1),1.4,(0,r0.c2,2,r1.c2,4,r2.c2))
# list [lindex [lindex [set L] 1] 0] [list [lindex [set L] 0] [dict get [dict get [set L] r0] c0] [lindex [set L] 2] [dict get [dict get [set L] r1] c0] [lindex [set L] 4] [dict get [dict get [set L] r2] c0]] [lindex [lindex [set L] 1] 2] [list [lindex [set L] 0] [dict get [dict get [set L] r0] c1] [lindex [set L] 2] [dict get [dict get [set L] r1] c1] [lindex [set L] 4] [dict get [dict get [set L] r2] c1]] [lindex [lindex [set L] 1] 4] [list [lindex [set L] 0] [dict get [dict get [set L] r0] c2] [lindex [set L] 2] [dict get [dict get [set L] r1] c2] [lindex [set L] 4] [dict get [dict get [set L] r2] c2]]
# c0 {r0 1 r1 4 r2 7} c1 {r0 2 r1 5 r2 8} c2 {r0 3 r1 6 r2 9}
# Get the lexeme of the nodes array of last commands :
get N(0:end.lexeme)
# lmap e [lrange [set N] 0 end] {dict get $e lexeme}
# START DOT COMMA OPEN_PAREN COMMA DOT COMMA COMMA DOT COMMA COMMA DOT COMMA DOT COMMA OPEN_PAREN COMMA DOT COMMA COMMA DOT COMMA COMMA DOT COMMA DOT COMMA OPEN_PAREN COMMA DOT COMMA COMMA DOT COMMA COMMA DOT
# Imbrication of commands (unreadable)...
get N([get N([get N([get N([get N([get N([get N(0.right)].left)].left)].left)].left)].left)].(lexeme,left,right))
# dict get [lindex [set N] 0] right
# dict get [lindex [set N] 26] left
# dict get [lindex [set N] 24] left
# dict get [lindex [set N] 14] left
# dict get [lindex [set N] 12] left
# dict get [lindex [set N] 2] left
# list [dict get [lindex [set N] 1] lexeme] [dict get [lindex [set N] 1] left] [dict get [lindex [set N] 1] right]
# DOT -2 -2
# list of transposed matrix
set rows (r1,r2,r3)
get L($rows.c0,$rows.c1,$rows.c2)
{1 4 7) {2 5 8} {3 6 9}Ranges are not fully tested yet
Be aware that this code use an expr shorthand that you can find on github
namespace eval OT {(
KEY = -1;
INDEX = -2;
TOKEN = -3;
TAG = -4
)}
namespace eval lex {(
# Categories
NODE_TYPE = 0xC0;
BINARY = 64; # 0x40
UNARY = 128; # 0x80
LEAF = 192;
# Ambigous lexemes
PLUS = 1;
MINUS = 2;
BAREWORD = 3;
INCOMPLETE = 4;
INVALID = 5;
COMMENT = 6;
VARIABLE = 7;
SCRIPT = 8;
# leaf lexemes
NUMBER = $LEAF | 1;
QUOTED = $LEAF | 2;
KEY = $LEAF | 3;
EMPTY = $LEAF | 4;
INDEX = $LEAF | 5;
DBQUOTED = $LEAF | 6;
# unary operator lexemes
UNARY_PLUS = $UNARY | $PLUS;
UNARY_MINUS = $UNARY | $MINUS;
START = $UNARY | 4;
OPEN_PAREN = $UNARY | 5;
# binary operators lexemes
COMMA = $BINARY | 3; # collecting operator
DOT = $BINARY | 4; # nesting operator
CLOSE_PAREN = $BINARY | 5;
RANGE = $BINARY | 6; # range operator
END = $BINARY | 7;
)}
proc enum args {
set i 1
foreach e $args {
uplevel [list set ::$e $i]
incr i
}
}
enum MARK_LEFT MARK_RIGHT MARK_PARENT
namespace eval prec {(
END = i = 1;
START = [incr i];
CLOSE_PAREN = [incr i];
OPEN_PAREN = [incr i];
COMMA = [incr i];
DOT = [incr i];
RANGE = [incr i];
UNARY = [incr i];
[unset i];
)}proc ParseIndex {src {numBytes -1}} {
set ::TAGS [set ::INDEXES [set ::KEYS [set ::TOKENS [set ::NODES [set lexeme {}]]]]]
set i [set incomplete [set lastParsed [set nodesUsed 0]]]
# NB : Bug = call out of sequence
#[( ::INDEXES = ::KEYS = ::TOKENS = ::NODES = lexeme = "";)]
#[( i = incomplete = lastParsed = nodesUsed = 0; )]
set ::Node [dict create lexeme START \
precedence [precOf START] p {prev {} parent {}} mark $::MARK_RIGHT left {} right 1 constant 1\
string $src result [dict create left {} right {} imbrique {}] multiple [dict create left 0 right 0]]
lappend ::NODES $::Node
if {$numBytes == -1} {(
numBytes = [string length $src]
)}
incr nodesUsed
while (1) {
set k -1
if {$numBytes < 0} { return [set ::NODES] }
# Create one new node in case it's needed :
# One node has been used if the last parse gave an operator : then we have to create a new node.
# No node has been used if the last parse gave an operand : we can use the existing one (last member of the list).
if {$lastParsed >= 0} {
# lastParsed was not an operand, the last node were used by it
set ::Node [dict create lexeme {} precedence {} mark {} p {parent {} prev {}} left {} right {} constant 1\
result [dict create left {} right {} imbrique {}] multiple [dict create left 0 right 0]]
lappend ::NODES $::Node
}
[( scanned = [ParseAllWhiteSpace [list $src $i] $numBytes];
i = $i+$scanned;
numBytes = $numBytes-$scanned; )]
set scanned [ParseLexeme [list $src $i] lexeme literal $numBytes]
if { ([lexOf NODE_TYPE] & $lexeme) == 0} {
# Ambigous Lexeme
set lexName [lexOf $lexeme]
switch $lexName {
COMMENT {
set CommentLen [ParseComment [list $src $i]]
incr i $CommentLen
incr numBytes -$CommentLen
continue
} INVALID {
puts "error : invalid char"
break
} BAREWORD {
if {$literal eq "end"} {
# the bareword end indicate the end of a list
set lexeme [lexOf INDEX]
# Bug in Optimization of NOP and Jump List ?
# [( i = $i + $scanned; complete = lastParsed = ${::OT::INDEX};)]
} else {(
# Any other bareword indicate the key of a dict.
lexeme = [lexOf KEY]
)}
} PLUS - MINUS {
if {[isOperator $lastParsed]} {(
lexeme = $lexeme | $UNARY
)} else {
puts "error"
return
}
} VARIABLE {
# variable is Ambigous because it can return a integer (then it's an index), or a string (then it's a key)
# try to check the content of the variable to know what it is :
dict with [set d [ParseVariable [list $src $i] $numBytes]]
if {[string is int [set $varname]]} {
set lexeme [lexOf INDEX]
} else {
set lexeme [lexOf KEY]
}
} SCRIPT {
# Script is ambigous because it can return a integer (then it's an index), or a string (then it's a key)
# We can't check it now because this script may have side effects and we would not like to play them twice
# So, let's defere this evaluation to the compile step.
dict with [set d [ParseCommand [list $src $i] $numBytes]]
lappend ::TOKENS $command
set complete [set lastParsed ${::OT::TOKEN}]
}
}
}
# Handle lexeme based on its category.
set lexCategory [lexOf [(${::lex::NODE_TYPE} & $lexeme)] ]
set lexName [lexOf $lexeme]
switch $lexCategory {
LEAF {
# A leaf lexeme appearing just after something that is not an operator is a syntax error
if {![isOperator $lastParsed]} { puts "missing operator" }
switch $lexName {
NUMBER - INDEX {
# Index of a list
lappend ::INDEXES $literal
set complete [set lastParsed ${::OT::INDEX}]
incr i $scanned
incr numBytes -$scanned
continue
} DBQUOTED {
# tag is a name to be added as this (usefull to build data structure)
set d [ParseDbQuoted [list $src $i] $numBytes]
dict with d {}
lappend ::TAGS $dbQuoted
set complete [set lastParsed ${::OT::TAG}]
incr i $scanned
incr numBytes -$scanned
continue
} QUOTED {
# Key of a dict
set d [ParseQuoted [list $src $i] $numBytes]
dict with d {}
lappend ::KEYS $quoted
set complete [set lastParsed ${::OT::KEY}]
incr i $scanned
incr numBytes -$scanned
continue
} KEY {
lappend ::KEYS $literal
set complete [set lastParsed ${::OT::KEY}]
incr i $scanned
incr numBytes -$scanned
continue
}
}
} UNARY {
if {![isOperator $lastParsed]} {
puts "missing operator"
}
# Use the created OpNode for the unary operator
dict set ::Node lexeme $lexName
dict set ::Node precedence [precOf $lexName]
dict set ::Node mark $::MARK_RIGHT
dict set ::Node constant 1
dict set ::Node p [dict create prev $incomplete]
lset ::NODES end $::Node
[( incomplete = lastParsed = $nodesUsed ;)]
incr nodesUsed
} BINARY {
set precedence [precOf $lexName]
if {[isOperator $lastParsed]} {
set Node-- [lindex $::NODES end-1]
if {[dict get ${Node--} precedence] > $precedence} {
if {[dict get ${Node--} lexeme] eq "OPEN_PAREN"} {
puts "unbalanced open paren"
}
} elseif {$lexName eq "CLOSE_PAREN"} {
puts "unbalanced close paren"
} else {
puts "missing operand"
}
break
} else {
if {$lastParsed == ${::OT::TAG} &&
($lexName eq "DOT" || $lexName eq "RANGE")} {
puts stderr "Tag value not allowed with $lexName"
}
}
# Here is where the tree comes together :
set j 0
while 1 {
[( incompleteNode = [lindex $::NODES $incomplete] ;)]
if {[dict get $incompleteNode precedence] < $precedence} {
# shift => read next
break
}
if {[dict get $incompleteNode precedence] == $precedence} {
# special rules, if any
}
# case : [dict get $incompleteNode precedence] > $precedence
# reduce => try a deduction from the rule.
# deduce syntax error :
# Paren must balance :
if {([dict get $incompleteNode lexeme] eq "OPEN_PAREN")
&& ($lexName ne "CLOSE_PAREN")} {
puts stderr "unbalanced open paren"
break
}
# Attach complete tree as right operand of most recent incomplete tree
dict set incompleteNode right $complete
if {[isOperator $complete]} {
set completeNode [lindex $::NODES $complete]
dict set completeNode p parent $incomplete
lset ::NODES $complete $completeNode
dict set incompleteNode constant \
[( [dict get $incompleteNode constant] && [dict get $completeNode constant] )]
} else {
dict set incompleteNode constant \
[( [dict get $incompleteNode constant] && ($complete == ${::OT::INDEX} || $complete == ${::OT::KEY} || $complete == ${::OT::TAG}) )]
}
lset ::NODES $incomplete $incompleteNode
if {[dict get $incompleteNode lexeme] eq "START"} {
# done !
return
}
# For security
[( complete = $incomplete;
incomplete = [dict get $incompleteNode p prev] ;)]
if {[ dict get $incompleteNode lexeme] eq "OPEN_PAREN" } {
break
}
}
if {$lexName eq "CLOSE_PAREN"} {
if {[dict get $incompleteNode lexeme] ne "OPEN_PAREN"} {
puts stderr "Unbalanced close paren"
}
}
# No node for CLOSE_PAREN
if {$lexName ne "CLOSE_PAREN"} {
# Link complete tree as left operand of new node
dict set ::Node lexeme $lexName
dict set ::Node precedence $precedence
dict set ::Node mark $::MARK_LEFT
dict set ::Node left $complete
lset ::NODES end ${::Node}
if {[isOperator $complete]} {
set completeNode [lindex $::NODES $complete]
dict set completeNode p parent $nodesUsed
lset ::NODES $complete $completeNode
dict set ::Node constant \
[( [dict get $::Node constant] && ($complete == ${::OT::INDEX} || $complete == ${::OT::KEY} || $complete == ${::OT::TAG}) )]
} else {
dict set ::Node constant \
[( [dict get $::Node constant] && ($complete == ${::OT::INDEX} || $complete == ${::OT::KEY} || $complete == ${::OT::TAG}) )]
}
dict set ::Node p [dict create prev $incomplete]
lset ::NODES end ${::Node}
[( incomplete = lastParsed = $nodesUsed ;)]
incr nodesUsed
}
}
}
incr i $scanned
incr numBytes -$scanned
}
}
proc ParseLexeme {start lexeme literal {numBytes -1}} {
upvar $lexeme lex
upvar $literal lit
lassign $start src i
if {$numBytes <= 0} {( lex = [lexOf END]; [return 0] )}
set char [string index $src $i]
set res [switch $char {
, {( [lexOf COMMA], 1 )}
. {( [lexOf DOT], 1 )}
"(" {( [lexOf OPEN_PAREN], 1 )}
")" {( [lexOf CLOSE_PAREN], 1 )}
":" {( [lexOf RANGE], 1 )}
{[} {( [lexOf SCRIPT], 1 )}
' {( [lexOf QUOTED], 1 )}
{"} {( [lexOf DBQUOTED], 1 )}
+ {( [lexOf PLUS], 1 )}
- {( [lexOf MINUS], 1 )}
* {( [lexOf MULT], 1 )}
/ {( [lexOf DIVIDE], 1 )}
% {( [lexOf MOD], 1 )}
$ {( [lexOf VARIABLE], 1 )}
{#} {( [lexOf COMMENT], 1 )}
default {("")}
}]
if {$res ne ""} { return [lassign $res lex] }
set len 0
# Parse integer Number
while {[isNumber $char]} {(
len = $len+1;
char = [string index $src $i+$len];
(numBytes = $numBytes-1) < 0 ? [break]:;
)}
if {$len > 0} {(
lex = [lexOf NUMBER];
lit = [string range $src $i [($i+$len-1)]];
[return $len]
)}
# Parse bareword
while {[isBareword $char]} {(
len = $len+1;
char = [string index $src $i+$len];
(numBytes = $numBytes-1) < 0 ? [break]:;
)}
if {$len > 0} {(
lex = [lexOf BAREWORD];
lit = [string range $src $i [($i+$len-1)]];
[return $len]
)}
}
proc TclParseAllWhiteSpace {start numBytes} {
lassign $start expr i
while {$i < $numBytes} {
if {[string is space [lindex $expr $i]]} {
incr i
} else break
}
return $i
}
proc lexOf {{lex {}}} {
set D [join [namespace eval ::lex {
unset -nocomplain v;
lmap v [info vars] {(
$v, [set $v], [set $v], $v
)}
}]]
namespace eval ::lex {unset v}
dict get $D $lex
}
proc precOf {{lexName {}}} {
set D [join [namespace eval ::prec {
unset -nocomplain v;
lmap v [info vars] {(
$v, [set $v], [set $v], $v
)}
}]]
namespace eval ::prec {unset v}
dict get $D $lexName
}
proc ParseQuoted {src {numBytes -1}} {
[( numBytes = ($numBytes == -1 ? [string length $src] : $numBytes); )]
lassign $src src i
if {[string index $src $i] eq "'"} {
set k 1
set quoted {}
set char [string index $src [($i+$k)] ]
while {$char ne "'"} {
append quoted $char
[( (numBytes = $numBytes-1) <= 0 ? [break] :; )]
set char [string index $src [($i+(k=$k+1)]]
}
}
return [dict create quoted $quoted scanned [($k+1)] ]
}
proc ParseDbQuoted {src {numBytes -1}} {
[( numBytes = ($numBytes == -1 ? [string length $src] : $numBytes); )]
lassign $src src i
if {[string index $src $i] eq {"}} {
[( k=1;
dbQuoted="";
char=[string index $src [($i+$k)]]; )]
while {$char ne "\""} {
append dbQuoted $char
[( (numBytes = $numBytes-1) <= 0 ? [break] :; )]
set char [string index $src [( $i+(k=$k+1) )]]
}
}
return [dict create dbQuoted $dbQuoted scanned [($k+1)] ]
}
proc ParseAllWhiteSpace {start {numBytes -1}} {
[( numBytes = ($numBytes == -1 ? [string length $start] : $numBytes); )]
lassign $start src index
set i 0
while {[isSpace [string index $src $index+$i]]} {(
i=$i+1;
(numBytes = $numBytes-1) < 0 ? [break]:;
)}
return $i
}
proc isBareword {c} {(
$c ni [list + - * / % ' \" ( ) \{ \} . , \[ \] ~ & # @ ^ ` = $ ¨ ! : \; ? § ° | ]
&& ![isSpace $c]
)}
proc isSpace {c} {string is space $c}
proc isNumber {c} {($c in [list 0 1 2 3 4 5 6 7 8 9] )}
proc isOperator {lastparsed} {
if {$lastparsed < 0} {
return 0
} elseif {$lastparsed >= 0} {
return 1
}
}
proc CompileIndexTree {var {index 0}} {
set Node [lindex $::NODES $index]
[(indexOfIndex = indexOfKey = indexOfTag = 0; )]
set current $index
while 1 {
incr k
if {[dict get $Node mark] == $::MARK_LEFT} {
set next [dict get $Node left]
switch [dict get $Node lexeme] {
COMMA {
if {$next > 0} {
set leftNode [lindex $::NODES $next]
dict set leftNode result imbrique [dict get $Node result imbrique]
lset ::NODES $next $leftNode
}
} DOT {
if {$next > 0} {
set leftNode [lindex $::NODES $next]
dict set leftNode result imbrique [dict get $Node result imbrique]
lset ::NODES $next $leftNode
}
}
}
} elseif {[dict get $Node mark] == $::MARK_RIGHT} {
set next [dict get $Node right]
switch [dict get $Node lexeme] {
START {
dict set Node result imbrique [format {[set %s]} $var]
lset ::NODES $current $Node
if {$next > 0} {
set rightNode [lindex $::NODES $next]
dict set rightNode result imbrique [format {[set %s]} $var]
lset ::NODES $next $rightNode
}
}
OPEN_PAREN {
set rightNode [lindex $::NODES $next]
dict set rightNode result imbrique [dict get $Node result imbrique]
lset ::NODES $next $rightNode
}
DOT {
if {$next > 0} {
set rightNode [lindex $::NODES $next]
if {[dict get $rightNode lexeme] eq "OPEN_PAREN"} {
# Il faut passer la valeur obtenue a gauche :
if {[dict get $Node multiple left]} {
# Cas (a,b).(0,1) -> lmap e [list [dict get ... a] [dict get ... b] {list [lindex $e 0] [lindex $e 1]}
# Cas 0~end.0 -> lmap e [lrange ... 0 end] {lindex $e 0}
# Quand s'agit d'une valeur multiple, il faut utiliser "lmap e ...", donc on passe "$e"
dict set rightNode result imbrique \$e
} else {
# sinon on passe le resultat du noeud de gauche
# Cas 0.1 -> lindex [lindex ... 0] 1
dict set rightNode result imbrique [dict get $Node result left]
}
# dict set rightNode multiple left 1
} elseif {[dict get $rightNode lexeme] eq "RANGE"} {
if {[dict get $Node multiple left]} {
# Cas (a,b).(0,1) -> lmap e [list [dict get ... a] [dict get ... b] {list [lindex $e 0] [lindex $e 1]}
# Cas 0~end.0 -> lmap e [lrange ... 0 end] {lindex $e 0}
# Quand s'agit d'une valeur multiple, il faut utiliser "lmap e ...", donc on passe "$e"
dict set rightNode result imbrique \$e
} else {
# cas 0.0:end -> lrange [lindex ... 0] 0 end
dict set rightNode result imbrique [dict get $Node result left]
}
}
lset ::NODES $next $rightNode
}
} COMMA {
if {$next > 0} {
set rightNode [lindex $::NODES $next]
dict set rightNode result imbrique [dict get $Node result imbrique]
lset ::NODES $next $rightNode
}
}
}
} else {
# MARK_PARENT
switch [dict get $Node lexeme] {
START {
if {[dict exist $Node multiple] && [dict get $Node multiple right]} {
return "list [dict get $Node result right]"
} else {
set RES [dict get $Node result right]
if {[string index $RES 0] eq "\[" && [string index $RES end] eq "\]"} {
return [string range $RES 1 end-1]
} else {
return $RES
}
}
} OPEN_PAREN {
set parent [dict get $Node p parent]
set P [lindex $::NODES $parent]
set ParentLexeme [dict get $P lexeme]
switch $ParentLexeme {
"COMMA" {
if {$current == [dict get $P left]} {
dict set P result left [format {[list %s]} [dict get $Node result right]]
dict set P multiple left 0
} elseif {$current == [dict get $P right]} {
dict set P result right [format {[list %s]} [dict get $Node result right]]
dict set P multiple right 0
}
} "DOT" {
if {$current == [dict get $P left]} {
# multiple a gauche ?
if {[dict get $Node multiple right]} {
dict set P result left [format {[list %s]} [dict get $Node result right]]
} else {
dict set P result left [dict get $Node result right]
}
dict set P multiple left [dict get $Node multiple right]
} elseif {$current == [dict get $P right]} {
dict set P result right [dict get $Node result right]
dict set P multiple right [dict get $Node multiple right]
}
} default {
puts defaultCaseInOpenParenSwitch
}
}
lset ::NODES $parent $P
lset ::NODES $current $Node
} COMMA {
set parent [dict get $Node p parent]
set P [lindex $::NODES $parent]
set ParentLexeme [dict get $P lexeme]
set leftLexeme [( [dict get $Node left] > 0 ? [dict get [lindex $::NODES [dict get $Node left]] lexeme] : "" )]
set rightLexeme [( [dict get $Node right] > 0 ? [dict get [lindex $::NODES [dict get $Node right]] lexeme] : "" )]
switch $ParentLexeme {
"COMMA" {
# Cumulation, collection
if {$leftLexeme eq "RANGE"} {
if {$rightLexeme eq "RANGE"} {
dict set P result left [format {{*}%s {*}%s} [dict get $Node result left] [dict get $Node result right]]
set m 2
} else {
dict set P result left [format {{*}%s %s} [dict get $Node result left] [dict get $Node result right]]
set m 2
}
} elseif {$rightLexeme eq "RANGE"} {
dict set P result left [format {%s {*}%s} [dict get $Node result left] [dict get $Node result right]]
set m 2
} else {
dict set P result left [format {%s %s} [dict get $Node result left] [dict get $Node result right]]
set m 1
}
dict set P multiple left $m
}
"OPEN_PAREN" {
# Cumulation, collection
if {$leftLexeme eq "RANGE"} {
if {$rightLexeme eq "RANGE"} {
dict set P result right [format {{*}%s {*}%s} [dict get $Node result left] [dict get $Node result right]]
set m 2
} else {
dict set P result right [format {{*}%s %s} [dict get $Node result left] [dict get $Node result right]]
set m 2
}
} elseif {$rightLexeme eq "RANGE"} {
dict set P result right [format {%s {*}%s} [dict get $Node result left] [dict get $Node result right]]
set m 2
} else {
dict set P result right [format {%s %s} [dict get $Node result left] [dict get $Node result right]]
set m 1
}
dict set P multiple right $m
# Le caractère de multiplicite doit-il être traite differemment selon l'operateur ?
} "START" {
switch [dict get $Node multiple left][dict get $Node multiple right] {
00 - 10 - 01 - 11 {
dict set P result right [format {%s %s} [dict get $Node result left] [dict get $Node result right]]
}
}
dict set P multiple right 1
}
default {
puts defaultCaseInCOMMASwitch
}
}
lset ::NODES $parent $P
} RANGE {
set parent [dict get $Node p parent]
set P [lindex $::NODES $parent]
set ParentLexeme [dict get $P lexeme]
switch $ParentLexeme {
"START" {
dict set P result right [format {%s} [dict get $Node result right]]
dict set P multiple right 0
} "DOT" {
if {$current == [dict get $P left]} {
dict set P result left [dict get $Node result right]
dict set P multiple left 1
} elseif {$current == [dict get $P right]} {
dict set P result right [dict get $Node result right]
dict set P multiple right 1
}
} "OPEN_PAREN" {
dict set P result right [dict get $Node result right]
dict set P multiple right 1
} "COMMA" {
if {$current == [dict get $P left]} {
dict set P result left [dict get $Node result right]
dict set P multiple left 1
} elseif {$current == [dict get $P right]} {
dict set P result right [dict get $Node result right]
dict set P multiple right 1
}
}
}
lset ::NODES $parent $P
} DOT {
set Dot $Node
set parent [dict get $Dot p parent]
set P [lindex $::NODES $parent]
set ParentLexeme [dict get $P lexeme]
set left [dict get $Dot left]
set right [dict get $Dot right]
if {$left > 0} {set leftNode [lindex $::NODES $left]} else {set leftNode {}}
if {$right > 0} {set rightNode [lindex $::NODES $right]} else {set rightNode {}}
switch $ParentLexeme {
"START" {
if {$leftNode ne {} && [dict get $Dot multiple left]} {
if {$rightNode ne {} && [dict get $Dot multiple right]} {
if {[dict get $Dot multiple left]==2} {
dict set P result right [format {lmap e [list %s] {list %s}} [dict get $Dot result left] [dict get $Dot result right]]
} else {
dict set P result right [format {lmap e %s {list %s}} [dict get $Dot result left] [dict get $Dot result right]]
}
} else {
dict set P result right [format {%s} [dict get $Dot result right]]
}
} else {
if {$rightNode ne {} && [dict get $Dot multiple right]} {
dict set P result right [format {list %s} [dict get $Dot result right]]
} else {
dict set P result right [format {%s} [dict get $Dot result right]]
}
}
} "COMMA" {
if {$current == [dict get $P left]} {
if {$leftNode ne {} && [dict get $Dot multiple left]} {
if {$rightNode ne {} && [dict get $Dot multiple right]} {
dict set P result left [format {[lmap e %s {%s}]} [dict get $Dot result left] [string range [dict get $Dot result right] 1 end-1]]
} else {
dict set P result left [format {%s} [dict get $Dot result right]]
}
} else {
dict set P result left [dict get $Node result right]
}
} elseif {$current == [dict get $P right]} {
if {$leftNode ne {} && [dict get $Dot multiple left]} {
if {$rightNode ne {} && [dict get $Dot multiple right]} {
dict set P result right [format {[lmap e %s {%s}]} [dict get $Dot result left] [string range [dict get $Dot result right] 1 end-1]]
} else {
dict set P result right [format {%s} [dict get $Dot result right]]
}
} else {
dict set P result right [dict get $Node result right]
}
}
} "OPEN_PAREN" {
} "DOT" {
if {$current == [dict get $P left]} {
dict set P result left [format {%s} [dict get $Node result right]]
dict set P multipe left 0
} elseif {$current == [dict get $P right]} {
dict set P result right [format {%s} [dict get $Node result right]]
dict set P multipe right 0
}
}
}
lset ::NODES $parent $P
}
}
set parent [dict get $Node p parent]
set Node [lindex $::NODES $parent]
set current $parent
continue
}
set MARK [dict get $Node mark]; # we must save the current mark because we are using it after.
dict set Node mark [( $MARK +1 )]; # will be used in the next iteration
if {![dict exists $Node result left]} { dict set Node result left 0 }
if {![dict exists $Node result right]} { dict set Node result right 0 }
if {![dict exists $Node multiple left]} { dict set Node multiple left 0 }
if {![dict exists $Node multiple right]} { dict set Node multiple right 0 }
lset ::NODES $current $Node
switch $next {
-1 {# KEY
set key [lindex $::KEYS $indexOfKey]
if {[dict get $Node lexeme] eq "DOT" } {
if {$MARK == $::MARK_LEFT} {
set cmd [format {[dict get %s %s]} [dict get $Node result imbrique] $key]
dict set Node result left $cmd
dict set Node multiple left 0
} elseif {$MARK == $::MARK_RIGHT} {
if {[dict get $Node multiple left]} {
dict set Node result right \
[format {[lmap e %s {dict get $e %s}]} \
[dict get $Node result left] $key]
dict set Node multiple right 0; #?
} else {
dict set Node result right \
[format {[dict get %s %s]} [dict get $Node result left] $key]
dict set Node multiple right 0;
}
}
} elseif {[dict get $Node lexeme] eq "COMMA" } {
set cmd [format {[dict get %s %s]} [dict get $Node result imbrique] $key]
set ml 1
if {$MARK == $::MARK_LEFT} {
dict set Node result left $cmd
dict set Node multiple left $ml
} elseif {$MARK == $::MARK_RIGHT} {
dict set Node result right $cmd
dict set Node multiple right 0
}
} elseif {[dict get $Node lexeme] == "START" || [dict get $Node lexeme] == "OPEN_PAREN"} {
# START ou OPEN_PAREN with a constant key
dict set Node result right [format {[dict get %s %s]} [dict get $Node result imbrique] $key]
}
lset ::NODES $current $Node
incr indexOfKey
}
-2 {# INDEX
set index [lindex $::INDEXES $indexOfIndex]
if {[dict get $Node lexeme] eq "DOT"} {
if {$MARK == $::MARK_LEFT} {
dict set Node result left [format {[lindex %s %s]} [dict get $Node result imbrique] $index]
dict set Node multiple left 0
} elseif {$MARK == $::MARK_RIGHT} {
if {[dict get $Node multiple left]} {
dict set Node result right \
[format {[lmap e %s {lindex $e %s}]} \
[dict get $Node result left] $index]
dict set Node multiple right 0; #?
} else {
dict set Node result right \
[format {[lindex %s %s]} [dict get $Node result left] $index]
dict set Node multiple right 0;
}
}
lset ::NODES $current $Node
} elseif {[dict get $Node lexeme] eq "COMMA"} {
if {$MARK == $::MARK_LEFT} {
dict set Node result left [format {[lindex %s %s]} [dict get $Node result imbrique] $index]
dict set Node multiple left 1
} elseif {$MARK == $::MARK_RIGHT} {
dict set Node result right [format {[lindex %s %s]} [dict get $Node result imbrique] $index]
dict set Node multiple right 1
}
lset ::NODES $current $Node
} elseif {[dict get $Node lexeme] eq "RANGE"} {
if {$MARK == $::MARK_LEFT} {
dict set Node result left $index
} elseif {$MARK == $::MARK_RIGHT} {
set cmd [format {[lrange %s %s %s]} [dict get $Node result imbrique] [dict get $Node result left] $index]
# We are leaving the node :
dict set Node result right $cmd
dict set Node multiple right 1
}
lset ::NODES $current $Node
} elseif {[dict get $Node lexeme] == "START" || [dict get $Node lexeme] == "OPEN_PAREN"} {
# START ou OPEN_PAREN with a constant key
dict set Node result right [format {[lindex %s %s]} [dict get $Node result imbrique] $index]
dict set Node multiple right 0
}
incr indexOfIndex
}
-3 {# TOKEN
incr indexOfToken
}
-4 { # TAG
if {$MARK == $::MARK_LEFT} {
dict set Node result left [format {[set res "%s"]} [lindex $::TAGS $indexOfTag]]
dict set Node multiple left 0
} elseif {$MARK == $::MARK_RIGHT} {
dict set Node result right [format {[set res "%s"]} [lindex $::TAGS $indexOfTag]]
dict set Node multiple right 0
}
incr indexOfTag
}
default {
set Node [lindex $::NODES $next]
set current $next
}
}
if {$k > 200} {
puts "to much iteration"
break
}
}
}proc printTree {} {
set j -1
puts [dict get [lindex $::NODES 0] string]
foreach e $::NODES {
set left [switch [set left [dict get $e left]] {
-1 ("'Key'")
-2 ("'Index'")
-3 ("'Token'")
-4 ("'Tag'")
{} ("'None'")
default {("[dict get [lindex $::NODES $left] lexeme] $left")}
}]
set right [switch [set right [dict get $e right]] {
-1 {("'Key'")}
-2 {("'Index'")}
-3 ("'Token'")
-4 ("'Tag'")
{} {("'None'")}
default {("[dict get [lindex $::NODES $right] lexeme] $right")}
}]
set parent [switch [set parent [dict get $e p parent]] {
{} {("'None'")}
default {("[dict get [lindex $::NODES $parent] lexeme] $parent")}
}]
puts "[incr j] : lexeme = [dict get $e lexeme] / left : $left , right : $right , parent : $parent / imbrication : [dict get $e result imbrique] / multiplicite : [dict get $e multiple]"
puts "\t left result : [dict get $e result left]"
puts "\t right result : [dict get $e result right]"
}
}proc get {var} {
set open [string first ( $var]
set close [string last ) $var]
set index [string range $var $open+1 $close-1]
set var [string range $var 0 $open-1]
ParseIndex $index
set command [CompileIndexTree $var]
uplevel $command
}This example defines 3-coordinates vectors as a dict of dict. There is colon vectors and line vectors. The 3 colon names are c0,c1,c2. The 3 row names are r0,r1,r2
namespace eval matrix {
namespace ensemble create
namespace export *
}
namespace eval vector {
namespace ensemble create
namespace export *
}
proc vector::colFromList {L} {
get ("c0",("r0","[get L(0)]","r1","[get L(1)]","r2","[get L(2)]"))
}
proc vector::rowFromList {L} {
get ("r0",("c0","[get L(0)]","c1","[get L(1)]","c2","[get L(2)]"))
}
proc vector::asList {V} {
set key {}
if {[vector::check $V key]} {
switch $key {
c0 { #colon vector
return [get V(c0.(r0,r1,r2))]
}
r0 { #line vector
return [get V(r0.(c0,c1,c2))]
}
}
}}
proc vector::check {V {keys {}}} {
if {$keys ne {}} { upvar $keys k }
if {[catch {dict keys $V}]} {
error "vector '$V' doesn't look like a dict"
return 0
}
if {[llength [set k [dict keys $V]]] == 1} {
if {[llength [set l [dict keys [dict get $V $k]]]] != 3} {
error "bad number of keys for vector $V"
} else {
switch $k {
c0 {
if {$l ne {r0 r1 r2}} {
error "bad name of key '$l' in vector $V"
return 0
}
}
r0 {
if {$l ne {c0 c1 c2}} {
error "bad name of key '$l' in vector $V"
return 0
}
} default {
error "bad name of key '$k' in vector $V"
return 0
}
}
return 1
}
}
return 0
}
proc vector::type {V {k {}}} {
set key {}
vector::check $V key
return $key
}
proc vector::transpose {V} {
set key {}
if {[vector::check $V key]} {
switch $key {
r0 {
return [get V("c0",("r0",r0.c0,"r1",r0.c1,"r2",r0.c2))]
} c0 {
return [get V("r0",("c0",c0.r0,"c1",c0.r1,"c2",c0.r2))]
}
}
}
}
proc vector::scalar_product {U V} {
[( s = 0;
uK = vK = {} ;)]
if {[vector::check $U uK] && [vector::check $V vK]} {
foreach ku [dict keys [dict get $U $uK]] \
kv [dict keys [dict get $V $vK]] {(
s = $s + [get U($uK.$ku)] * [get V($vK.$kv)]
)}
return $s
}
}
proc vector::tensor_product {U V} {
if {[vector::check $U uK] && [vector::check $V vK]} {
set P {}
switch [list $uK $vK] {
{c0 c0} { set V [vector::transpose $V] }
{c0 r0} {}
{r0 r0} { set U [vector::transpose $U] }
{r0 c0} {
set U [vector::transpose $U]
set V [vector::transpose $V]
}
}
foreach k0 {r0 r1 r2} {
set m {}
foreach k1 {c0 c1 c2} {
lappend m $k1 [( [get U(c0.$k0)] * [get V(r0.$k1)] )]
}
lappend P $k0 $m
}
return $P
}
}
proc vector::cross_product {U V} {
if {[vector::check $U uK] && [vector::check $V vK]} {
switch [list $uK $vK] {
{c0 c0} {}
{c0 r0} { set V [vector::transpose $V] }
{r0 r0} {
set U [vector::transpose $U]
set V [vector::transpose $V]
}
{r0 c0} { set U [vector::transpose $U] }
}
lassign [get U(c0.(r0,r1,r2))] x y z
lassign [get V(c0.(r0,r1,r2))] X Y Z
return [( "c0",("r0",$y*$Z-$Y*$z, "r1", $z*$X-$x*$Z, "r2", $x*$Y-$y*$X))]
}
}
# Matrix as list
proc matrix::asList {M} {
set keys {}
if {[matrix::check $M keys]} {
switch $keys {
{r0 r1 r2} {
return [get M((r0,r1,r2).(c0,c1,c2))]
}
{c0 c1 c2} {
return [get M((c0,c1,c2).(r0,r1,r2))]
}
}
}
}
proc matrix::check {M {keys {}}} {
if {$keys ne {}} { upvar $keys k }
if {[catch {dict keys $M}]} {
error "matrix '$M' doesn't look like a dict"
return 0
}
if {[llength [set k [dict keys $M]]] == 3} {
foreach e $k {
if {[llength [set l [dict keys [dict get $M $e]]]] != 3} {
error "bad number of keys for matrix $M"
} else {
switch $e {
r0 - r1 - r2 {
if {$l ne {c0 c1 c2}} {
error "bad name of keys '$l' in matrix $M"
return 0
}
} c0 - c1 - c2 {
if {$l ne {r0 r1 r2}} {
error "bad name of keys '$l' in matrix $M"
return 0
}
} default {
error "bad name of keys '$l' in matrix $M"
return 0
}
}
}
}
return 1
}
}
# tests :
set U [vector::colFromList {1 2 3}]
# c0 {r0 1 r1 2 r2 3}
set V [vector::rowFromList {1 2 3}]
# r0 {c0 1 c1 2 c2 3}
vector::scalar_product $U $V
# 14
set M [vector::tensor_product $U $V]
# r0 {c0 1 c1 2 c2 3} r1 {c0 2 c1 4 c2 6} r2 {c0 3 c1 6 c2 9}
matrix::asList $M
# {1 2 3} {2 4 6} {3 6 9}
set W [vector::cross_product $U $V]
# c0 {r0 0 r1 0 r2 0}
vector::asList $W
# 0 0 0I'd like this proc to be able modify the variable. I think it is possible, since the order of elements is well defined.
I'd like to introduce basic arithmetic on indexes
I'd like to introduce basic regexp on keys.
I'd like to add test capabilities.
I expected I have shown that infixed notation could be very usefull to access parts of a complex data structure.
Every comments are welcomed.
FM (2026, august 6)
TIP 29 and TIP 22 may be concerned here.
If the set command were made to parse the index along the little language, as well as the $ substitution, some complains of these TIPs would be adressed :
# in TIP 29 :
# original (282 chars) :
proc shuffle1 { list } {
set n [llength $list]
foreach i [lseq $n] {
set j [expr {int(rand()*$n)}]
set temp [lindex $list $j]
set list [lreplace $list $j $j [lindex $list $i]]
set list [lreplace $list $i $i $temp]
}
return $list
}
# With index parsing and expr shorthand on foreach script (182 chars):
proc shuffle {list} {
set n [llength $list]
foreach i [lseq $n] {(
j = int(rand()*$n);
temp = $list($j);
list($j) = $list($i);
list($i) = $temp
)}
return $list
}
# in TIP 22
## Example 1
set A {{1 2 3} {4 5 6} {7 8 9}}
### originals
#### Historical way :
set p [expr {[lindex [lindex $A 2] 2] + [lindex [lindex $A 2] 2]}]; # 66 chars
# Improved way with nested index :
set p [expr {[lindex $A 2 2] + [lindex $A 2 2}]; # 47 chars
#### New way with index parsing and expr inlined shorthand :
set p [( $A(2.2) + $A(2.2) )]; # 29 chars
## Example 2
set pstruct {text {ignored-data { ... } validStyles {justifiction {left centered right full} font {courier helvetica times}}}}
### originals :
#### Historical
lrange [lindex [lindex [lindex $pstruct 1] 3] 3] 0 end-1; # 56 chars
lrange [dict [dict get [dict get $pstruct text] validStyles] font] 0 end-1; # 78 chars
#### With nested index
lrange [lindex $pstruct 1 3 3] 0 end-1; # 38 chars
lrange [dict get $pstruct text validStyles font] 0 end-1; # 56 chars
### New style with index parsing :
$pstruct(1.3.3.0:end-1); # 23 chars
$pstruct(text.validStyles.font.0:end-1); # 39 chars# 1. querying data
| with index language | classical command |
|---|---|
| set L(0) | lindex $L 0 |
| set D(key) | dict get $D key |
| set L(0.0) | lindex $L 0 0 |
| set D(style.font) | dict get $D style font |
| set L(0,1,2) | list [lindex $L 0] [lindex $L 1] [lindex $L 2] |
| set D(k1,k2) | list [dict get $D k1] [dict get $D k2 |
| set L(0.key) | dict get [lindex $L 0] key |
| set D(key.0) | lindex [dict get $D key] 0 |
| set L(0:3) | lrange $L 0 3 |
| set L(0:3,7:10) | list [lrange $L 0 3] [lrange $L 7 10] |
| set L(*0:3,*7:10) | list {*}[lrange $L 0 3] {*}[lrange $L 7 10] |
| set L((1,2).lexeme) | lmap e [list [lindex $L 1] [lindex $L 2] {dict get $e lexeme} |
| set L(1.(left,right)) | list [dict get [lindex $L 1] left] [dict get [lindex $L 1] right] |
| set L((1,2).(left,right)) | lmap e [list [lindex $L 1] [lindex $L 2] {list [dict get $e left] [dict get $e right]} |
# 2.Updating data
| with index language | classical command |
|---|---|
| set L(1,3) A B | lset L 1 A; lset L 3 B |
| set D(k1,k2) A B | dict set D k1 A; dict set D k2 B |
| set L(end+1) A B | lappend L A B |
| set L(-1) Z | lprepend L Z |
| set L((1,2).(left,right)) 3 4 5 6 | set D1 [lindex $L 1]; dict set D1 left 3; dict set D1 right 4; set D2 [lindex $L 2]; dict set D2 left 5; dict set D2 right 6; lset L 1 $D1; lset L 2 $D2 |
...
nem - 2026-08-10 15:07:31
It’s been a long time since I last browsed the wiki. It’s great to see people still making these kinds of radical experiments! Looks very interesting. Am I right that it requires that dict keys must be non-numeric to ensure distinction from list indices? I’m not sure if it’s a common case, but I have sometimes used integer keys in a dict (typically as a “sparse” list).
FM - 2026-08-10 15:07:31 Hi nem ! I read you a lot in the past 20 years
By default, numerics and end are taken as indexes. By default, barewords (except end) are taken as keys.
But the language established a way to force everything to be taken as a key : just put simple quotes around it :
get L(1); # access as a list
get D('1'); # access as a dict
get L(end); # access as a list
get D('end'); # access as a dict