Tcl's containers are very simple, but it is not distinguished mutually.
Although the advantage on code description also exists, it becomes a big fault at the time of file reading and the beginning.
kanryu I wrote a sample imprement as a library for internal expression for containers(dict/list). In the trial, It seems that it is operating well although the dump command of JSON form was mounted.
namespace eval ::huddler {
namespace export create list get gets strip llength keys jsondump
}
proc huddle {command args} {
switch $command {
list {
return [::huddler::listh {*}$args]
}
llength {
return [::huddler::llengthh {*}$args]
}
default {
return [::huddler::$command {*}$args]
}
}
}
proc ::huddler::isHuddler {args} {
if {[lindex $args 0] eq "HUDDLE" && [llength $args] == 2} {
return 1
} else {
return 0
}
}
proc ::huddler::create {args} {
if {[llength $args] % 2} {error {wrong # args: should be "dict create ?key value ...?"}}
set result {}
set resultL {}
foreach {key value} $args {
if [isHuddler {*}$value] {
set value [lindex $value 1]
lappend result $key $value
lappend resultL $key $value
set deep 1
} else {
lappend result $key $value
lappend resultL $key [list s $value]
}
}
if [info exists deep] {
set result [_wrap D $resultL]
} else {
set result [_wrap d $result]
}
return $result
}
proc ::huddler::listh {args} {
set result {}
set resultL {}
foreach {value} $args {
if [isHuddler {*}$value] {
set value [lindex $value 1]
lappend result $value
lappend resultL $value
set deep 1
} else {
lappend result $value
lappend resultL [list s $value]
}
}
if [info exists deep] {
set result [_wrap L $resultL]
} else {
set result [_wrap l $result]
}
return $result
}
proc ::huddler::strip {value} {
foreach {head value} $value break
switch $head {
HUDDLE {
return [strip $value]
}
D {
foreach {key val} $value {
lappend result $key [strip $val]
}
return $result
}
d { return $value }
L {
foreach {val} $value {
lappend result [strip $val]
}
return $result
}
l { return $value }
s { return $value }
default {
error "\{$src\} is not a huddler."
}
}
return $value
}
proc ::huddler::llengthh {src args} {
if {![isHuddler {*}$src]} {error "\{$src\} is not a huddler."}
return [llength [lindex [lindex $src 1] 1]]
}
proc ::huddler::keys {src args} {
if {![isHuddler {*}$src]} {error "\{$src\} is not a huddler."}
return [dict keys [lindex [lindex $src 1] 1]]
}
proc ::huddler::get {src args} {
if {![isHuddler {*}$src]} {error "\{$src\} is not a huddler."}
return [_get 0 [lindex $src 1] [llength $args] $args]
}
proc ::huddler::gets {src args} {
if {![isHuddler {*}$src]} {error "\{$src\} is not a huddler."}
return [_get 1 [lindex $src 1] [llength $args] $args]
}
proc ::huddler::_get {strip src len path} {
foreach {heads src} $src break
if {$len > 1} {
set headp [lindex $path 0]
set subpath [lrange $path 1 end]
incr len -1
switch $heads {
D {
return [_get $strip [dict get $src $headp] $len $subpath]
}
d {
return [dict get $src $path]
}
L {
return [_get $strip [lindex $src $headp] $len $subpath]
}
l {
return [lindex $src $path]
}
default {
error "\{$src\} is not a huddler."
}
}
}
switch $heads {
D {
return [_strip_wrap "" [dict get $src $path] $strip]
}
d {
return [_strip_wrap s [dict get $src $path] $strip]
}
L {
return [_strip_wrap "" [lindex $src $path] $strip]
}
l {
return [_strip_wrap s [lindex $src $path] $strip]
}
s {
return [_strip_wrap s $src $strip]
}
default {
error "\{$src\} is not a huddler."
}
}
}
proc ::huddler::type {src args} {
if {![isHuddler {*}$src]} {error "\{$src\} is not a huddler."}
return [_type 1 [lindex $src 1] [llength $args] $args]
}
proc ::huddler::_type {strip src len path} {
foreach {heads src} $src break
if {$len > 1} {
set headp [lindex $path 0]
set subpath [lrange $path 1 end]
incr len -1
switch $heads {
D {
return [_type $strip [dict get $src $headp] $len $subpath]
}
d {
return "string"
}
L {
return [_type $strip [lindex $src $headp] $len $subpath]
}
l {
return "string"
}
default {
error "\{$src\} is not a huddler."
}
}
}
switch $heads {
D {
return "dict"
}
d {
return "dict"
}
L {
return "list"
}
l {
return "list"
}
s {
return "string"
}
default {
error "\{$src\} is not a huddler."
}
}
}
proc ::huddler::_wrap {head src {striped 0}} {
if {$striped} {
return $src
} else {
if {$head ne ""} {
return [list HUDDLE [list $head $src]]
} else {
return [list HUDDLE $src]
}
}
}
proc ::huddler::_strip_wrap {head src {striped 0}} {
if {$striped} {
return [strip $src]
} else {
return [_wrap $head $src]
}
}
proc ::huddler::jsondump {data {offset ""}} {
set nextoff "$offset "
switch [huddle type $data] {
"string" {
set data [huddle strip $data]
if [regexp {^true$|^false$} $data] {return $data}
return "\"$data\""
}
"list" {
set inner {}
set len [huddle llength $data]
for {set i 0} {$i < $len} {incr i} {
set sub [huddle get $data $i]
lappend inner [jsondump $sub $nextoff]
}
return [join [list "\[\n" $nextoff [join $inner ",\n$nextoff"] "\n" $offset "\]"] ""]
}
"dict" {
set inner {}
foreach {key} [huddle keys $data] {
set val [jsondump [huddle get $data $key] $nextoff]
lappend inner "\"$key\": $val"
}
if {[llength $inner] == 1 && ![regexp {[\n\{\[]]} $array]} {
return "{ $array }"
}
return [join [list "\{\n" $nextoff [join $inner ",\n$nextoff"] "\n" $offset "\}"] ""]
}
default {
return $data
}
}
}