Updated 2016-11-13 19:49:00 by AMG

AMG's [dictedit

AMG: Here is a full Tcl 8.4 implementation of [dict] that preserves key ordering. This code passes 261 out of the 317 tests in Tcl's dict test suite that existed at time of writing (2014-05-22).

A likely-faster implementation based on [array] is found below [1], but it doesn't implement as much of [dict] and does not preserve key ordering.

I say "likely-faster" because even though my code hasn't been benchmarked yet, it's probably slower than Anton Kovalenko's code due to thorough error checking, the frequent need to canonicalize dicts (remove duplicate keys), and the linear-time algorithms necessitated by the lack of hash tables.
# dict.tcl
# http://wiki.tcl.tk/10609
#
# Tcl 8.4-compatible implementation of the [dict] command.
#
# Known deficiencies:
# - In error messages, the variable name doesn't always appear correctly.  This
#   is due to use of [upvar] which renames the variable.
# - Tcl 8.4 offers no way for [return], [break], etc. inside the script to
#   affect the caller.  [uplevel] doesn't quite do everything that's needed.
# - Some usage error messages show different names for formal parameters.
# - Performance is reduced.
#
# Test failures (prefix each name with "dict-"):
# 3.12    4.5     5.7     9.7     9.8     11.15   12.7    12.8    12.10
# 13.7    13.8    13.9    14.1    14.2    14.3    14.4    14.12   14.13
# 14.22   15.9    15.10   15.11   16.8    16.9    16.17   16.18   17.13
# 17.16   17.18   21.1    21.2    21.3    21.4    21.13   21.14   21.15
# 22.1    22.2    22.3    22.10   22.14   22.15   23.1    23.2    24.1
# 24.2    24.3    24.4    24.12   24.13   24.20.1 24.21   24.24   24.25

