#JMN 2004
#public domain


package provide patternlib [namespace eval patternlib {

	variable version
	set version 1.2.6
}]



#Change History
#-------------------------------------------------------------------------------
#2022-05
# added . search and . itemKeys methods to >collection to enable lookups by value
#2021-09
# Add >keyvalprotector  - an object to overload various collection methods such as 'remove' to stop deletion of specific items.
#
#2006-05
# deprecate 'del' in favour of 'remove' - 'del' still there but delegated to 'remove'. todo - emit deprecation warnings.
#
#2005-04
# remove 'name' method - incorporate indexed retrieval into 'names' method
# !todo? - adjust key/keys methods for consistency?
#
#2004-10
# initial key aliases support 
# fix negative index support on some methods e.g remove
#2004-08
# separated >collection predicate methods out onto separate 'mixin' object >predicatedCollection
# added $posn $result variables to predicate methods, changed varnames from $k $v to $key $value
#
#2004-06-05
# added 'sort' method to sort on values.
# fixed 'keySort' method to accept multiple sort options
# added predicate methods 'all' 'allKeys' 'collectAll'
#2004-06-01
# '>collection . names' method now accepts optional 'glob' parameter to filter result
#2004-05-19
#fix '>collection . clear' method so consecutive calls don't raise an error
#-------------------------------------------------------------------------------

namespace eval ::patternlib::util {
    proc package_require_min {pkg minver} {
        if {[package vsatisfies [lindex [set available [lsort -increasing [package versions $pkg]]] end] $minver-]} {
            package require $pkg
        } else {
            error "Package pattern requires package $pkg of at least version $minver. Available: $available"
        }
    }
    
    #bloom filter experiment https://wiki.tcl-lang.org/page/A+Simple+Bloom+Filter
    # k-hashes
    # m-bits
    # n-elements
    # optimal value of k: (m/n)ln(2)
    #proc bloom_optimalNumHashes {capacity_n bitsize_m} {
    #    expr { round((double($bitsize_m) / $capacity_n) * log(2))}
    #}
    #proc bloom_optimalNumBits {capacity fpp} {
    #    expr {entier(-$capacity * log($fpp) / (log(2) * log(2)))}
    #}
    
}
::patternlib::util::package_require_min pattern 1.2.4
#package require pattern
::pattern::init ;# initialises (if not already)


namespace eval ::patternlib {namespace export {[a-z]*}
	namespace export {[>]*}

