nxs, by PYK, is a command that manipulates values in a Nested eXtensible heterogeneous data Structure.
nxs provides built-in handling for list and dictionary types. Other types of structures can be registered by adding command prefixes to $set and $get that provide the same semantics as the builtin types.
I struggled for a while to find some way to pass the extracted values back up through the recursive calls to nxs, and eventually came up with this strategy:
catch {uplevel $nsetlevel [list ::tailcall lindex $struct]}This takes advantage of a quirk of the implementation of tailcall, described on the uplevel page, where tailcall doesn't itself tear down the current level and replace it, but just calls return in the current level after arranging for it to be replaced upon return.
MS is probably going to have a seizure about the use of uplevel ... tailcall in working code, but hey, it works, and it's kind of neat.
nxs is included in ycl struct, along with a test suite that provides examples.
To extract the third item from the fifth list in the second list:
nxs get $data 1 4 2
#or
nxs get $data {1 4 2}To extract the first through third and fifth through seventh items from the fifth list in the second list:
nxs get $data 1 4 2 {{0 2} {4 6}}
#or
nxs get $data {1 4 2 {{0 2} {4 6}}}To look up a name in the third dictionary in the second list of dictionaries:
nxs get $data l 0 2 d name nxs set data l 0 2 d name
To set the same name:
nxs set data l 0 2 d name
To set the third item in a deeply nested list:
nxs set data l 4 1 = l 2 newvalue
To prepend three values as a single item to a deeply-nested list:
nxs set data l 4 1 * l -1 value1 value2 value3
To prepend multiple items to a deeply-nested list:
nxs set data l 4 1 * l -1 value1 value2 valu3
To append three values as a single item to a deeply-nested list:
nxs set data l 4 1 = l + value1 value2 valu3
To append three values as multiple items to a deeply-nested list
nxs set data l 4 1 * l + value1 value2 valu3
If there is more than one value to be set, the values are formed into a list, which is then set. The following two commands have the same effect:
nxs set data l 4 1 = l 2 [list newvalue newvalue2 newvalue3] nxs set data l 4 1 = l 2 newvalue newvalue2 newvalue3
To replace the third item in a deeply nested list with three items that are expanded into the list:
nxs set data l 4 1 * l 2 value1 value2 value3
#! /bin/env tclsh
if 0 {
Use {ycl ns dupensemble} to duplicate and specialize this namespace . To
add handlers for a new structure, choose an unused name add to $set and
$unset command prefixes conforming to the semantics of the built-in
handlers.
}
# When args is empty , set nothing , return the indicated indices .
# When args is a list containing only the empty string , set the specified
# items to the empty string
# When keys is empty , operate on the primary value
variable set {
d {apply {{name keys args} {
upvar 1 $name var
set res {}
if {[llength $args] % 2} {
set args [list [lindex $keys end] {*}$args]
set keys [lreplace $keys[set keys {}] end end]
}
if {[llength $keys] > 1} {
set outer $var
set var [dict get $outer[set var {}] {*}$keys]
dict set outer {*}$keys {}
}
if {$args eq {}} {
set res [dict get $var {*}$keys]
} else {
foreach {key val} $args {
dict set var $key $val[::set val {}]
dict set res $key [dict get $var $key]
}
}
if {[info exists outer]} {
dict set outer {*}$keys $var
set var $outer
}
return $res
}}}
l {apply {{name keys args} {
upvar 1 $name var
set keycount [llength $keys]
set valscount [llength $args]
set i 0
set lastval {}
if {[llength $args]} {
foreach key $keys val $args {
if {$i >= $valscount} {
set val $lastval
} else {
set lastval $val
}
if {[llength $key] == 2} {
lassign $key[set key {}] firstkey lastkey
} else {
set firstkey $key
set lastkey $key
}
if {$i == $keycount -1} {
set val [list $val {*}[lrange $args[set args {}] $i+1 end]]
if {$key eq {+}} {
lappend var {*}$val
} else {
set var [lreplace $var[set var {}] $firstkey $lastkey {*}$val]
}
} else {
if {$key eq {+}} {
lappend var $val
}
set var [lreplace $var[set var {}] $firstkey $lastkey $val]
}
incr i
if {$i >= $keycount} break
}
return $var
} else {
foreach key $keys {
if {[llength $key] == 2} {
lassign $key[set key {}] firstkey lastkey
lappend res [lrange $var $firstkey $lastkey]
} else {
lappend res [lindex $var $key]
}
}
if {[llength $res] == 1} {
set res [lindex $res[set res {}] 0]
}
return $res
}
}}}
}
variable unset {
d {apply {{name keys} {
upvar 1 $name var
foreach key $keys {
dict unset var $key
}
return $var
}}}
l {apply {{name indices} {
upvar 1 $name var
foreach index $indices {
if {[llength $index] == 2} {
lassign $index[set index {}] first last
} else {
set first $index
set last $index
}
set var [lreplace $var[set var {}] $first $last]
}
}}}
}
proc get {struct args} {
nset struct {*}$args
}
variable doc::set {
description {
Set and retrieve values in a nested heterogeneous structure .
}
args {
synopsis {
set varname ?KEYTYPE KEYS ...? ?OPERATOR KEYTYPE|ARGUMENT? ...
}
args {
Each key type is followed by a sequence keys indicating which nodes
to traverse , with the final key being itself a list of keys
indicating which items to select. If there is only one argument
between key types, that argument interpreted as if its items had
occurred as individual key arguments. The items specified by
theargumetns are returned. If an operator occurs in the position
of a key type , subsequent arguments are processed as defined for
that operator before the results are returned .
builtin key types
d
dictionary
operators
*
An alias for "="
=
If the key list is empty , the entire dictionary is
replaced . If the key listcontains exactly one
items and there is an odd number of subsequent
arguments , the items in the key list is
considered the first key , the next argument the
first value , and remaining arguments alternating
keys and values , which are all set in the
dictionary .
-
Each argument is a key in the dictionary to unset .
l
list
operators
=
The key list contains indices or ranges , as
describe for [lrange] , of items to replace .
If keylist is empty , the entire list is replaced .
If there is one argument , it is the value to be
set . If there are multiple arguments , they
constitute a list , which becomes the value to be
set . If the key list is empty , the entire
list is replaced with the value . Each index or
range consumes one argument , and the final index
or range consumes the remaining arguments .
*
Like "=" , but each argument becomes an additional
value in the modified list , in the same fashion as
with the {*} Tcl operator . This replacement
happens individually for each index in KEYLIST. The
selection is finalized before any replacement is
performed , and as replacement proceeds , the
remaining selections are adjusted so that the
replacement affects values indicated by the index
before the beginning of the entire operation . If
there are no values , the selected items in are
removed from the list .
-
Each argument is an index to unset . If the
argument is a two-items list , it is a range , as
described for [lrange] .
}
}
}
variable nsetlevel -1
proc nset {name args} {
variable nsetlevel
incr nsetlevel
variable set
variable unset
upvar $name struct
set length [llength $args]
set args [lassign $args[set args {}] type keys]
set prevstruct $struct
if {$type in {= * -}} {
set op $type
set type $keys
set args [lassign $args[set args {}] keys]
switch $op {
- {
{*}[dict get $unset $type] struct [list $keys {*}$args]
}
= - * {
if {[llength $args] == 1} {
set args [lindex $args[set args {}] 0]
}
if {$keys eq {}} {
set struct $args
} else {
if {$op eq {=}} {
# Encapsulate $args in a list in order to provide the
# semantics of "=", as opposed to "*" .
set args [list $args[set args {}]]
}
{*}[dict get $set $type] struct $keys {*}$args
}
}
}
} elseif {$args == 1} {
tailcall [lindex [info level 0] 0] $name $type $keys = {*}$args
} else {
while {[llength $args] > 0 && [lindex $args 0] ni {= * -}
&& ![dict exists $set [lindex $args 0]]} {
# Must be another key
set args [lassign $args[set args {}] key]
lappend keys $key
}
if {[llength $keys] > 1} {
set keys [lassign $keys[set keys {}] key1]
# Expand key here so that in the future , multiple branches can
# be manipulated .
set struct [{*}[dict get $set $type] prevstruct {*}$key1]
#Reduce the reference count of the Tcl_Obj behind $struct
{*}[dict get $set $type] prevstruct {*}$key1
set oldnsetlevel $nsetlevel
set nsetlevel -1
set struct2 [[lindex [info level 0] 0] struct $type $keys {*}$args]
set nsetlevel $oldnsetlevel
catch {uplevel $nsetlevel [list ::tailcall lindex $struct2]}
{*}[dict get $set $type] prevstruct $key1 $struct
set struct $prevstruct[set prevstruct $struct; list]
} else {
set struct [{*}[dict get $set $type] prevstruct $keys]
#Reduce the reference count of the Tcl_Obj behind $struct
{*}[dict get $set $type] prevstruct $keys {}
if {[llength $args]} {
[lindex [info level 0] 0] struct {*}$args
} else {
catch {uplevel $nsetlevel [list ::tailcall lindex $struct]}
}
{*}[dict get $set $type] prevstruct $keys $struct
set struct $prevstruct[set prevstruct $struct; list]
}
}
incr nsetlevel -1
return $prevstruct
}