# Only create [dict] command if it doesn't already exist.
if {[catch {dict get {}}]} {
    # Tcl 8.4-style implementation of namespace ensembles.
    namespace eval ::dict {}
    proc ::dict {subcommand args} {
        # Confirm $subcommand is a [dict] command or unambiguous prefix thereof.
        if {[regexp {[][*?\\]} $subcommand]
         || [llength [set command [info commands ::dict::$subcommand*]]] != 1} {
            set commands [string map {::dict:: {}}\
                    [lsort [info commands ::dict::*]]]
            if {[llength $commands] > 1} {
                lset commands end "or [lindex $commands end]"
            }
            if {[llength $commands] > 2} {
                set commands [join $commands ", "]
            } else {
                set commands [join $commands]
            }
            error "unknown or ambiguous subcommand \"$subcommand\":\
                    must be $commands"
        }

        # Invoke the command.
        if {[catch {uplevel 1 [concat [list $command] $args]} msg]} {
            # Rewrite the command name on error.
            regsub {^(wrong # args: should be \")::(dict)::} $msg {\1\2 } msg
            error $msg
        } else {
            return $msg
        }
    }

    # [dict append]
    proc ::dict::append {varName key args} {
        upvar 1 $varName var

        # Locate the matching key.  On match, append to the key's value.
        if {[::info exists var]} {
            ::set var [get $var]
            ::for {::set i 0} {$i < [llength $var]} {::incr i 2} {
                if {[lindex $var $i] eq $key} {
                    ::incr i
                    return [lset var $i [lindex $var $i][join $args {}]]
                }
            }
        }

        # On search failure, add the key to the dict.  This code also will
        # create the dict if it doesn't already exist.
        ::lappend var $key [join $args {}]
    }

    # [dict create]
    proc ::dict::create {args} {
        if {[llength $args] & 1} {
            error "wrong # args: should be \"dict create ?key value ...?\""
        }
        get $args
    }

    # [dict exists]
    proc ::dict::exists {dictionary key args} {
        # Traverse through nested dicts searching for matches.
        ::set sub $dictionary
        foreach key [concat [list $key] $args] {
            if {[llength $sub] & 1} {
                return 0
            }
            ::set match 0
            foreach {subkey sub} $sub {
                if {$subkey eq $key} {
                    ::set match 1
                    break
                }
            }
            if {!$match} {
                return 0
            }
        }
        return $match
    }

    # [dict filter]
    proc ::dict::filter {dictionary filterType args} {
        # Invoke the correct filter handler.
        ::set result {}
        switch $filterType {
        k - ke - key {
            # Filter on keys.
            foreach {key val} [get $dictionary] {
                foreach pattern $args {
                    if {[string match $pattern $key]} {
                        ::lappend result $key $val
                        break
                    }
                }
            }
        } v - va - val - valu - value {
            # Filter on values.
            foreach {key val} [get $dictionary] {
                foreach pattern $args {
                    if {[string match $pattern $val]} {
                        ::lappend result $key $val
                        break
                    }
                }
            }
        } s - sc - scr - scri - scrip - script {
            # Filter on script returning true.
            if {[llength $args] != 2} {
                error "wrong # args: should be \"dict filter dictionary script\
                        {keyVarName valueVarName} filterScript\""
            } elseif {[llength [lindex $args 0]] != 2} {
                error "must have exactly two variable names"
            }
            upvar 1 [lindex $args 0 0] key [lindex $args 0 1] val
            foreach {key val} [get $dictionary] {
                if {[uplevel 1 [lindex $args 1]]} {
                    ::lappend result $key $val
                }
            }
        } default {
            error "bad filterType \"$filterType\":\
                    must be key, script, or value"
        }}
        return $result
    }

    # [dict for]
    proc ::dict::for {keyVarValueVar dictionary script} {
        if {[llength $keyVarValueVar] != 2} {
            error "must have exactly two variable names"
        }

        # [foreach] does what's needed, mostly.  Tcl 8.4 offers no way for
        # [return], etc. inside the script to make the caller return.
        uplevel 1 [list foreach $keyVarValueVar [get $dictionary] $script]
    }

    # [dict get]
    proc ::dict::get {dictionary args} {
        if {[llength $args]} {
            # When given multiple arguments, traverse nested dicts to find the
            # requested key.  Fail if the key is not found.
            ::set sub $dictionary
            foreach key $args {
                if {[llength $sub] & 1} {
                    error "missing value to go with key"
                }
                ::for {::set i [expr {[llength $sub] - 2}]} {1} {::incr i -2} {
                    if {$i < 0} {
                        error "key \"$key\" not known in dictionary"
                    } elseif {[lindex $sub $i] eq $key} {
                        break
                    }
                }
                ::set sub [lindex $sub [expr {$i + 1}]]
            }
            return $sub
        } else {
            # With only one argument, convert that argument to a canonical dict.
            if {[llength $dictionary] & 1} {
                error "missing value to go with key"
            }
            ::for {::set i 0} {$i < [llength $dictionary]} {::incr i 2} {
                if {[::info exists indexes([lindex $dictionary $i])]} {
                    lset dictionary $indexes([lindex $dictionary $i])\
                            [lindex $dictionary [expr {$i + 1}]]
                    ::set dictionary [lreplace $dictionary $i [expr {$i + 1}]]
                    ::incr i -2
                } else {
                    ::set indexes([lindex $dictionary $i]) [expr {$i + 1}]
                }
            }
            return $dictionary
        }
    }

    # [dict incr]
    proc ::dict::incr {varName key {increment 1}} {
        upvar 1 $varName var

        # Disallow non-integer increments.
        if {![string is integer -strict $increment]} {
            error "expected integer but got \"$increment\""
        }

        # Locate the matching key and increment its value.
        if {[::info exists var]} {
            ::set var [get $var]
            ::for {::set i 0} {$i < [llength $var]} {::incr i 2} {
                if {$key eq [lindex $var $i]} {
                    ::incr i

                    # Disallow non-integer values.
                    if {![string is integer -strict [lindex $var $i]]} {
                        error "expected integer but got \"[lindex $var $i]\""
                    }

                    # Increment the value in place.
                    return [lset var $i [expr {[lindex $var $i] + $increment}]]
                }
            }
        }

        # On search failure, add the key to the dict.  This code also will
        # create the dict if it doesn't already exist.
        ::lappend var $key $increment
    }

    # [dict info]
    proc ::dict::info {dictionary} {
        # Make sure the dictionary is valid.
        if {[llength $dictionary] & 1} {
            error "missing value to go with key"
        }

        # No hash table.
        return "dict is represented as plain list"
    }

    # [dict keys]
    proc ::dict::keys {dictionary {pattern *}} {
        # Build and return a list of matching keys.
        ::set result {}
        foreach {key val} [get $dictionary] {
            if {[string match $pattern $key]} {
                ::lappend result $key
            }
        }
        return $result
    }

    # [dict lappend]
    proc ::dict::lappend {varName key args} {
        upvar 1 $varName var

        # Locate the matching key and append a list element to its value.
        if {[::info exists var]} {
            ::set var [get $var]
            ::for {::set i 0} {$i < [llength $var]} {::incr i 2} {
                if {$key eq [lindex $var $i]} {
                    ::incr i

                    # Disallow non-list values.
                    llength [lindex $var $i]

                    # Increment the value in place.
                    return [lset var $i [concat [lindex $var $i] $args]]
                }
            }
        }

        # On search failure, add the key to the dict.  This code also will
        # create the dict if it doesn't already exist.
        ::lappend var $key $args
    }

    # [dict map]
    proc ::dict::map {keyVarValueVar dictionary script} {
        # Confirm argument syntax.
        if {[llength $keyVarValueVar] != 2} {
            error "must have exactly two variable names"
        }

        # Link to local variables which will be used as iterators.
        upvar 1 [lindex $keyVarValueVar 0] key [lindex $keyVarValueVar 1] val

        # Accumulate and return the result.
        ::set result {}
        foreach {key val} [get $dictionary] {
            ::lappend result $key [uplevel 1 $script]
        }
        return $result
    }

    # [dict merge]
    proc ::dict::merge {args} {
        # Confirm each argument is a dict.
        foreach dict $args {
            if {[llength $dict] & 1} {
                error "missing value to go with key"
            }
        }

        # Merge the dicts, then normalize.
        get [eval [list concat] $args]
    }

    # [dict remove]
    proc ::dict::remove {dictionary args} {
        # Remove all dictionary keys matching any of the key arguments.
        ::set dictionary [get $dictionary]
        ::set args [lsort -unique $args]
        ::for {::set i 0} {$i < [llength $dictionary]} {::incr i 2} {
            ::set index [lsearch -exact -sorted $args [lindex $dictionary $i]]
            if {$index >= 0} {
                ::set dictionary [lreplace $dictionary $i [expr {$i + 1}]]
                ::set args [lreplace $args $index $index]
                if {![llength $args]} {
                    break
                }
                ::incr i -2
            }
        }
        return $dictionary
    }

    # [dict replace]
    proc ::dict::replace {dictionary args} {
        # Confirm correct argument parity.
        if {[llength $args] & 1} {
            error "wrong # args:\
                    should be \"dict replace dictionary ?key value ...?\""
        }

        # Concatenate the dicts then use [get] to canonicalize the result.
        get [eval [list concat $dictionary] $args]
    }

    # [dict set]
    proc ::dict::set {varName key args} {
        upvar 1 $varName var

        # Confirm that a value argument was given.
        if {![llength $args]} {
            error "wrong # args:\
                    should be \"dict set varName key ?key ...? value\""
        }

        # Default the dictionary to empty.
        if {![::info exists var]} {
            ::set var {}
        }

        # Shuffle the arguments into the right variables.
        ::set keys [concat [list $key] [lrange $args 0 end-1]]
        ::set val [lindex $args end]

        # Traverse through nested dicts to find the key to insert or replace.
        ::set path {}
        ::set sub $var
        ::for {::set i 0} {$i < [llength $keys]} {::incr i} {
            # Canonicalize each level of nested dicts.
            lset var $path [::set sub [get $sub]]

            # Search the current level to see if any keys match.
            ::for {::set j 0} {1} {::incr j 2} {
                if {$j >= [llength $sub]} {
                    # On match failure, move the remaining keys into the value,
                    # transforming it into a nested dict, then set that value.
                    ::set j [expr {[llength $keys] - 1}]
                    ::for {} {$j > $i} {::incr j -1} {
                        ::set val [list [lindex $keys $j] $val]
                    }
                    lset var $path [concat $sub [list [lindex $keys $i] $val]]
                    return $var
                } elseif {[lindex $sub $j] eq [lindex $keys $i]} {
                    # On match success, advance to the next level of nesting.
                    break
                }
            }

            # Descend into the value associated with the matching key.
            ::incr j
            ::lappend path $j
            ::set sub [lindex $sub $j]
        }

        # Replace the value of the matched key.
        lset var $path $val
    }

    # [dict size]
    proc ::dict::size {dictionary} {
        # Canonicalize the dict and return half its length.
        expr {[llength [get $dictionary]] / 2}
    }

    # [dict unset]
    proc ::dict::unset {varName key args} {
        upvar 1 $varName var

        # Handle the case of the dict not existing.
        if {![::info exists var]} {
            if {[llength $args]} {
                # Fail when unsetting a nested key.
                error "key \"$key\" not known in dictionary"
            } else {
                # Create the dict when unsetting a non-nested key.
                ::set var {}
                return
            }
        }

        # Traverse through nested dicts to find the key to remove.
        ::set keys [concat [list $key] $args]
        ::set path {}
        ::set sub $var
        ::for {::set i 0} {1} {::incr i} {
            # Canonicalize each level of nested dicts.
            lset var $path [::set sub [get $sub]]

            # Search the current level to see if any keys match.
            ::for {::set j 0} {$j < [llength $sub]} {::incr j 2} {
                if {[lindex $sub $j] eq [lindex $keys $i]} {
                    break
                }
            }

            # Handle outer and innermost nesting levels differently.
            if {$i < [llength $keys] - 1} {
                # In parent levels, search failure is an error.
                if {$j >= [llength $sub]} {
                    error "key \"[lindex $keys $i]\" not known in dictionary"
                }

                # Descend into the value associated with the matching key.
                ::incr j
                ::lappend path $j
                ::set sub [lindex $sub $j]
            } else {
                # In the innermost level, search failure is acceptable.  On
                # search success, remove the key, otherwise just ignore.
                if {$j < [llength $sub]} {
                    lset var $path [lreplace $sub $j [expr {$j + 1}]]
                }

                # Return the updated dictionary.
                return $var
            }
        }
    }

    # [dict update]
    proc ::dict::update {varName key valVarName args} {
        # Confirm argument parity.
        if {!([llength $args] & 1)} {
            error "wrong # args: should be \"dict update varName key valVarName\
                    ?key valVarName ...? script\""
        }
        ::set script [lindex $args end]

        # Convert the list of keys and variable names to an array.
        array set names [concat [list $key $valVarName] [lrange $args 0 end-1]]

        # Copy the dict values into the caller's variables.
        upvar 1 $varName dict
        foreach {key val} [get $dict] {
            if {[::info exists names($key)]} {
                upvar 1 $names($key) valVar
                ::set valVar $val
            }
        }

        # Invoke the caller-supplied script.
        ::set result [uplevel 1 $script]

        # If the dict is gone, let it stay gone.  Otherwise update it.
        if {[::info exists dict]} {
            # Update the dict values from the caller's variables, and remove
            # keys corresponding to unset variables.
            ::for {::set i 0} {$i < [llength $dict]} {::incr i 2} {
                if {[::info exists names([lindex $dict $i])]} {
                    upvar 1 $names([lindex $dict $i]) valVar
                    ::unset names([lindex $dict $i])
                    if {[::info exists valVar]} {
                        lset dict [expr {$i + 1}] $valVar
                    } else {
                        ::set dict [lreplace $dict $i [expr {$i + 1}]]
                        ::incr i -2
                    }
                }
            }

            # Add keys back to the dict from the caller's variables, in case the
            # caller removed some keys directly from the dict.
            foreach {key valVarName} [array get names] {
                upvar 1 $valVarName valVar
                if {[::info exists valVar]} {
                    ::lappend dict $key $valVar
                }
            }
        }

        # Return the result of the script.
        return $result
    }

    # [dict values]
    proc ::dict::values {dictionary {pattern *}} {
        # Build and return a list of matching values.
        ::set result {}
        foreach {key val} [get $dictionary] {
            if {[string match $pattern $val]} {
                ::lappend result $val
            }
        }
        return $result
    }

    # [dict with]
    proc ::dict::with {varName args} {
        upvar 1 $varName dict

        # Confirm a script argument was supplied.
        if {![llength $args]} {
            error "wrong # args:\
                    should be \"dict with varName ?key ...? script\""
        }
        ::set script [lindex $args end]
        ::set args [lrange $args 0 end-1]

        # Traverse through nested dicts to find the dict on which to operate.
        ::set path {}
        ::set sub [get $dict]
        foreach key $args {
            # Canonicalize each level of nested dicts.
            lset dict $path $sub

            # Search the current level to see if any keys match.
            ::for {::set i 0} {$i < [llength $sub]} {::incr i 2} {
                if {[lindex $sub $i] eq $key} {
                    break
                }
            }

            # Terminate on match failure.
            if {$i >= [llength $sub]} {
                error "key \"$key\" not known in dictionary"
            }

            # Descend into the value associated with the matching key.
            ::incr i
            ::set sub [get [lindex $sub $i]]
            ::lappend path $i
        }

        # Copy the dict values into the caller's variables.  Make an array to
        # keep track of all the keys in the dict.
        foreach {key val} $sub {
            upvar 1 $key valVar
            ::set valVar $val
            ::set keys($key) {}
        }

        # Invoke the caller-supplied script.
        ::set result [uplevel 1 $script]

        # If the dict is gone, let it stay gone.  Otherwise update it.
        if {[::info exists dict]} {
            # Traverse through nested dicts again in case the caller-supplied
            # script reorganized the dict.
            ::set path {}
            ::set sub [get $dict]
            foreach key $args {
                # Canonicalize each level of nested dicts.
                lset dict $path $sub

                # Search the current level to see if any keys match.
                ::for {::set i 0} {$i < [llength $sub]} {::incr i 2} {
                    if {[lindex $sub $i] eq $key} {
                        break
                    }
                }

                # Terminate on match failure.
                if {$i >= [llength $sub]} {
                    error "key \"$key\" not known in dictionary"
                }

                # Descend into the value associated with the matching key.
                ::incr i
                ::set sub [get [lindex $sub $i]]
                ::lappend path $i
            }

            # Update the dict values from the caller's variables, and remove
            # keys corresponding to unset variables.
            ::for {::set i 0} {$i < [llength $sub]} {::incr i 2} {
                if {[::info exists keys([lindex $sub $i])]} {
                    upvar 1 [lindex $sub $i] valVar
                    ::unset keys([lindex $sub $i])
                    if {[::info exists valVar]} {
                        lset sub [expr {$i + 1}] $valVar
                    } else {
                        ::set sub [lreplace $sub $i [expr {$i + 1}]]
                        ::incr i -2
                    }
                }
            }

            # Add keys back to the dict from the caller's variables, in case the
            # caller removed some keys directly from the dict.
            foreach key [array names keys] {
                upvar 1 $key valVar
                if {[::info exists valVar]} {
                    ::lappend sub $key $valVar
                }
            }

            # Save the updated nested dict back into the dict variable.
            lset dict $path $sub
        }

        # Return the result of the script.
        return $result
    }
}

# vim: set sts=4 sw=4 tw=80 et ft=tcl:

Anton Kovalenko's [dictedit

Anton Kovalenko: As I like the new dict command very much, I want to use it in all my new projects. But I don't want my programs to need tcl 8.5!

Here is a pure tcl emulation of dict command.

Vince -- this is very useful indeed. Thanks!

dict update, dict with, and dict map are not yet supported here. Any contributions?
# Poor man's dict -- a pure tcl [dict] emulation
# Very slow, but complete.
#
# Not all error checks are implemented!
# e.g. [dict create odd arguments here] will work
#
# Implementation is based on lists, [array set/get]
# and recursion

if {![llength [info commands dict]]} {
    proc dict {cmd args} {
        uplevel 1 [linsert $args 0 _dict_$cmd]
    }
    proc _dict_get {dv args} {
        if {![llength $args]} {return $dv} else {
            array set dvx $dv
            set key [lindex $args 0]
            set dv $dvx($key)
            set args [lrange $args 1 end]
            return [eval [linsert $args 0 _dict_get $dv]]
        }
    }
    proc _dict_exists {dv key args} {
        array set dvx $dv
        set r [info exists dvx($key)]
        if {!$r} {return 0}
        if {[llength $args]} {
            return [eval [linsert $args 0 _dict_exists $dvx($key) ]]
        } else {return 1}
    }
    proc _dict_set {dvar key value args } {
        upvar 1 $dvar dv
        if {![info exists dv]} {set dv [list]}
        array set dvx $dv
        if {![llength $args]} {
            set dvx($key) $value
        } else {
            eval [linsert $args 0 _dict_set dvx($key) $value]
        }
        set dv [array get dvx]
    }
    proc _dict_unset {dvar key args} {
        upvar 1 $dvar mydvar
        if {![info exists mydvar]} {return}
        array set dv $mydvar
        if {![llength $args]} {
            if {[info exists dv($key)]} {
                unset dv($key)
            }
        } else {
            eval [linsert $args 0 _dict_unset dv($key) ]
        }
        set mydvar [array get dv]
        return {}
    }
    proc _dict_keys {dv {pat *}} {
        array set dvx $dv
        return [array names dvx $pat]
    }
    proc _dict_append {dvar key {args}} {
        upvar 1 $dvar dv
        if {![info exists dv]} {set dv [list]}
        array set dvx $dv
        eval [linsert $args 0 append dvx($key) ]
        set dv [array get dvx]
    }
    proc _dict_create {args} {
        return $args
    }
    proc _dict_filter {dv ftype args} {
        set r [list]
        foreach {globpattern} $args {break}
        foreach {varlist script} $args {break}

        switch $ftype {
            key {
                foreach {key value} $dv {
                    if {[string match $globpattern $key]} {
                        lappend r $key $value
                    }
                }
            }
            value {
                foreach {key value} $dv {
                    if {[string match $globpattern $value]} {
                        lappend r $key $value
                    }
                }
            }
            script {
                foreach {Pkey Pval} $varlist {break}
                upvar 1 $Pkey key $Pval value
                foreach {key value} $dv {
                    if {[uplevel 1 $script]} {
                        lappend r $key $value
                    }
                }
            }
            default {
                error "Wrong filter type"
            }
        }
        return $r
    }
    proc _dict_for {kv dict body} {
        uplevel 1 [list foreach $kv $dict $body]
    }
    proc _dict_incr {dvar key {incr 1}} {
        upvar 1 $dvar dv
        if {![info exists dv]} {set dv [list]}
        array set dvx $dv
        if {![info exists dvx($key)]} {set dvx($key) 0}
        incr dvx($key) $incr
        set dv [array get dvx]
    }
    proc _dict_info {dv} {
        return "Dictionary is represented as plain list"
    }
    proc _dict_lappend {dvar key args} {
        upvar 1 $dvar dv
        if {![info exists dv]} {set dv [list]}
        array set dvx $dv
        eval [linsert $args 0 lappend dvx($key)]
        set dv [array get dvx]
    }
    proc _dict_merge {args} {
        foreach dv $args {
            array set dvx $dv
        }
        array get dvx
    }
    proc _dict_replace {dv args} {
        foreach {k v} $args {
            _dict_set dv $k $v
        }
        return $dv
    }
    proc _dict_remove {dv args} {
        foreach k $args {
            _dict_unset dv $k
        }
        return $dv
    }
    proc _dict_size {dv} {
        return [expr {[llength $dv]/2}]
    }
    proc _dict_values {dv {gp *}} {
        set r [list]
        foreach {k v} $dv {
            if {[string match $gp $v]} {
                lappend r $v
            }
        }
        return $r
    }
}

AMG: This code has numerous issues and shortcomings, though many of them are due to being implemented in terms of [array]. However, some things just baffle me. For example, what's this code supposed to do?
        foreach {globpattern} $args {break}

Why not just say set globpattern [lindex $args 0]?

28jan04 jcw - The "ihash" package in critlib [2] might be a way to get good performance (from C, i.e. with a Tcl extension, not a core change). See also the Adding a hashed datatype page where this extension is described in more detail.

RHS 20Sept2004 I included this code in the .tgz file for RHS's Bytecode Package. I wasn't sure who to ask about doing this, but I assumed it was ok, since its on the Wiki and my code is released open source (standard Tclish license). I made a note in the dict.tcl file that the code in that file is not copyrighted to me, and put a link to this page. If my including this file is an issue, let me know and I'll remove it.

AMG: See Who owns the content on this Wiki for more discussion on this subject.

PS's [dict updateedit

PS I created a dict package based on the current (Nov2005) code of Tcl 8.5, which has all the features and most of the performance of the real thing. See the dict page, search for 'tclDict'

Here's an ugly 'dict update' implementation. Any improvements?
proc _dict_update {dvar args} {
    set name [string map {: {} ( {} ) {}} $dvar]
    upvar 1 $dvar dv
    upvar 1 _my_dict_array$name local

    array set local $dv
    foreach {k v} [lrange $args 0 end-1] {
        if {[info exists local($k)]} {
            if {![uplevel 1 [list info exists $v]]} {
                uplevel 1 [list upvar 0 _my_dict_array${name}($k) $v]
            } else {
                uplevel 1 [list set $v $local($k)]
            }
        }
    }
    set code [catch {uplevel 1 [lindex $args end]} res]

    foreach {k v} [lrange $args 0 end-1] {
        if {[uplevel 1 [list info exists $v]]} {
            set local($k) [uplevel 1 [list set $v]]
        } else {
            unset -nocomplain local($k)
        }
    }
    set dv [array get local]
    unset local

    return -code $code $res
}