	variable keyCounter 0  ;#form part of unique keys for collections when items added without any key specified
	proc uniqueKey {} {
		return [incr  ::patternlib::keyCounter]
	}

#!todo - multidimensional collection
# 	- o_list as nested list 
#   - o_array with compound keys(?) how will we unambiguously delimit dimensions in a concatenated key?
#   - perhaps a key is always a list length n where n is the number of dimensions?
#   - therefore we'll need an extra level of nesting for the current base case n=1
#
#	- how about a nested dict for each key-structure (o_list & o_array) ?

#COLLECTION
#
#!todo? - consider putting the actual array & list vars in the objects namespace, and using the instancevars to hold their names
# - consider array-style access using traced var named same as collection.
# would this defeat the purpose ? if it was faster, would users always use array syntax in preference.. in which case they may as well just use arrays..?
#!todo - add boolean property to force unique values as well as keys


#::pattern::create >collection 




::>pattern .. Create >collection
set COL >collection
#process_pattern_aliases [namespace origin >collection]
#process_pattern_aliases ::patternlib::>collection
$COL .. Property version 1.0 
$COL .. PatternDefaultMethod item

set PV [$COL .. PatternVariable .]

$PV o_data
#$PV o_array
#$PV o_list
$PV o_alias
$PV this

#for invert method
$PV o_dupes 0


$COL .. PatternProperty bgEnum


#PV o_ns

$PV m_i_filteredCollection

#set ID [lindex [set >collection] 0 0]   ;#context ID
#set IID [lindex [set >collection] 1 0]  ;#level 1 base-interface ID

$COL .. Constructor {args} {
    var o_data m_i_filteredCollection o_count o_bgEnum

    var this
    set this @this@

    set m_i_filteredCollection 0
    if {![llength $args]} {
        set o_data [dict create]
        #array set o_array	[list]
        #set o_list		[list]
        set o_count 0
    } elseif {[llength $args] == 1} {
        set o_data [dict create]
        set pairs [lindex $args 0]
        if {[llength $pairs] % 2} {
            error "patternllib::>collection - if an argument given to constructor, it must have an even number of elements. Bad args: $args"
        }
        set keys_seen [list]
        foreach key [dict keys $pairs] {
            if {[string is integer -strict $key] } {
                error ">collection key must be non-integer. Bad key: $key. No items added."
            }
            if {$key in $keys_seen} {
                error "key '$key' already exists in this collection. No items added."
            }
            lappend keys_seen $key
        }
        unset keys_seen
        #rely on dict ordering guarantees (post 8.5? preserves order?)
        set o_data [dict merge $o_data[set o_data {}] $pairs]
        set o_count [dict size $o_data]
    } else {
        error "patternlib::>collection constructor did not understand arguments supplied. Try a dict as a single argument."
    }
    array set o_alias	[list]

    array set o_bgEnum [list]
    @next@
}
#comment block snipped from collection Constructor
    #---------------------------------------------
    #set o_selfID [lindex [set $o_this] 0]  ;#object id always available in methods as $_ID_ anyway
    #
    #### OBSOLETE - left as example of an approach
    #make count property traceable (e.g so property ref can be bound to Tk widgets)	
    #!todo - manually update o_count in relevant methods faster??
    # should avoid trace calls for addList methods, shuffle etc 
    #
    #set handler ::p::${_ID_}::___count_TraceHandler
    #proc $handler {_ID_ vname vidx op} {
    #	#foreach {vname vidx op} [lrange $args end-2 end] {break}
    #	#! we shouldn't trust this vname - it may be that we are being accessed via upvar so it is a different name
    #	
    #	#this is only a 'write' handler
    #	set ::p::[lindex ${_ID_} 0 0]::o_count [llength [set ::p::[lindex ${_ID_} 0 0]::o_list]]
    #	return
    #}
    #trace add variable o_list {write} [list $handler $_ID_]
    ####
    #
    #
    #puts "--->collection constructor id: $_ID_"




set PM [$COL .. PatternMethod .]


#!review - why do we need the count method as well as the property?
#if needed - document why.
# read traces on count property can be bypassed by method call... shouldn't we avoid that?
#2018 - in theory write traces on the . count property are very useful from an application-writer's perpective.
#
$COL .. PatternMethod count {} {
    #we don't require any instance vars to be upvar'ed - argless [var] stops them automatically being added.
    #we directly refer to the ::O:: var if only accessing a few times rather than upvar'ing.
    var o_data
    dict size $o_data	
}

$COL .. PatternProperty count
$COL .. PatternPropertyWrite count {_val} {
    var
    error "count property is read-only"
}

$COL .. PatternPropertyUnset count {} {
    var
} ;#cannot raise error's in unset trace handlers - simply fail to unset silently

$COL .. PatternMethod isEmpty {} {
    #var o_list
    #return [expr {[llength $o_list] == 0}]
    var o_data
    expr {[dict size $o_data] == 0}
}

$COL .. PatternProperty inverted 0



######
# item
######
#defaults to fifo when no idx supplied (same as 'pair' method). !review? is lifo more logical/intuitive/useful?
# i.e [>obj . item] returns the 1st element in the list
#[>obj . item -1] returns the last element (equiv to "end" keyword used by Tcl list commands)
#[>obj . item -2] returns 2nd last element (equiv to "end-1")


$COL .. PatternMethod item {{idx 0}} {
    #with pattern::0::$OID access.. was measured  faster than item2 : approx 110us vs 140us for 26element collection accessed via string (time {>col $key} 10000)
    # (still at least 20 times slower than a plain array... at <5us)
    var o_data o_alias

    #!todo - review 'string is digit' vs 'string is integer' ??
    if {[string is integer -strict $idx]} {
        if {$idx < 0} {
            set idx "end-[expr {abs($idx + 1)}]"
        }
        set keys [dict keys $o_data]
        if {[catch {dict get $o_data [lindex $keys $idx]} result]} {
            var this
            error "no such index : '$idx' in collection: $this"
        } else {
            return $result	
        }
    } else {
        if {[catch {dict get $o_data $idx} result]} {
            if {[catch {set o_alias($idx)} nextIdx ]} {
                var this
                error "no such index: '$idx' in collection: $this"
            } else {
                #try again 
                #return $o_array($nextIdx)
                #tailcall?
                #item $_ID_ $nextIdx
                #puts stdout "\n\n\n !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! about to call tailcall item $_ID_ $nextIdx \n\n\n"
                tailcall item $_ID_ $nextIdx
            }
        } else {
            return $result	
        }
    }
}



if {0} {
#leave this here for comparison.
$COL .. PatternMethod item2 {{idx 0}} {
    var o_array o_list o_alias this

    if {[string is integer -strict $idx]} {
        if {$idx < 0} {
            set idx "end-[expr {abs($idx + 1)}]"
        }

        if {[catch {set o_array([lindex $o_list $idx])} result]} {
            error "no such index : '$idx' in collection: $this"
        } else {
            return $result	
        }
    } else {
        if {[catch {set o_array($idx)} result]} {

            if {[catch {set o_alias($idx)} nextIdx ]} {
                error "no such index: '$idx' in collection: $this"
            } else {
                #try again 
                #return $o_array($nextIdx)	
                item $_ID_ $nextIdx
            }
        } else {
            return $result	
        }
    }

}
}

#simple no-frills access for speed.. (timed at 43us vs 63us for item (depending on dispatch method!))
$COL .. PatternMethod itemNamed {idx} {
    var o_data
    dict get $o_data $idx
}
$COL .. PatternMethod in {idx} {
    var o_data
    dict get $o_data $idx
}

$COL .. PatternMethod itemAt {idx} {
    var o_data
    dict get $o_data [lindex [dict keys $o_data] $idx]
}

$COL .. PatternMethod replace {idx val} {
    var o_data o_alias this

    if {[string is integer -strict $idx]} {
        if {$idx < 0} {
            set idx "end-[expr {abs($idx + 1)}]"
        }

        if {[catch {dict set o_data [lindex [dict keys $o_data] $idx] $val}]} {
            error "no such index: '$idx' in collection: $this"
        } else {
            return $val
        }
    } else {
        if {[catch {dict set o_data $idx $val}]} {
            if {[catch {set o_alias($idx)} nextIdx ]} {
                error "no such index: '$idx' in collection: $this"
            } else {
                #try again
                tailcall replace $_ID_ $nextIdx $val
            }

        } else {
            return $val
        }
    }
}

#if the supplied index is an alias, return the underlying key; else return the index supplied.
$COL .. PatternMethod realKey {idx} {
    var o_alias

    if {[catch {set o_alias($idx)} key]} {
        return $idx
    } else {
        return $key
    }
}

#note alias feature is possibly ill-considered.
#if we delete an item - should we delete corresponding alias? If not - we then would need to allow adding under an alias only if the corresponding key is missing.
$COL .. PatternMethod alias {newAlias existingKeyOrAlias} {
    var o_alias

    #set existingKey [realKey $_ID_ $existingKeyOrAlias]
    #alias to the supplied KeyOrAlias - not the underlying key

    if {[string is integer -strict $newAlias]} {
        error "collection key alias cannot be integer"
    }

    if {[string length $existingKeyOrAlias]} {
        set o_alias($newAlias) $existingKeyOrAlias
    } else {
        unset o_alias($newAlias)
    }
}
$COL .. PatternMethod aliases {{key ""}} {
    var o_alias

    if {[string length $key]} {
        set result [list]
        #lsearch -stride?
        foreach {n v} [array get o_alias] {
            if {$v eq $key} {
                lappend result $n $v
            }
        }		

        return $result
    } else {
        return [array get o_alias]
    }
}

#'pop' & 'unshift' methods !todo - optimize so lsearch not called when numerical idx/posn already supplied

#default to removing item from the end, otherwise from supplied index (position or key)
#!todo - accept alias indices
#!todo - review.. should any corresponding alias be destroyed when the corresponding item is popped (or removed in any way?)
#!todo - review.. for performance.. shouldn't pop NOT accept an index? 
#if we need to pop from other than the end.. this could be a separate function. Do other langs use pop with an index??
$COL .. PatternMethod pop {{idx ""}} {
    var o_data o_count

    if {$idx eq ""} {
        set key [lindex [dict keys $o_data] end]
    } else {
        if {[string is integer -strict $idx]} {
            set key [lindex [dict keys $o_data] $idx]
        } else {
            set key $idx
        }
    }
    set posn [lsearch -exact [dict keys $o_data] $key]

    if {($posn >= 0) && ($posn < [dict size $o_data])} {
        set result [dict get $o_data $key]
        dict unset o_data $key
        set o_count [dict size $o_data]
        return $result
    } else {
        error "no such index: '$idx'"
    }
}
$COL .. PatternMethod poppair {} {
    var o_data o_count
    set key [lindex [dict keys $o_data] end]
    set val [dict get $o_data $key]
    dict unset o_data $key
    set o_count [dict size $o_data]
    return [list $key $val]
}



#!todo - add 'push' method... (basically specialized versions of 'add')
#push - add at end (effectively an alias for add)
#shift - add at start   ???bad name? this is completely at odds with for example the common Perl shift function, which returns and removes the first element of an array.
#add - add at end

#ordered
$COL .. PatternMethod items {} {
    var o_data

    dict values $o_data
}




####
#pair
####
#fifo-style accesss when no idx supplied (likewise with 'add' method)
$COL .. PatternMethod pair {{idx 0}} {
    var o_data

    if {[string is integer -strict $idx]} {
        set key [lindex [dict keys $o_data] $idx]
    } else {
        set key $idx
    }

    if {[catch {dict get $o_data $key} val]} {
        error "no such index: '$idx'"
    } else {
        return [list $key $val]
    }
}
$COL .. PatternMethod pairs {} {
    var o_data
    set o_data
}

$COL .. PatternMethod get {} {
    var o_data
    set o_data
}
#todo - fix >pattern so that methods don't collide with builtins
#may require change to use oo - or copy 'my' mechanism to call own methods
$COL .. PatternMethod Info {} {
    var o_data
    return [dict info $o_data]
}
#2006-05-21.. args to add really should be in key, value order?
# - this the natural order in array-like lists
# - however.. key should be optional.

$COL .. PatternMethod add {val args} {
    #(using args instead of {key ""} enables use of empty string as a key )

    var o_data o_alias o_count  this

    if {![llength $args]} {
        set key "_[::patternlib::uniqueKey]_"
    } else {
        #!todo - could we handle multiple val,key pairs without impacting performance of the common case?
        if {[llength $args] > 1} {
            error "add method expected 'val' and optional 'key' - got: $val $args"

        }

        set key [lindex $args 0]
        if {[string is integer -strict $key]} {
            error ">collection key must be non-numeric. Other structures such as >hashMap allow user specified integer keys"
        }
    }

    if {[dict exists $o_data $key]} {
        #error "key $key already exists in collection [set ::p::[lindex ${_ID_} 0 0]::this]"
        error "key '$key' already exists in collection $this"
    }
    if {[info exists o_alias($key)]} {
      if {[dict exists $o_data $o_alias($key)]} {
            #only disallow adding via the alias if there is an existing o_data element for the key pointed to by the alias
            error "key '$key' already exists as an alias for $o_alias($key) in collection $this"
        }
    }

    dict set o_data $key $val


    set posn $o_count
    incr o_count

    return $posn
}


#should the 'stack' methods such as shift,push,pop,peek actually be on a separate interface?
#what then of methods like 'count' which apply equally well to collections and stacks?

#Alias for 'add' - is there a way to alias this to add implementation with zero overhead??
$COL .. PatternMethod push {val args} {
    #(using args instead of {key ""} enables use of empty string as a key )

    var o_data o_alias o_count  this

    if {![llength $args]} {
        set key "_[::patternlib::uniqueKey]_"
    } else {
        #!todo - could we handle multiple val,key pairs without impacting performance of the common case?
        if {[llength $args] > 1} {
            error "add method expected 'val' and optional 'key' - got: $val $args"

        }

        set key [lindex $args 0]
        if {[string is integer -strict $key]} {
            error ">collection key must be non-numeric. Other structures such as >hashMap allow user specified integer keys"
        }	
    }

    if {[dict exists $o_data $key]} {
        #error "key $key already exists in collection [set ::p::[lindex ${_ID_} 0 0]::this]"
        error "key '$key' already exists in collection $this"
    }
    if {[info exists o_alias($key)]} {
        if {[dict exists $o_data $o_alias($key)]} {
            #only disallow adding via the alias if there is an existing o_data element for the key pointed to by the alias
            error "key '$key' already exists as an alias for $o_alias($key) in collection $this"
        }
    }

    dict set o_data $key $val


    set posn $o_count
    incr o_count

    return $posn
}


#shift/unshift - roughly analogous to those found in Perl & PHP
#unshift adds 1 or more values to the beginning of the collection.
$COL .. PatternMethod unshift {values {keys ""}} {
    var o_data o_count

    if {![llength $keys]} {
        for {set i 0} {$i < [llength $values]} {incr i} {
            lappend keys "_[::patternlib::uniqueKey]_"
        }
    } else {
        #check keys before we insert any of them.
        foreach newkey $keys {
            if {[string is integer -strict $newkey]} {
                error "cannot accept key '$newkey', >collection keys must be non-numeric. Other structures such as >hashMap allow user specified integer keys"
            }	
        }
    }
    if {[llength $values] != [llength $keys]} {
        error "unshift requires same number of keys as values. (or no keys for auto-generated keys) Received [llength $values] values, [llength $keys] keys"
    }	

    #separate loop through keys because we want to fail the whole operation if any are invalid.

    set existing_keys [dict keys $o_data]	
    foreach newkey $keys {
        if {$newkey in $exisint_keys} {
            #puts stderr "==============> key $key already exists in this collection"
            error "key '$newkey' already exists in this collection"
        }
    }


    #ok - looks like entire set can be inserted.
    set newpairs [list]
    foreach val $values key $keys {
        lappend newpairs $key $val
    }
    set o_data [concat $newpairs $o_data[set o_data {}]]
    set o_count [dict size $o_data]

    return [expr {$o_count - 1}]
}

#default to removing item from the beginning, otherwise from supplied index (position or key)
#!todo - accept alias indices
$COL .. PatternMethod shift {{idx ""}} {
	var o_data o_count
	
	if {$idx eq ""} {
		set key [lindex [dict keys $o_data] 0]
	} else {
		if {[string is integer -strict $idx]} {
			set key [lindex [dict keys $o_data] $idx]
		} else {
			set key $idx
		}
	}
	set posn [lsearch -exact [dict keys $o_data] $key]
	
	if {($posn >= 0) && (($posn/2) < [dict size $o_data])} {
		set result [dict get $o_data $key]
		dict unset o_data $key
		set o_count [dict size $o_data]
		return $result
	} else {
		error "no such index: '$idx'"
	}	
}


$COL .. PatternMethod peek {} {
	var o_data
	
	#set o_array([lindex $o_list end])

	#dict get $o_data [lindex [dict keys $o_data] end]
	lindex $o_data end
}

$COL .. PatternMethod peekKey {} {
	var o_data
	#lindex $o_list end
	lindex $o_data end-1
}


$COL .. PatternMethod insert {val args} {
	var o_data o_count
	
	set idx 0
	set key ""

	if {[llength $args] <= 2} {
		#standard arg (ordered) style:
		#>obj . insert $value $position $key

		lassign $args idx key
	} else {
		#allow for literate programming style:
		#e.g
		# >obj . insert $value at $listPosition as $key
	
		if {[catch {array set iargs $args}]} {
			error "insert did not understand argument list.
usage: 
>obj . insert \$val \$position \$key
>obj . insert \$val at \$position as \$key"
		}
		if {[info exists iargs(at)]} {
			set idx $iargs(at)
		}
		if {[info exists iargs(as)]} {
			set key $iargs(as)
		}
	}

	if {![string length $key]} {
		set key "_[::patternlib::uniqueKey]_"
	}

	if {[string is integer -strict $key]} {
		error ">collection key must be non-numeric. Other structures such as >hashMap allow user specified integer keys"
	}	

	
	if {[dict exists $o_data $key]} {
		#puts stderr "==============> key $key already exists in this collection"
		error "key '$key' already exists in this collection"
	}

	if {$idx eq "end"} {
		#lappend o_list $key
		#standard dict set will add it to the end anyway
		dict set o_data $key $val

	} else {
		#set o_list [linsert $o_list $idx $key]

		#treat dict as list
		set o_data [linsert $o_data[set o_data {}] [expr {$idx*2}] $key $val]
	}


	#set o_array($key) $val


	set o_count [dict size $o_data]

	return [expr {$o_count - 1}]
}

#!todo - deprecate and give it a better name! addDict addPairs ?
$COL .. PatternMethod addArray {list} {
	var
	puts stderr "patternlib::>collection WARNING: addArray deprecated - call addPairs with same argument instead"
	tailcall  addPairs $_ID_ $list
}
$COL .. PatternMethod addPairs {list} {
	var o_data o_alias o_count
	if {[llength $list] % 2} {
		error "must supply an even number of elements"
	}

  set aliaslist [array names o_alias]
	#set keylist [dict keys $o_data]
	foreach newkey [dict keys $list] {
		if {[string is integer -strict $newkey] } {
			error ">collection key must be non-integer. Bad key: $newkey. No items added."
		}

		#if {$newkey in $keylist} {}
		#for small to medium collections - testing for newkey in $keylist is probably faster,
		# but we optimise here for potentially large existing collections, where presumably a dict exists lookup will be more efficient.
		if {[dict exists $o_data $newkey]} {
			error "key '$newkey' already exists in this collection. No items added."
		}
		#The assumption is that there are in general relatively few aliases - so a list test is appropriate
		if {$newkey in $aliaslist} {
			if {[dict exists $o_data $o_alias($newkey)]} {
				error "key '$newkey' already exists as an alias for $o_alias($newkey) in collection. No items added "
			}
		}
		#! check if $list contains dups?
		#- slows method down - for little benefit?
	}
	#!todo - test?  (but we need a loop to test for integer keys.. so what's the point?)
	#set intersection [struct::set intersect [dict keys $list] [dict keys $o_data]]
	#if {[llength $intersection]} {
	#	error "keys '$intersection' already present in this collection. No items added."
	#}


	#rely on dict ordering guarantees (post 8.5? preserves order?)
	set o_data [dict merge $o_data[set o_data {}] $list]

	set o_count [dict size $o_data]

	return [expr {$o_count - 1}]
}
$COL .. PatternMethod addList {list} {
	var o_data o_count
	
	foreach val $list {
		dict set o_data "_[::patternlib::uniqueKey]_" $val
		#!todo - test. Presumably lappend faster because we don't need to check existing keys..
		#..but.. is there shimmering involved in treating o_data as a list?
		#lappend o_data _[::patternlib::uniqueKey]_ $val

		#tested 2008-06 tcl8.6a0  lappend was slower as the gain is lost (and more!) during subsequent [dict size $o_data]
	}
	set o_count [dict size $o_data]

	return [expr {$o_count - 1}]
}

#'del' is not a very good name... as we're not really 'deleting' anything.
# 'remove' seems better, and appears to be more consistent with other languages' collection implementations.
#!todo - handle 'endRange' parameter for removing ranges of items.
$COL .. PatternMethod del {idx {endRange ""}} {
	var
	#!todo - emit a deprecation warning for 'del'
	tailcall remove $_ID_ $idx $endRange
}

$COL .. PatternMethod remove {idx {endRange ""}} {
	var o_data o_count o_alias this

	if {[string length $endRange]} {
		error "ranged removal not yet implemented.. remove one item at a time."
	}


	if {[string is integer -strict $idx]} {
		if {$idx < 0} {
			set idx "end-[expr {abs($idx + 1)}]"
		}
		set key [lindex [dict keys $o_data] $idx]
		set posn $idx
	} else {
		set key $idx
		set posn [lsearch -exact [dict keys $o_data] $key]
		if {$posn < 0} {
			if {[catch {set o_alias($key)} nextKey]} {
				error "no such index: '$idx' in collection: $this"
			} else {
				#try with next key in alias chain...
				#return [remove $_ID_ $nextKey]
				tailcall remove $_ID_ $nextKey
			}
		}
	}
	
	dict unset o_data $key

	set o_count [dict size $o_data]
	return
}

#ordered
$COL .. PatternMethod names {{globOrIdx {}}} {
	var o_data

	if {[llength $globOrIdx]} {
		if {[string is integer -strict $globOrIdx]} {
			#Idx
			set idx $globOrIdx
			
			if {$idx < 0} {
				set idx "end-[expr {abs($idx + 1)}]"
			}	
		
			

			if {[catch {lindex [dict keys $o_data] $idx} result]} {
				error "no such index : '$idx'"
			} else {
				return $result	
			}		
		
		} else {
			#glob
			return [lsearch -glob -all -inline [dict keys $o_data] $globOrIdx]
		}
	} else {
		return [dict keys $o_data]
	}
}

#ordered
$COL .. PatternMethod keys {} {
	#like 'names' but without globbing
	var o_data
	dict keys $o_data
}

#Unfortunately the string 'name' is highly collidable when mixing in a collection over existing objects
# - !todo - review. Is it worth adjusting the collection methodnames to avoid a few common collision cases?
# - some sort of resolution order/interface-selection is clearly required anyway
# so perhaps it's generally best not to bother being 'polite' here, and implement a robust understandable resolution mechanism.
# In the mean time however... we'll at least avoid 'name'!
#
#$PM name {{posn 0}} {
#	var o_array o_list
#	
#	if {$posn < 0} {
#		set posn "end-[expr {abs($posn + 1)}]"
#	}
#		
#	if {[catch {lindex $o_list $posn} result]} {
#		error "no such index : '$posn'"
#	} else {
#		return $result	
#	}
#}

$COL .. PatternMethod key {{posn 0}} {
	var o_data
	
	if {$posn < 0} {
		set posn "end-[expr {abs($posn + 1)}]"
	}
		
	if {[catch {lindex [dict keys $o_data] $posn} result]} {
		error "no such index : '$posn'"
	} else {
		return $result	
	}
}


#!todo - consider use of 'end-x' syntax for 'to', and implications re consistency with other commands.
$COL .. PatternMethod setPosn {idx to} {
	var o_data
	
	if {![string is integer -strict $to]} {
		error "destination position must be numeric, consider reKey method if you are trying to change the string key under which this value is stored"
	}

	if {[string is integer -strict $idx]} {
		set idx [expr {$idx % [dict size $o_data]}]

		set key [lindex [dict keys $o_data] $idx]
		set posn $idx
	} else {
		set key $idx
		set posn [lsearch -exact [dict keys $o_data] $key]
	}

	set to [expr {$to % [dict size $o_data]}]
	

	set val [dict get $o_data $key]
	dict unset o_data $key

	#treat dict as list
	set o_data [linsert $o_data[set o_data {}] [expr {$posn*2}] $key $val]
 
	#set o_list [lreplace $o_list $posn $posn]
	#set o_list [linsert $o_list $to $key] 

	return $to
}
#!todo - improve efficiency of calls to other functions on this object.. 'inline'??
#presumably the collection object functionality will be long-term stable because it's purpose is to be a core datastructure; therefore it should be reasonable to favour efficiency over maintainability.
$COL .. PatternMethod incrPosn {idx {by 1}} {
	var o_data
	if {[string is integer -strict $idx]} {
		set idx [expr {$idx % [dict size $o_data]}]
		set key [lindex [dict keys $o_data] $idx]
		set posn $idx
	} else {
		set key $idx
		set posn [lsearch -exact [dict keys $o_data] $key]
	}
	
	set newPosn [expr {($posn + $by) % [dict size $o_data]}]

	setPosn $_ID_ $posn $newPosn
	return $newPosn
}
$COL .. PatternMethod decrPosn {idx {by 1}} {
	var
	return [incrPosn $_ID_ $idx [expr {- $by}]]
}
$COL .. PatternMethod move {idx to} {
	var
	return [setPosn $_ID_ $idx $to]
}
$COL .. PatternMethod posn {key} {
	var o_data
	return [lsearch -exact [dict keys $o_data] $key]
}

#!todo? - disallow numeric values for newKey so as to be consistent with add
#!note! - item can be reKeyed out from under an alias such that the alias chain no longer points to anything
# - this is ok.
$COL .. PatternMethod reKey {idx newKey} {
	var o_data o_alias


	if {[dict exists $o_data $newKey]} {
		#puts stderr "==============> reKey collision, key $newKey already exists in this collection"
		error "reKey collision, key '$newKey' already exists in this collection"
	}
	if {[info exists o_alias($newKey)]} {
		if {[dict exists $o_data $o_alias($newKey)]} {
			error "reKey collision, key '$newKey' already present as an alias in this collection"
		} else {
				set newKey $o_alias($newKey)
		}
	}



	if {[string is integer -strict $idx]} {
		if {$idx < 0} {
			set idx "end-[expr {abs($idx + 1)}]"
		}
		set key [lindex [dict keys $o_data] $idx]
		set posn $idx
	} else {
		set key $idx
		set posn [lsearch -exact [dict keys $o_data] $key]
		if {$posn < 0} {
			if {[catch {set o_alias($key)} nextKey]} {
				error "no such index: '$idx'"
			} else {
				#try with next key in alias chain...
				#return [reKey $_ID_ $nextKey $newKey]
				tailcall reKey $_ID_ $nextKey $newKey
			}
		}
	}

	#set o_list [lreplace $o_list $posn $posn $newKey]
	##atomic? (traces on array?)
	#set o_array($newKey) $o_array($key)
	#unset o_array($key)

	dict set o_data $newKey [dict get $o_data $key]
	dict unset o_data $key

	return
}
$COL .. PatternMethod hasKey {key} {
	var o_data
	dict exists $o_data $key
}
$COL .. PatternMethod hasAlias {key} {
	var o_alias
	info exists o_alias($key)
}

#either key or alias
$COL .. PatternMethod hasIndex {key} {
	var o_data o_alias
	if {[dict exists $o_data $key]} {
		return 1
	} else {
		return [info exists o_alias($key)]
	}	
}


#Shuffle methods from http://mini.net/tcl/941
$COL .. PatternMethod shuffleFast {} {
	#shuffle6 - fast, but some orders more likely than others.

	var o_data
 	 	
	set keys [dict keys $o_data]

   set n [llength $keys]
   for { set i 1 } { $i < $n } { incr i } {
       set j [expr { int( rand() * $n ) }]
       set temp [lindex $keys $i]
       lset keys $i [lindex $keys $j]
       lset keys $j $temp
   }

	#rebuild dict in new order
	#!todo - can we do the above 'in place'?
	set newdata [dict create]
	foreach k $keys {
		dict set newdata $k [dict get $o_data $k]
	}
	set o_data $newdata

    return     
}
$COL .. PatternMethod shuffle {} {
	#shuffle5a
	
	var o_data
	 
	set n 1
	set keys [list]  ;#sorted list of keys
	foreach k [dict keys $o_data] {
		#set index [expr {int(rand()*$n)}]

		#set slist [linsert [::pattern::K $keys [set keys {}]] $index $k]

		#faster alternative.. 'inline K' [lindex [list a b] 0] ~ [K a b]   
		set keys [linsert [lindex [list $keys [set keys {}]] 0] [expr {int(rand()*$n)}] $k]
		incr n
	}

	#rebuild dict in new order
	#!todo - can we do the above 'in place'?
	set newdata [dict create]
	foreach k $keys {
		dict set newdata $k [dict get $o_data $k]
	}
	set o_data $newdata
	
	return
}


#search is a somewhat specialised form of 'itemKeys'
$COL .. PatternMethod search {value args} {
    var o_data
    #only search on values as it's possible for keys to match - especially with options such as -glob
    set matches [lsearch {*}$args [dict values $o_data] $value]
    
    if {"-inline" in $args} {
        return $matches 
    } else {
        set keylist [list]
        foreach i $matches {
            set idx [expr {(($i + 1) * 2) -2}]
            lappend keylist [lindex $o_data $idx]
        }
        return $keylist
    }
}

#inverse lookup 
$COL .. PatternMethod itemKeys {value} {
    var o_data
    #only search on values as it's possible for keys to match
    set value_indices [lsearch -all [dict values $o_data] $value]
    
    set keylist [list]
    foreach i $value_indices {
        set idx [expr {(($i + 1) * 2) -2}]
        lappend keylist [lindex $o_data $idx]
    }
    return $keylist
}

#invert:
#change collection to be indexed by its values with the old keys as new values.
# - keys of duplicate values become a list keyed on the value.
#e.g the array equivalent is:
# arr(a) 1
# arr(b) 2
# arr(c) 2
#becomes
# inv(1) a
# inv(2) {b c}
#where the order of duplicate-value keys is not defined.
#
#As the total number of keys may change on inversion - order is not preserved if there are ANY duplicates.
#


#!todo - try just  [lreverse $o_data] ??


$COL .. PatternMethod invert {{splitvalues ""}} {

	var o_data o_count o_dupes o_inverted
	

	if {$splitvalues eq ""} {
		#not overridden - use o_dupes from last call to determine if values are actually keylists.
		if {$o_dupes > 0} {
			set splitvalues 1
		} else {
			set splitvalues 0
		}
	}


	#set data [array get o_array]
	set data $o_data

	if {$o_count > 500} {
		#an arbitrary optimisation for 'larger' collections.
		#- should theoretically keep the data size and save some reallocations.
		#!todo - test & review
		#
		foreach nm [dict keys $o_data] {
			dict unset o_data $nm
		}
	} else {
		set o_data [dict create]
	}
	
	if {!$splitvalues} {
		dict for {k v} $data {
			dict set o_data $v $k
		}
	} else {
		dict for {k v} $data {
			#we're splitting values because each value is a list of keys
			#therefore sub should be unique - no need for lappend in this branch.
			foreach sub $v {
				#if {[info exists o_array($sub)]} {
				#	puts stderr "---here! v:$v sub:$sub k:$k"
				#	lappend o_array($sub) $k
				#} else {
					dict set o_data $sub $k
				#}
			}
		}
	}


	if {[dict size $o_data] != $o_count} {
		#must have been some dupes

		set o_dupes [expr {$o_count - [dict size $o_data]}]
		#update count to match inverted collection
		set o_count [dict size $o_data]
	} else {
		set o_dupes 0
	}

	set o_inverted [expr {!$o_inverted}]

	#'dupes' is the size difference - so 3 equal values in the original collection corresponds to '2 dupes'
	return $o_dupes
}






#NOTE: values are treated as lists and split into separate keys for inversion only if requested!
# To treat values as keylists - set splitvalues 1
# To treat each value atomically - set splitvalues 0
# i.e only set splitvalues 1 if you know the values represent duplicate keys from a previous call to invert!
#
#
#Initially call invert with splitvalues = 0
#To keep calling invert and get back where you started..
# The rule is... if the previous call to invert returned > 0... pass 1 on the next call.
#
$COL .. PatternMethod invert_manual {{splitvalues 0}} {
	#NOTE - the list nesting here is *tricky* - It probably isn't broken.

	var o_list o_array o_count

	set data [array get o_array]
	
	if {$o_count > 500} {
		#an arbitrary optimisation for 'large' collections.
		#- should theoretically keep the array size and save some reallocations.
		#!todo - test & review
		#
		foreach nm [array names o_array] {
			unset o_array($nm)
		}
	} else {
		array unset o_array
	}
	
	if {!$splitvalues} {
		foreach {k v} $data {
			lappend o_array($v) $k
		}
	} else {
		foreach {k v} $data {
			#we're splitting values because each value is a list of keys
			#therefore sub should be unique - no need for lappend in this branch.
			foreach sub $v {
				#if {[info exists o_array($sub)]} {
				#	puts stderr "---here! v:$v sub:$sub k:$k"
				#	lappend o_array($sub) $k
				#} else {
					set o_array($sub) $k
				#}
			}
		}
	}


	if {[array size o_array] != $o_count} {
		#must have been some dupes
		set o_list [array names o_array]


		set dupes [expr {$o_count - [array size o_array]}]
		#update count to match inverted collection
		set o_count [array size o_array]
	} else {
		#review - are these machinations worthwhile for order preservation? what speed penalty do we pay?
		array set prev $data
		set i -1
		if {$splitvalues} {
			#values are lists of length one. Take lindex 0 so list values aren't overnested.
			foreach oldkey $o_list {
				lset o_list [incr i] [lindex $prev($oldkey) 0]
			}
		} else {
			foreach oldkey $o_list {
				lset o_list [incr i] $prev($oldkey)
			}
		}

		set dupes 0
	}


	#'dupes' is the size difference - so 3 equal values in the original collection corresponds to '2 dupes'
	return $dupes
}



#Note that collections cannot be inverted without loss of information if they have duplicates AND compound keys
# (keys that are lists)
$COL .. PatternMethod invert_lossy {{splitvalues 1}} {
	var o_list o_array o_count

	set data [array get o_array]
	
	if {$o_count > 500} {
		#an arbitrary optimisation for 'large' collections.
		#- should theoretically keep the array size and save some reallocations.
		#!todo - test & review
		#
		foreach nm [array names o_array] {
			unset o_array($nm)
		}
	} else {
		array unset o_array
	}
	
	if {!$splitvalues} {
		foreach {k v} $data {
			#note! we must check for existence and use 'set' for first case.
			#using 'lappend' only will result in deeper nestings on each invert!
			#If you don't understand this - don't change it!
			if {[info exists o_array($v)]} {
				lappend o_array($v) $k
			} else {
				set o_array($v) $k
			}
		}
	} else {
		foreach {k v} $data {
			#length test necessary to avoid incorrect 'un-nesting'
			#if {[llength $v] > 1} {
				foreach sub $v {
					if {[info exists o_array($sub)]} {
						lappend o_array($sub) $k
					} else {
						set o_array($sub) $k
					}
				}
			#} else {
			#	if {[info exists o_array($v)]} {
			#		lappend o_array($v) $k
			#	} else {
			#		set o_array($v) $k
			#	}
			#}
		}
	}


	if {[array size o_array] != $o_count} {
		#must have been some dupes
		set o_list [array names o_array]


		set dupes [expr {$o_count - [array size o_array]}]
		#update count to match inverted collection
		set o_count [array size o_array]
	} else {
		#review - are these machinations worthwhile for order preservation? what speed penalty do we pay?
		array set prev $data
		set i -1
		foreach oldkey $o_list {
			lset o_list [incr i] $prev($oldkey)
		}
		set dupes 0
	}


	#'dupes' is the size difference - so 3 equal values in the original collection corresponds to '2 dupes'
	return $dupes
}

$COL .. PatternMethod reverse {} {
	var o_data

	set dictnew [dict create]
	foreach k [lreverse [dict keys $o_data]] {
		dict set dictnew $k [dict get $o_data $k]
	}
	set o_data $dictnew
	return
}

$COL .. PatternMethod keySort {{options -ascii}} {
	var o_data
	
	set keys [lsort {*}$options [dict keys $o_data]]

	set dictnew [dict create]
	foreach k $keys {
		dict set dictnew $k [dict get $o_data $k]
	}
	set o_data $dictnew

	return
}

#!todo - allow simple options in combination with options such as -command and -object.  Redo args handling completely for more complex sorting.
$COL .. PatternMethod sort {args} {
	var o_data

	#defaults
	set options [dict create -index 1] ;#values always in subelement 1 of name-value pair list for sorting. 

	set options_simple [list]
	

	for {set i 0} {$i < [llength $args]} {incr i} {
		set a [lindex $args $i]
		switch --  $a {
		-indices -
		-ascii -
		-dictionary -
		-integer -
		-real -
		-increasing -
		-decreasing {
			#dict set options $a 1
			lappend options_simple $a
			}
		-unique {
			#not a valid option
			#this would stuff up the data... 
			#!todo? - remove dups from collection if this option used? - alias the keys?
			}
        -object {
            #!todo - treat value as object and allow sorting by sub-values  .eg >col1 . sort -object ". sub . property" -increasing 
            #may be slow - but handy.  Consider -indexed property to store/cache these values on first run 
            }
		-command {
			dict set options $a [lindex $args [incr i]]
			}
		-index {
			#allow sorting on subindices of the value.
			dict set options -index [concat [dict get $options -index] [lindex $args [incr i]]  ]
			}
		default {
			#unrecognised option - print usage?
		}
		}
	}


	
	if {[set posn [lsearch -exact $options_simple "-indices"]] >= 0} {

		var o_array

		set slist [list]
		foreach k [dict keys $o_data] {
			lappend slist [list $k [dict get $o_data $k]]
		}
		return [lsort {*}$options_simple {*}$options $slist]



		#set options_simple [lreplace $options_simple $posn $posn] ;#
		#set slist [list]
		#foreach {n v} [array get ::p::[lindex ${_ID_} 0 0]::o_array] {
		#	lappend slist [list $n $v]	
		#}
		#set slist [lsort {*}$options_simple {*}$options $slist]
		#foreach i $slist {
		#	#determine the position in the collections list 
		#	lappend result {*}[lsearch -exact $o_list [lindex $i 0]]
		#}
		#return $result
	} else {	
		set slist [list]
		dict for {k v} $o_data {
			lappend slist [list $k $v]	
		}
		#set slist [lsort {*}$options_simple {*}$options $slist]
		set slist [lsort {*}$options_simple {*}$options $slist[set slist {}]]  ;#K combinator for efficiency

		
		#set o_list [lsearch -all -inline -subindices -index 0 $slist *]

		set o_data [dict create]
		foreach pair $slist {
			dict set o_data [lindex $pair 0] [lindex $pair 1]
		}
	


		return
	}

}


$COL .. PatternMethod clear {} {
	var o_data o_count
	
	set o_data [dict create]
	set o_count 0
    #aliases?
	return
}

#see http://wiki.tcl.tk/15271 - A generic collection traversal interface
#
#!todo  - options: -progresscommand -errorcommand  (-granularity ?) (-self ? (to convert to an iterator?))
#!todo? - lazy retrieval of items so that all changes to the collection are available to a running asynch enumeration?
#		- should this be an option? which mechanism should be the default? 
#		- currently only the keylist is treated in 'snapshot' fashion 
#		  so values could be changed and the state could be invalidated by other code during an enumeration
#
$COL .. PatternMethod enumerate {args} {
	#----------
	lassign [lrange $args end-1 end] cmd seed
	set optionlist [list]
	foreach a [lrange $args 0 end-2] {
		lappend optionlist $a
	}
	set opt(-direction) left
	set opt(-completioncommand) ""
	array set opt $optionlist
	#----------
	var o_data

	if {[string tolower [string index $opt(-direction) 0]] eq "r"} {
		#'right' 'RIGHT' 'r' etc.
		set list [lreverse [dict keys $o_data]]
	} else {
		#normal left-right order
		set list [dict keys $o_data]
	}

	if {![string length $opt(-completioncommand)]} {
		#standard synchronous processing
		foreach k $list {
			set seed [uplevel #0 [list {*}$cmd $seed [dict get $o_data $k]]]
		}
		return $seed
	} else {
		#ASYNCHRONOUS enumeration 
		var this o_bgEnum 
		#!todo - make id unique
		#!todo - facility to abort running enumeration.
		set enumID enum[array size o_bgEnum]
		
		set seedvar [$this . bgEnum $enumID .]
		set $seedvar $seed

		after 0 [list $this . _doBackgroundEnum $enumID $list $cmd $seedvar $opt(-completioncommand)]
		return $enumID
	}
}

#!todo - make private? - put on a separate interface?
$COL .. PatternMethod _doBackgroundEnum {enumID slice cmd seedvar completioncommand} {
	var this o_data


	#Note that we don't post to the eventqueue using 'foreach s $slice' 
	# we only schedule another event after each item is processed 
	# - otherwise we would be spamming the eventqueue with <collection . count> items.

	#!todo? - accept a -granularity option to allow handling of n list-items per event?

	if {[llength $slice]} {
		set slice [lassign $slice head]

		set script [string map [list %cmd% $cmd %seedvar% $seedvar %val% [dict get $o_data $head]] {
				%cmd% [set %seedvar%] %val%
		}]

		#post to eventqueue and re-enter _doBackgroundEnum
		#
		after idle [list after 0 [subst {set $seedvar \[uplevel #0 [list $script] \]; $this . _doBackgroundEnum $enumID [list $slice] [list $cmd] $seedvar [list $completioncommand]}]]

	} else {
		#done.

		set script [string map [list %cmd% $completioncommand %seedvar% $seedvar] {
			lindex [list [%cmd% [set %seedvar%]] [unset %seedvar%]] 0
		}]

		after idle [list after 0 [list uplevel #0 $script]]
	}

	return
}

$COL .. PatternMethod enumeratorstate {} {
	var o_bgEnum
	parray o_bgEnum
}

#proc ::bgerror {args} {
#	puts stderr "=bgerror===>$args"
#}


#map could be done in terms of the generic 'enumerate' method.. but it's slower.
#
#$PM map2 {proc} {
#	var
#	enumerate $_ID_ [list ::map-helper $proc] [list]
#}
#proc ::map-helper {proc accum item} {
#	lappend accum [uplevel #0 [list {*}$proc $item]]
#}

$COL .. PatternMethod map {cmd} {
	var o_data
	set seed [list]
	dict for {k v} $o_data {
		lappend seed [uplevel #0 [list {*}$cmd $v]]
	}

	return $seed
}
$COL .. PatternMethod objectmap {cmd} {
	var o_data
	set seed [list]
	dict for {k v} $o_data {
		lappend seed [uplevel #0 [list $v {*}$cmd]]
	}

	return $seed
}


#End core collection functionality.
#collection 'mixin' interfaces

>pattern .. Create >keyvalprotector 
>keyvalprotector .. PatternVariable o_protectedkeys
>keyvalprotector .. PatternVariable o_protectedvals

#!todo - write test regarding errors in Constructors for mixins like this
# - an error (e.g from bad args) can cause errors with vars after it's re-run with correct args
>keyvalprotector .. Constructor {args} {
    var this  o_protectedkeys o_protectedvals
    set this @this@
    #----------------------------------------------------------------------------
    set known_opts [list -keys -vals ] 
    dict set default -keys [list]
    dict set default -vals [list]
    if {([llength $args] % 2) != 0} {
        error "(>keyvalprotector .. Constructor) ERROR: uneven options supplied - must be of form '-option value' "
    }
    foreach {k v} $args {
        if {$k ni $known_opts} {
            error "(>keyvalprotector .. Constructor) ERROR: option '$k' not in known options: '$known_opts'"
        }
    }
    set opts [dict merge $default $args]
    set o_protectedkeys    [dict get $opts -keys]
    set o_protectedvals    [dict get $opts -vals]
    #----------------------------------------------------------------------------
    set protections [concat $o_protectedkeys $o_protectedvals]
    if {![llength $protections]} {
        error "(>keyvalprotector .. Constructor) ERROR: must supply at least one argument to -vals or -keys"
    }

}
>keyvalprotector .. PatternMethod clear {} {
    error "(>keyvalprotector . clear) ERROR:  This collection is protected by a >keyvalprotector mixin. Cannot clear"
}
>keyvalprotector .. PatternMethod pop {{idx ""}} {
    var o_data o_count o_protectedkeys o_protectedvals

    if {$idx eq ""} {
        set key [lindex [dict keys $o_data] end]
    } else {
        if {[string is integer -strict $idx]} {
            set key [lindex [dict keys $o_data] $idx]
        } else {
            set key $idx
        }
    }

    if {$key in $o_protectedkeys} {
        error "(>keyvalprotector . pop) ERROR: Cannot pop object with index '$idx', key '$key' from collection."
    }
    set posn [lsearch -exact [dict keys $o_data] $key]
    if {($posn >= 0) && ($posn < [dict size $o_data])} {
        set result [dict get $o_data $key]
        if {$result in $o_protectedvals} {
            error "(>keyvalprotector . pop) ERROR: Cannot pop object '$result' with index '$idx', key '$key' from collection."
        }
        dict unset o_data $key
        set o_count [dict size $o_data]
        return $result
    } else {
        error "no such index: '$idx'"
    }

}
>keyvalprotector .. PatternMethod remove {idx {endRange ""}} {
    var this o_data o_count o_alias o_protectedkeys o_protectedvals

    if {[string length $endRange]} {
        error "ranged removal not yet implemented.. remove one item at a time."
    }

    if {[string is integer -strict $idx]} {
        if {$idx < 0} {
            set idx "end-[expr {abs($idx + 1)}]"
        }
        set key [lindex [dict keys $o_data] $idx]
        if {$key in $o_protectedkeys} {
            error "(>keyvalprotector . remove) ERROR: cannot remove item with index '$idx' key '$key' from collection"
        }
        set posn $idx
    } else {
        set key $idx
        set posn [lsearch -exact [dict keys $o_data] $key]
        if {$posn < 0} {
            if {[catch {set o_alias($key)} nextKey]} {
                error "no such index: '$idx' in collection: $this"
            } else {
                if {$key in $o_protectedkeys} {
                    error "(>keyvalprotector . remove) ERROR: cannot remove item with index '$idx' from collection"
                }
                #try with next key in alias chain...
                #return [remove $_ID_ $nextKey]
                tailcall remove $_ID_ $nextKey
            }
        }
    }

    dict unset o_data $key

    set o_count [dict size $o_data]
    return
}

#1)
#predicate methods (order preserving)
#usage: 
# >collection .. Create >c1
# >predicatedCollection .. Create >c1   ;#overlay predicate methods on existing collection

#e.g  >col1 . all {$val > 14}
#e.g  >col1 . filterToCollection {$val > 19} . count
#e.g  >col1 . filter {[string match "x*" $key]}
#!todo - fix. currying fails..

::>pattern .. Create >predicatedCollection
#process_pattern_aliases ::patternlib::>predicatedCollection

set PM  [>predicatedCollection .. PatternMethod .]

>predicatedCollection .. PatternMethod filter {predicate} {
	var this o_list o_array
	set result [list]
	
	#!note (jmn 2004) how could we do smart filtering based on $posn?
	#i.e it would make sense to lrange $o_list based on $posn... 
	#but what about complicated expressions where $posn is a set of ranges and/or combined with tests on $key & $val ??
	#Seems better to provide an alternative efficient means of generating subcolllections/ranges to perform predicate operations upon.
	#given this, is $posn even useful?
	
	set posn 0
	foreach key $o_list {
		set val $o_array($key)
		if $predicate {
			lappend result $val
		}
		incr posn
	}
	set result
}
>predicatedCollection .. PatternMethod filterToKeys {predicate} {
	var this o_list o_array
	set result [list]
	
	set posn 0
	foreach key $o_list {
		set val $o_array($key)
		if $predicate {
			lappend result $key
		}
		incr posn
	}
	set result
}
>predicatedCollection .. PatternMethod filterToCollection {predicate {destCollection {}}} {
	#!todo - collection not in subordinate namespace? -> if subordinate, should imply modification of sub's contents will be reflected in parent?
	#!todo - implement as 'view' on current collection object.. extra o_list variables?
	#!todo - review/document 'expected' key collision behaviour - source keys used as dest keys.. -autokey option required? 
	var this o_list o_array m_i_filteredCollection
	
	incr m_i_filteredCollection
	if {![string length $destCollection]} {
		#!todo? - implement 'one-shot' object (similar to RaTcl)
		set result [::patternlib::>collection .. Create [$this .. Namespace]::>filteredCollection-$m_i_filteredCollection]
	} else {
		set result $destCollection
	}

	####
	#externally manipulate new collection
	#set ADD [$c . add .]
	#foreach key  $o_list {
	#	set val $o_array($key)
	#	if $predicate {
	#		$ADD $val $key
	#	}
	#}
	###
	
	#internal manipulation faster
	#set cID [lindex [set $result] 0]
	set cID [lindex [$result --] 0]

	#use list to get keys so as to preserve order
	set posn 0
	upvar #0 ::p::${cID}::o_array cARRAY ::p::${cID}::o_list cLIST
	foreach key $o_list {
		set val $o_array($key)
		if $predicate {	
			if {[info exists cARRAY($key)]} {
				error "key '$key' already exists in this collection"
			}
			lappend cLIST $key
			set cARRAY($key) $val
		}
		incr posn
	}
	
	return $result
}

#NOTE! unbraced expr/if statements. We want to evaluate the predicate.
>predicatedCollection .. PatternMethod any {predicate} {
	var this o_list o_array
	set posn 0
	foreach key $o_list {
		set val $o_array($key)
		if $predicate {
			return 1
		}
		incr posn
	}
	return 0
}
>predicatedCollection .. PatternMethod all {predicate} {
	var this o_list o_array
	set posn 0
	foreach key $o_list {
		set val $o_array($key)
        if !($predicate) {
			return 0
		}
		incr posn
	}
	return 1
}
>predicatedCollection .. PatternMethod dropWhile {predicate} {
	var this o_list o_array
	set result [list]
	set _idx 0
	set posn 0
	foreach key $o_list {
		set val $o_array($key)
		if $predicate {
			incr _idx
		} else {
			break
		}
		incr posn
	}
	set remaining [lrange $o_list $_idx end]
	foreach key $remaining {
		set val $o_array($key)
		lappend result $val
	}
	return $result
}
>predicatedCollection .. PatternMethod takeWhile {predicate} {
	var this o_list o_array
	set result [list]
	set posn 0
	foreach key $o_list {
		set val $o_array($key)
		if $predicate {
			lappend result $val
		} else {
			break
		}
		incr posn
	}
	set result
}



#end >collection mixins
######################################




#-----------------------------------------------------------
#!TODO - methods for converting an arrayHandle to & from a hashMap efficiently?
# Why do we need both? apart from the size variable, what is the use of hashMap?
#-----------------------------------------------------------
#::pattern::create >hashMap 
::>pattern .. Create >hashMap

>hashMap .. PatternVariable o_size
>hashMap .. PatternVariable o_array

>hashMap .. Constructor {args} {
    var o_array o_size
    array set o_array [list]
    set o_size 0
}
>hashMap .. PatternDefaultMethod "item"
>hashMap .. PatternMethod item {key} {
    var o_array
    set o_array($key)
}
>hashMap .. PatternMethod items {} {
    var o_array

    set result [list]
    foreach nm [array names o_array] {
        lappend result $o_array($nm)
    }
    return $result
}
>hashMap .. PatternMethod pairs {} {
    var o_array

    array get o_array
}
>hashMap .. PatternMethod add {val key} {
    var o_array o_size

    set o_array($key) $val
    incr o_size
    return $key	
}

>hashMap .. PatternMethod del {key} {
    var 
    puts stderr "warning: 'del' method of >hashMap deprecated. Use 'remove' instead."
    remove $_ID_ $key
}
>hashMap .. PatternMethod remove {key} {
    var o_array o_size
    unset o_array($key)
    incr o_size -1
    return $key
}
>hashMap .. PatternMethod count {} {
    var o_size
    #array size o_array
    return $o_size
}
>hashMap .. PatternMethod count2 {} {
    var o_array
    #array size o_array ;#slow, at least for TCLv8.4.4
    #even array statistics is faster than array size !
    #e.g return [lindex [array statistics o_array] 0]
    #but.. apparently there are circumstances where array statistics doesn't report the correct size. 
    return [array size o_array]
}
>hashMap .. PatternMethod names {} {
    var o_array
    array names o_array
}
>hashMap .. PatternMethod keys {} {
    #synonym for names
    var o_array
    array names o_array
}
>hashMap .. PatternMethod hasKey {key} {
    var o_array
    return [info exists o_array($key)]
}
>hashMap .. PatternMethod clear {} {
    var o_array o_size
    unset o_array
    set o_size 0
    return
}
#>hashMap .. Ready 1















#explicitly create metadata. Not required for user-defined patterns. 
# this is only done here because this object is used for the metadata of all objects
# so the object must have all it's methods/props before its own metadata structure can be built.
#uplevel 1 "::pattern::object ::pattern::>_nullMeta createMetadata >collection"
#uplevel 1 "::patternlib::>collection .. CreateMetadata ::patternlib::>collection"




if 0 {


#-----------------------------------------------------------
#::pattern::create >arrayHandle {
#	variable o_arrayName
#	variable this
#}
::>pattern .. Create >arrayHandle

>arrayHandle .. PatternVariable o_arrayName
>arrayHandle .. PatternVariable this

>arrayHandle .. Constructor {args} {
	var o_arrayName this
	set this @this@
	
	
	set o_arrayName [$this .. Namespace]::array

	upvar #0 $o_arrayName $this
	#? how to automatically update this after a namespace import?
		
	array set $o_arrayName [list]
	
}
>arrayHandle .. PatternMethod array {} {
	var o_arrayName
	return $o_arrayName
}

#-------------------------------------------------------
#---- some experiments
>arrayHandle .. PatternMethod up {varname} {
	var o_arrayName
	
	#is it dodgy to hard-code the calling depth?
	#will it be different for different object systems?
	#Will it even be consistent for the same object.
	# Is this method necessary anyway? -
	# - users can always instead do:
	# upvar #0 [>instance . array] var
	
	uplevel 3 [list upvar 0 $o_arrayName $varname]
	
	return
}
>arrayHandle .. PatternMethod global {varname} {
	var o_arrayName
	# upvar #0 [>instance . array] var
	
	if {![string match ::* $varname]} {
		set varname ::$varname
	}
	
	upvar #0 $o_arrayName $varname
	
	return
}
>arrayHandle .. PatternMethod depth {} {
	var o_arrayName
	#
	for {set i 0} {$i < [info level]} {
		puts "${i}: [uplevel $i [list namespace current] , [info level $i]]"
	}
	
}
 # --------------------------------------------


>arrayHandle .. PatternMethod item {key} {
	var o_arrayName
	set ${o_arrayName}($key)
}
>arrayHandle .. PatternMethod items {} {
	var o_arrayName
	
	set result [list]
	foreach nm [array names $o_arrayName] {
		lappend result [set ${o_arrayName}($nm)]
	}
	return $result
}
>arrayHandle .. PatternMethod pairs {} {
	var o_arrayName
	
	array get $o_arrayName
}
>arrayHandle .. PatternMethod add {val key} {
	var o_arrayName 
	
	set ${o_arrayName}($key) $val
	return $key	
}
>arrayHandle .. PatternMethod del {key} {
	puts stderr "Warning: 'del' method of >arrayHandle deprecated. Use 'remove' instead."
	remove $_ID_ $key
}
>arrayHandle .. PatternMethod remove {key} {
	var o_arrayName 
	unset ${o_arrayName}($key)
	return $key
}
>arrayHandle .. PatternMethod size {} {
	var o_arrayName
	return [array size $o_arrayName]
}
>arrayHandle .. PatternMethod count {} {
	#alias for size
	var o_arrayName
	return [array size $o_arrayName]
}
>arrayHandle .. PatternMethod statistics {} {
	var o_arrayName
	return [array statistics $o_arrayName]
}
>arrayHandle .. PatternMethod names {} {
	var o_arrayName
	array names $o_arrayName
}
>arrayHandle .. PatternMethod keys {} {
	#synonym for names
	var o_arrayName
	array names $o_arrayName
}
>arrayHandle .. PatternMethod hasKey {key} {
	var o_arrayName
		
	return [info exists ${o_arrayName}($key)]
}
>arrayHandle .. PatternMethod clear {} {
	var o_arrayName
	unset $o_arrayName
	array set $o_arrayName [list]
	
	return
}
#>arrayHandle .. Ready 1




::>pattern .. Create >matrix

>matrix .. PatternVariable o_array
>matrix .. PatternVariable o_size

>matrix .. Constructor {args} {
    var o_array o_size

    array set o_array [list]
    set o_size 0
}


#process_pattern_aliases ::patternlib::>matrix 

set PM [>matrix .. PatternMethod .]

>matrix .. PatternMethod item {args} {
    var o_array 

    if {![llength $args]} {
        error "indices required"
    } else {
        
    }
    if [info exists o_array($args)] {
        return $o_array($args)
    } else {
        error "no such index: '$args'"
    }
}
>matrix .. PatternMethod items {} {
    var o_array

    set result [list]
    foreach nm [array names o_array] {
        lappend result $o_array($nm)
    }
    return $result
}
>matrix .. PatternMethod pairs {} {
	var o_array
	
	array get o_array
}
>matrix .. PatternMethod slice {args} {
	var o_array
	
	if {"*" ni $args} {
		lappend args *
	}
	
	array get o_array $args
}
>matrix .. PatternMethod add {val args} {
	var o_array o_size

	if {![llength $args]} {
		error "indices required"
	}
	
	set o_array($args) $val	
	incr o_size
	
	#return [array size o_array]
	return $o_size
}
>matrix .. PatternMethod names {} {
	var o_array
	array names o_array
}
>matrix .. PatternMethod keys {} {
	#synonym for names
	var o_array
	array names o_array
}
>matrix .. PatternMethod hasKey {args} {
	var o_array
		
	return [info exists o_array($args)]
}
>matrix .. PatternMethod clear {} {
	var o_array o_size
	unset o_array
	set o_size 0
	return
}
>matrix .. PatternMethod count {} {
	var o_size
	return $o_size
}
>matrix .. PatternMethod count2 {} {
	var o_array
	#see comments for >hashMap count2
	return [array size o_array]
}
#>matrix .. Ready 1

#--------------------------------------------------------
#tree data structure (based *loosely* on API at http://www.msen.com/%7Eclif/treeNobj.html  - discussed in Clif Flynts book Tcl programming)
#!todo - compare API to http://tcllib.sourceforge.net/doc/tree.html
#!todo - create an >itree (inheritance tree) where node data is readable/writable on children unless overridden.
::>pattern .. Create >tree

set _NODE [::>pattern .. Create [>tree .. Namespace]::>node]
set _TREE_NODE $_NODE
#process_pattern_aliases $_TREE_NODE

$_NODE .. PatternVariable o_treens ;#tree namespace
$_NODE .. PatternVariable o_idref
$_NODE .. PatternVariable o_nodePrototype

#$_NODE .. PatternProperty data
$_NODE .. PatternProperty info

$_NODE .. PatternProperty tree
$_NODE .. PatternProperty parent
$_NODE .. PatternProperty children
$_NODE .. PatternMethod addNode {} {
	set nd_id [incr $o_idref]
	set nd [$o_nodePrototype .. Create ${o_treens}::>n-$nd_id -tree $o_tree -parent @this@]
	@this@ . add $nd n-$nd_id

	return n-$nd_id
}
#flat list of all nodes below this
#!todo - something else? ad-hoc collections?
#!todo - non-recursive version? tail-call opt?
$_NODE .. PatternMethod nodes {} {
	set result [list]

	#use(abuse?) our knowledge of >collection internals
	foreach n $o_list {
		#eval lappend result $n [$o_array($n) . nodes]
		#!todo - test
		lappend result $n {*}[$o_array($n) . nodes]
	}
	return $result
}
#count of number of descendants
#!todo - non-recursive version? tail-call opt?
$_NODE .. PatternMethod size {} {
	set result 0
	#use(abuse?) our knowledge of >collection internals
	foreach n $o_list {
		incr result [expr {1 + [$o_array($n) . size]}]
	}
	return $result
}
$_NODE .. PatternMethod isLeaf {} {
	#!todo - way to stop unused vars being uplevelled?
	var o_tree 

	#tailcall isEmpty $_ID_  ;#fails. because isEmpty is from >collection interface - so different ns?
	tailcall [@this@ . isEmpty .]
}
$_NODE .. Constructor {args} {
	array set A $args

	set o_tree	$A(-tree)
	set o_parent	$A(-parent)

	#array set o_data [list]
	array set o_info [list]

	set o_nodePrototype [::patternlib::>tree .. Namespace]::>node
	set o_idref [$o_tree . nodeID .]
	set o_treens [$o_tree .. Namespace]
	#set o_children [::patternlib::>collection .. Create [@this@ .. Namespace]::>children]

	#overlay children collection directly on the node
	set o_children [::patternlib::>collection .. Create @this@]

	return
}

>tree .. PatternProperty test blah
>tree .. PatternProperty nodeID 0  ;#public only so node can access.. need 'friend' concept?
>tree .. PatternVariable o_ns
>tree .. Constructor {args} {
    set o_ns [@this@ .. Namespace]

    #>tree is itself also a node (root node)
    #overlay new 'root' node onto existing tree, pass tree to constructor
    [::patternlib::>tree .. Namespace]::>node .. Create @this@ -tree @this@ -parent "" 
}




unset _NODE




#--------------------------------------------------------
#a basic binary search tree experiment
# - todo - 'scheme' property to change behaviour? e.g balanced tree
::>pattern .. Create >bst
#process_pattern_aliases ::patternlib::>bst
>bst .. PatternVariable o_NS		;#namespace
>bst .. PatternVariable o_this		;#namespace
>bst .. PatternVariable o_nodeID

>bst .. PatternProperty root ""
>bst .. Constructor {args} {
	set o_this @this@
	set o_NS [$o_this .. Namespace]
	namespace eval ${o_NS}::nodes {}
	puts stdout ">bst constructor"
	set o_nodeID 0
}
>bst .. PatternMethod insert {key args} {
	set newnode [::patternlib::>bstnode .. Create ${o_NS}::nodes::>n-[incr o_nodeID]]
	set [$newnode . key .] $key
	if {[llength $args]} {
		set [$newnode . value .] $args
	}
	if {![string length $o_root]} {
		set o_root $newnode
		set [$newnode . parent .] $o_this
	} else {
		set ipoint {}			;#insertion point
		set tpoint $o_root		;#test point
		set side {}
		while {[string length $tpoint]} {
			set ipoint $tpoint
			if {[$newnode . key] < [$tpoint . key]} {
				set tpoint [$tpoint . left]
				set side left
			} else {
				set tpoint [$tpoint . right]
				set side right
			}
		}
		set [$newnode . parent .] $ipoint
		set [$ipoint . $side .] $newnode
	}
	return $newnode
}
>bst .. PatternMethod item {key} {
	if {![string length $o_root]} {
		error "item $key not found"
	} else {
		set tpoint $o_root
		while {[string length $tpoint]} {
			if {[$tpoint . key] eq $key} {
				return $tpoint
			} else {	
				if {$key < [$tpoint . key]} {
					set tpoint [$tpoint . left]
				} else {	
					set tpoint [$tpoint . right]
				}
			}
		}
		error "item $key not found"
	}
}
>bst .. PatternMethod inorder-walk {} {
	if {[string length $o_root]} {
		$o_root . inorder-walk
	}
	puts {}
}
>bst .. PatternMethod view {} {
	array set result [list]
	
	if {[string length $o_root]} {
		array set result [$o_root . view 0 [list]]
	}
	
	foreach depth [lsort [array names result]] {
		puts "$depth: $result($depth)"
	}
	
}
::>pattern .. Create >bstnode
#process_pattern_aliases ::patternlib::>bstnode
>bstnode .. PatternProperty parent
>bstnode .. PatternProperty left	""
>bstnode .. PatternProperty right	""
>bstnode .. PatternProperty key
>bstnode .. PatternProperty value

>bstnode .. PatternMethod inorder-walk {} {
	if {[string length $o_left]} {
		$o_left . inorder-walk
	}

	puts -nonewline "$o_key "

	if {[string length $o_right]} {
		$o_right . inorder-walk
	}
	
	return
}
>bstnode .. PatternMethod  view {depth state} {
	#!todo - show more useful representation of structure 
	set lower [incr depth]
	
	if {[string length $o_left]} {
		set state [$o_left . view $lower $state]
	}

	if {[string length $o_right]} {
		set state [$o_right . view $lower $state]
	}

		
	array set s $state
	lappend s($depth) $o_key

	return [array get s]
}


#--------------------------------------------------------
#::pattern::create ::pattern::>metaObject 
#::pattern::>metaObject PatternProperty methods
#::pattern::>metaObject PatternProperty properties
#::pattern::>metaObject PatternProperty PatternMethods
#::pattern::>metaObject PatternProperty patternProperties
#::pattern::>metaObject Constructor args {
#	set this @this@
#		
#	set [$this . methods .]				[::>collection create [$this namespace]::methods]
#	set [$this . properties .]			[::>collection create [$this namespace]::properties]
#	set [$this . PatternMethods .]		[::>collection create [$this namespace]::PatternMethods]
#	set [$this . patternProperties .]	[::>collection create [$this namespace]::patternProperties]
#	 
#}



	#tidy up
	unset PV
	unset PM



#--------------------------------------------------------
::>pattern .. Create >enum
#process_pattern_aliases ::patternlib::>enum
>enum .. PatternMethod item {{idx 0}} {
	var o_array o_list
	
	if {[string is integer -strict $idx]} {
		if {$idx < 0} {
			set idx "end-[expr {abs($idx + 1)}]"
		}
		if {[catch {set o_array([lindex $o_list $idx])} result]} {
			error "no such index : '$idx'"
		} else {
			return $result	
		}
	} else {
		if {[catch {set o_array($idx)} result]} {
			error "no such index: '$idx'"
		} else {
			return $result	
		}
	}
}



#proc makeenum {type identifiers} {
#	#!!todo - make generated procs import into whatever current system context?
#
#    upvar #0 wbpbenum_${type}_number a1 wbpbenum_number_${type} a2
#
#    #obliterate any previous enum for this type
#    catch {unset a1}
#    catch {unset a2}
#
#     set n 0
#     foreach id $identifiers {
#	 	set a1($id) $n
#	 	set a2($n) $id
#	 incr n
#     }
#     proc ::${type}_to_number key [string map [list @type@ $type] {
#		 upvar #0 wbpbenum_@type@_number ary
#		 if {[catch {set ary($key)} num]} {
#		     return -code error "unknown @type@ '$key'"
#		 }
#		 return $num
#     }]
#	    
#     proc ::number_to_${type} {number} [string map [list @type@ $type] {
#	 	upvar #0 wbpbenum_number_@type@ ary
#		 if {[catch {set ary($number)} @type@]} {
#		     return -code error "no @type@ for '$number'"
#		 }
#		 return $@type@
#     }]
#     
#     #eval "namespace eval ::sysnexus {namespace export number_to_${type}; namespace export ${type}_to_number}"
#     #eval "namespace eval :: {namespace import -force sysnexus::number_to_${type} sysnexus::${type}_to_number}"
#}
#
#--------------------------------------------------------
::>pattern .. Create >nest
>nest .. PatternVariable THIS
>nest .. PatternProperty data -autoclone
>nest .. Constructor {args} {
    var o_data 
    var THIS
    set THIS @this@
    array set o_data [list]
}
>nest .. PatternMethod item {args} {
    set THIS @this@
    return [$THIS . data [join $args ,]]
}

# 
# e.g 
#	set [>nest a , b . data c .] blah
#	>nest a , b , c
#
#	set [>nest w x , y . data z .] etc
#	>nest w x , y , z
#--------------------------------------------------------

}

}


#package require patternlibtemp