dicttool

dicttool

Starting from tcllib 1.17, the dicttool package provides additional utilities on top of the regular dict package. One of these is the ability to recursively merge dictionaries. The version below adds the ability to append to list values during the merge. The option -restrict is a list of glob-style matching patterns that the names of the keys should match to be considered for list appending. By default, it will match any key name:

if {[::info commands ::tcl::dict::rlamerge] eq {}} {
  proc ::tcl::dict::_psearch { k ptns } {
    foreach p $ptns {
      if { [string match $p $k] } {
        return 1
      }
    }
    return 0
  }

  ###
  # title: A recursive form of dict merge
  # description:
  # A routine to recursively dig through dicts and merge
  # adapted from http://stevehavelka.com/tcl-dict-operation-nested-merge/
  # This appends to list values
  ###
  proc ::tcl::dict::rlamerge {args} {
    # Parse possible list of restricted keys to consider as lists
    if { [lindex $args 0] eq "-restrict" } {
      ::set restrictions [lindex $args 1]
      ::set a [lindex $args 2]
      ::set args [lrange $args 3 end]
    } else {
      ::set restrictions [list "*"]
      ::set a [lindex $args 0]
      ::set args [lrange $args 1 end]
    }


    ::set result $a
    # Merge b into a, and handle nested dicts appropriately
    ::foreach b $args {
      for { k v } $b {
        if {[string index $k end] eq ":"} {
          # Element names that end in ":" are assumed to be literals
          set result $k $v
        } elseif { [dict exists $result $k] } {
          # key exists in a and b?  let's see if both values are dicts
          # both are dicts, so merge the dicts
          if { [is_dict [get $result $k]] && [is_dict $v] } {
            set result $k [rlamerge -restrict $restrictions [get $result $k] $v]
          } elseif { [_psearch $k $restrictions] && [string is list [get $result $k]] && [string is list $v] } {
            lappend result $k {*}$v
          } else {  
            set result $k $v
          }
        } else {
          set result $k $v
        }
      }
    }
    return $result
  }
  namespace ensemble configure dict -map [dict replace\
      [namespace ensemble configure dict -map] rlamerge ::tcl::dict::rlamerge]
}

Here is a little example:

set a [dict create color green]
set b [dict create fruit pear]
set c [dict create color {red blue} fruit {apple orange}]

puts [dict print [dict rlamerge -restrict {fruit} $a $b $c]]