Back to the [Chart of proposed set functionality]. # --------------------------------------------- # SetOps -- Set operations for Tcl # # (C) c.l.t. community, 1999 # # $Id: 358,v 1.3 2003-03-21 09:00:45 jcw Exp $ # --------------------------------------------- # Implementation variant for tcl 7.6 and below. # It looks as if the procedures would use namespaces, # but they don't. For 7.6 the '::'s are just part of # the procedure name. It is especially not possible # to use the internal procedures in a shortcut manner # (without preceding ::setops::). # --------------------------------------------- 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 [::setops::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} { ::setops::diff [::setops::union $a $b] [::setops::Intersect2 $a $b] } proc ::setops::empty {set} { expr {[llength $set] == 0} } ---- !!!!!! %| [Category Package] |% !!!!!!