JMN 2006-10-21 'dictn' An experimental wrapper over dict - focused on nested dicts.
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.
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}}
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 {expand}$path]
append str $val
dict set dvar {expand}$path $str
}
}
proc ::dictn::create {args} {
::set data {}
foreach {path val} $args {
dict set data {expand}$path $val
}
return $data
}
proc ::dictn::exists {dictval path} {
return [dict exists $dictval {expand}$path]
}
proc ::dictn::filter {dictval path filterType args} {
::set sub [dict get $dictval {expand}$path]
dict filter $sub $filterType {expand}$args
}
proc ::dictn::for {keyvalvars dictval path body} {
::set sub [dict get $dictval {expand}$path]
dict for $keyvalvars $sub $body
}
proc ::dictn::get {dictval {path {}}} {
return [dict get $dictval {expand}$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 {expand}$path]} + $increment]
dict set dvar {expand}$path $newval
return $dvar
}
}
proc ::dictn::info {dictval {path {}}} {
if {![string length $path]} {
return [dict info $dictval]
} else {
::set sub [dict get $dictval {expand}$path]
return [dict info $sub]
}
}
proc ::dictn::keys {dictval {path {}} {glob {}}} {
::set sub [dict get $dictval {expand}$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 {expand}$args]
} else {
upvar 1 $dictvar dvar
::set list [dict get $dvar {expand}$path]
::lappend list {expand}$args
dict set dvar {expand}$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 {expand}$subpath]
::set sub [dict remove $sub [lindex $path end]]
dict set dictval {expand}$subpath $sub
}
}
if {[llength $basic]} {
return [dict remove $dictval {expand}$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 {expand}$subpath]
::set sub [dict replace $sub [lindex $path end] $val]
dict set dictval {expand}$subpath $sub
}
}
if {[llength $basic]} {
return [dict replace $dictval {expand}$basic]
} else {
return $dictval
}
}
proc ::dictn::set {dictvar path newval} {
upvar 1 $dictvar dvar
return [dict set dvar {expand}$path $newval]
}
proc ::dictn::size {dictval {path {}}} {
return [dict size [dict get $dictval {expand}$path]]
}
proc ::dictn::unset {dictvar path} {
upvar 1 $dictvar dvar
return [dict unset dvar {expand}$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 {expand}$path]} {
uplevel 1 [list set $var [dict get $dvar $path]]
}
}
catch {uplevel 1 $body} result
foreach {path var} $maplist {
if {[dict exists $dvar {expand}$path]} {
upvar 1 $var $var
if {![::info exists $var]} {
uplevel 1 [list dict unset $dictvar {expand}$path]
} else {
uplevel 1 [list dict set $dictvar {expand}$path [::set $var]]
}
}
}
return $result
}
proc ::dictn::values {dictval {path {}} {glob {}}} {
::set sub [dict get $dictval {expand}$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 {expand}$path $body]]
} else {
upvar 1 $dictvar dvar
::lassign $args arrayname body
upvar 1 $arrayname arr
array set arr [dict get $dvar {expand}$path]
::set prevkeys [array names arr]
catch {uplevel 1 $body} result
foreach k $prevkeys {
if {![::info exists arr($k)]} {
dict unset $dvar {expand}$path $k
}
}
foreach k [array names arr] {
dict set $dvar {expand}$path $k $arr($k)
}
return $result
}
}