Back to the Chart of proposed set functionality.
See also a new proposed version SetOps, Code, 8.x v2
# --------------------------------------------- # SetOps -- Set operations for Tcl # # (C) c.l.t. community, 1999 # # $Id: 359,v 1.5 2003-09-18 08:00:06 jcw Exp $ # --------------------------------------------- # Implementation variant for tcl 8.x and beyond. # Uses namespaces. # --------------------------------------------- proc ::setops::create {args} { if {[llength $args] == 0} { return {} } foreach $args {.} {break} unset args info locals } proc ::setops::contains {set element} { expr {[lsearch -exact $set $element] < 0 ? 0 : 1} } proc ::setops::union {args} { switch [llength $args] { 0 { return {} } 1 { return [lindex $args 0] } default { foreach __SETA__ $args { if {[llength $__SETA__] > 0} { foreach $__SETA__ {.} {break} } } unset args __SETA__ info locals } } } proc ::setops::Intersect2 {__SETA__ __SETB__} { if {[llength $__SETA__] == 0} { return {} } if {[llength $__SETB__] == 0} { return {} } set __RESULT__ {} if {[llength $__SETA__] < [llength $__SETB__]} { foreach $__SETB__ {.} {break} foreach __ITEM__ $__SETA__ { if {[info exists $__ITEM__]} { lappend __RESULT__ $__ITEM__ } } } else { foreach $__SETA__ {.} {break} foreach __ITEM__ $__SETB__ { if {[info exists $__ITEM__]} { lappend __RESULT__ $__ITEM__ } } } return $__RESULT__ } proc ::setops::intersect {args} { switch [llength $args] { 0 { # Intersection of nothing is nothing return {} } 1 { return [lindex $args 0] } default { set res [lindex $args 0] set args [lrange $args 1 end] while {($res != {}) && ([llength $args] > 0)} { set res [Intersect2 $res [lindex $args 0]] set args [lrange $args 1 end] } return $res } } } proc ::setops::diff {__SETA__ __SETB__} { if {[llength $__SETA__] == 0} { return {} } if {[llength $__SETB__] == 0} { return $__SETA__ } set __RESULT__ {} foreach $__SETB__ {.} {break} foreach __ITEM__ $__SETA__ { if {![info exists $__ITEM__]} { lappend __RESULT__ $__ITEM__ } } return $__RESULT__ } proc ::setops::symdiff {a b} { diff [union $a $b] [Intersect2 $a $b] } proc ::setops::empty {set} { expr {[llength $set] == 0} }
The above code does not work if the set elements look syntactically like array variables. For example
setops::union {a b} {c b foo(local)}
returns
foo a b c
The problem is use of local variables (optimization) instead of an explicit array. Neat trick but doesn't quite work. APN