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. It's combine with catch to supress the return call arranged by tailcall. It's a bit hacky, but it works, and the alternatives weren't that appealing.
PYK 2015-09-23: Update: Now that the procedure has been divided into nset and nset_internal, and alternative to catch {tailcall ...} would be to set the result in the local scope of nset.
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 nset data l 0 2 d name
To nset the same name:
nxs nset data l 0 2 d = name Vincentio
To nset the third item in a deeply nested list:
nxs nset data l 4 1 l = 2 newvalue
To replace the third item in a deeply nested list with three items that are expanded (i.e., the list more elements than it originally did) into the list:
nxs nset data l 4 1 l = 2 value1 value2 value3
To prepend multiple items to a deeply-nested list:
nxs nset data l 4 1 l = -1 value1 value2 valu3
To append three values to a deeply-nested list:
nxs nset data l 4 1 l = + value1 value2 valu3
To unset the fourth item in a deeply-nested list
nxs nset data l 4 1 l - 3
To unset range ranges of items in a deeply-nested list
nxs nset data l 4 1 l - {2 5} {7 10}A more recent version of this code may be available in ycl struct
#! /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 {{op name keys args} {
upvar 1 $name var
# If anything is to be set , there should , at the very least , be one
# value in $args
if {[llength $args]} {
set res {}
if {[llength $args] % 2 && [llength $keys]} {
set args [list [lindex $keys end] {*}$args]
set keys [lreplace $keys[set keys {}] end end]
}
foreach {key val} $args {
dict set var {*}$keys $key $val[::set val {}]
dict set res {*}$keys $key [dict get $var {*}$keys $key]
}
} else {
set res [dict get $var {*}$keys]
}
if {[info exists outer]} {
dict set outer {*}$keys $var
set var $outer
}
return $res
}}}
l {apply {{op 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 {
if {[llength $keys]} {
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
}
# No changes were made, so return nothing
}
}}}
}
variable unset {
d {apply {{op name keys} {
upvar 1 $name var
foreach key $keys {
dict unset var $key
}
return $var
}}}
l {apply {{op name indices} {
set res {}
upvar 1 $name var
foreach index $indices {
# Make sure to return the result as a list if a range was provided,
# or as single value if an index was provided
if {[llength $index] == 2} {
lassign $index[set index {}] first last
lappend res [lrange $var $first $last]
} else {
lappend res [lindex $var $index]
set first $index
set last $index
}
set var [lreplace $var[set var {}] $first $last]
}
if {[llength $res] == 1} {
set res [lindex $res[set res {}] end]
}
return $res
}}}
}
proc nget {struct args} {
nset struct {*}$args
}
variable doc::nset {
description {
Set and retrieve values in a nested heterogeneous structure .
}
args {
synopsis {
nset VARNAME ?KEYTYPE KEYS ARG ...?
nset VARNMAE ?KEYTYPE KEYS ARG ...? OPERATOR ?ARG ...?
}
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 is interpreted as if its items had
occurred as individual key arguments . If a KEYTYPTE is followed by
an OPERATOR , subsequent arguments are processed as defined for
that operator before the results are returned .
builtin key types
d
dictionary
operators
=
Values in the nested dictionary indicated by KEYS
are replaced by ARGS , which are alternating keys
and values . If there is an odd number of ARGS ,
the last item in KEYS becoms the first ARG .
-
Each ARG is a key to unset in the nested dictionary
indicated by KEYS .
l
list
operators
=
Arguments at even indices are ranges , while
arguments at odd indices are sets of values . Each
range is either a single index in which case the
following argument is a simple value , or two
indices indicating the first and last item to
operate on, and the following argument is a list of
values . For eaach index in a range , one value is
consumed from the corresponding set of values , and
placed in the list at that index . If the set of
values is larger than the range of indices ,
remaining values are placed in the list after the
last index in the range , increasing the size of
the list by the number of additional values. Each
range is calculated against the original list,
before the first change is made, and is adjusted as
changes occur so that it always refers to indices
relative to the original list.
-
Each argument is an index to unset . If the
argument is a two-items list , it is a range , as
described for [lrange] .
}
}
}
proc nset {name args} {
set nsetlevel -1
upvar 1 $name struct
nset_internal struct {*}$args
}
proc nset_internal {name args} {
upvar 1 nsetlevel nsetlevel
incr nsetlevel
variable set
variable unset
upvar 1 $name struct
set length [llength $args]
set args [lassign $args[set args {}] type keys]
if {[info exists struct]} {
set prevstruct $struct
}
if {$keys in {= -}} {
set op $keys
set args [lassign $args[set args {}] keys]
switch $op {
- {
set res [
{*}[dict get $unset $type] $op struct [list $keys {*}$args]]
}
= {
set res [{*}[dict get $set $type] $op struct $keys {*}$args]
}
}
catch {uplevel $nsetlevel [list ::tailcall lindex $res]}
} 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
}