JMN 2006-10-21 'dictn' An experimental wrapper over dict - focused on nested dicts.
JEC 2010-6-17 The following is nice, but is there an 8.4 version available? I'm use the tclDict package https://wiki.tcl-lang.org/5042
The dictn package implements the same subcommands as dict, except wherever the dict function takes a 'key', dictn takes a list which is a 'path'.
For some subcommands such as 'replace' and 'remove' this allows operations at different nesting levels in a single call, without having to explicitly extract,update,repack.
As datastructures such as dict will presumably be used extensively and in code hotspots such as inner loops - the performance hit of a wrapper such as this may be an issue.
'dictn merge' not implemented. Presumably it would merge based on the longest key paths.. It looked a little tricky to implement.
e.g
%package require dictn
0.1
%set data [dictn create {slot1 item1} {a 0 b 1} {slot1 item2} {a 100 b 101} {slot2 item1 a} 3]
slot2 {item1 {a 3}} slot1 {item1 {a 0 b 1} item2 {a 100 b 101}}
%dictn replace $data slot2 was-slot-2-data {slot1 item1 a} AAA
slot2 was-slot-2-data slot1 {item1 {a AAA b 1} item2 {a 100 b 101}
%dictn incr data {slot1 item1 b} 100
slot2 {item1 {a 3}} slot1 {item1 {a 0 b 101} item2 {a 100 b 101}}
'dictn with' has an extra option to allow supply of the name of an array variable in which array keys are mapped to dict keys at the specified path. This is an alternative to auto-creating various variables (corresponding to possibly arbitrary dict keys) in the calling context.
e.g
%dictn with data {slot1 item1} info {parray info}
info(a) = 0
info(b) = 101Unsetting or changing an array element value will be reflected in the dict. Adding new elements to the array will not add them to the dict. The array is also not cleared prior to the call. I don't know if that's ideal - just the way it's done for this version. sqlite does something similar with it's 'db eval $sql arrayname $script' Perhaps here it would make more sense to automatically clear the array, and reflect any new values into the dict. (?)
It seems to me this wrapper can be used along side standard 'dict' calls on the same variable. So you could generally stick to standard dict, and just call this to avoid some extract,modify,repack situations. I'm assuming that using dictn like this isn't going to cause any shimmering/underlying rep problems - but I'll leave that for someone else to analyse at this stage.
Save as dictn-0.1.tm and place on the Tcl8.5+ module path.
#Julian Noble 2006
# - Experimental wrapper around 'dict' to provide consistent syntax for nested operations.
# - Lic: Freely distributable - same conditions as Tcl.
#
#
package provide dictn [namespace eval ::dictn {
variable version
namespace export append create exists filter for get incr info keys lappend merge remove replace set size unset update values with
namespace ensemble create
set version 0.1
}]
## ::dictn::append
#This can of course 'ruin' a nested dict if applied to the wrong element
# - i.e using the string op 'append' on an element that is itself a nested dict is analogous to the standard Tcl :
# %set list {a b {c d}}
# %append list x
# a b {c d}x
# IOW - don't do that unless you really know that's what you want.
#
proc ::dictn::append {dictvar path {value {}}} {
if {[llength $path] == 1} {
uplevel 1 [list dict append $dictvar $path $value]
} else {
upvar 1 $dictvar dvar
::set str [dict get $dvar {*}$path]
append str $val
dict set dvar {*}$path $str
}
}
proc ::dictn::create {args} {
::set data {}
foreach {path val} $args {
dict set data {*}$path $val
}
return $data
}
proc ::dictn::exists {dictval path} {
return [dict exists $dictval {*}$path]
}
proc ::dictn::filter {dictval path filterType args} {
::set sub [dict get $dictval {*}$path]
dict filter $sub $filterType {*}$args
}
proc ::dictn::for {keyvalvars dictval path body} {
::set sub [dict get $dictval {*}$path]
dict for $keyvalvars $sub $body
}
proc ::dictn::get {dictval {path {}}} {
return [dict get $dictval {*}$path]
}
proc ::dictn::incr {dictvar path {increment {}} } {
if {[llength $path] == 1} {
uplevel 1 [list dict incr $dictvar $path $increment]
} else {
upvar 1 $dictvar dvar
if {![string length $increment]} {
::set increment 1
}
::set newval [expr {[dict get $dvar {*}$path]} + $increment]
dict set dvar {*}$path $newval
return $dvar
}
}
proc ::dictn::info {dictval {path {}}} {
if {![string length $path]} {
return [dict info $dictval]
} else {
::set sub [dict get $dictval {*}$path]
return [dict info $sub]
}
}
proc ::dictn::keys {dictval {path {}} {glob {}}} {
::set sub [dict get $dictval {*}$path]
if {[string length $glob]} {
return [dict keys $sub $glob]
} else {
return [dict keys $sub]
}
}
proc ::dictn::lappend {dictvar path args} {
if {[llength $path] == 1} {
uplevel 1 [list dict lappend $dictvar $path {*}$args]
} else {
upvar 1 $dictvar dvar
::set list [dict get $dvar {*}$path]
::lappend list {*}$args
dict set dvar {*}$path $list
}
}
proc ::dictn::merge {args} {
error "nested merge not yet supported"
}
#dictn remove dictionaryValue ?path ...?
proc ::dictn::remove {dictval args} {
::set basic [list] ;#buffer basic (1element path) removals to do in a single call.
foreach path $args {
if {[llength $path] == 1} {
::lappend basic $path
} else {
#extract,modify,replace
::set subpath [lrange $path 0 end-1]
::set sub [dict get $dictval {*}$subpath]
::set sub [dict remove $sub [lindex $path end]]
dict set dictval {*}$subpath $sub
}
}
if {[llength $basic]} {
return [dict remove $dictval {*}$basic]
} else {
return $dictval
}
}
proc ::dictn::replace {dictval args} {
::set basic [list] ;#buffer basic (1element path) replacements to do in a single call.
foreach {path val} $args {
if {[llength $path] == 1} {
::lappend basic $path $val
} else {
#extract,modify,replace
::set subpath [lrange $path 0 end-1]
::set sub [dict get $dictval {*}$subpath]
::set sub [dict replace $sub [lindex $path end] $val]
dict set dictval {*}$subpath $sub
}
}
if {[llength $basic]} {
return [dict replace $dictval {*}$basic]
} else {
return $dictval
}
}
proc ::dictn::set {dictvar path newval} {
upvar 1 $dictvar dvar
return [dict set dvar {*}$path $newval]
}
proc ::dictn::size {dictval {path {}}} {
return [dict size [dict get $dictval {*}$path]]
}
proc ::dictn::unset {dictvar path} {
upvar 1 $dictvar dvar
return [dict unset dvar {*}$path
}
proc ::dictn::update {dictvar args} {
::set body [lindex $args end]
::set maplist [lrange $args 0 end-1]
upvar 1 $dictvar dvar
foreach {path var} $maplist {
if {[dict exists $dvar {*}$path]} {
uplevel 1 [list set $var [dict get $dvar $path]]
}
}
catch {uplevel 1 $body} result
foreach {path var} $maplist {
if {[dict exists $dvar {*}$path]} {
upvar 1 $var $var
if {![::info exists $var]} {
uplevel 1 [list dict unset $dictvar {*}$path]
} else {
uplevel 1 [list dict set $dictvar {*}$path [::set $var]]
}
}
}
return $result
}
proc ::dictn::values {dictval {path {}} {glob {}}} {
::set sub [dict get $dictval {*}$path]
if {[string length $glob]} {
return [dict values $sub $glob]
} else {
return [dict values $sub]
}
}
# Standard form:
#'dictn with dictVariable path body'
#
# Extended form:
#'dictn with dictVariable path arrayVariable body'
#
proc ::dictn::with {dictvar path args} {
if {[llength $args] == 1} {
::set body [lindex $args 0]
return [uplevel 1 [list dict with $dictvar {*}$path $body]]
} else {
upvar 1 $dictvar dvar
::lassign $args arrayname body
upvar 1 $arrayname arr
array set arr [dict get $dvar {*}$path]
::set prevkeys [array names arr]
catch {uplevel 1 $body} result
foreach k $prevkeys {
if {![::info exists arr($k)]} {
dict unset $dvar {*}$path $k
}
}
foreach k [array names arr] {
dict set $dvar {*}$path $k $arr($k)
}
return $result
}
}