Check-in [aba779d300]

# ****************************************************************************
# Synopsis:
#     arrayHasElem ?options? arrName ?keyVar? ?valueVar?
# 
# Options:
#     -remove
#         does "unset arrName($key)" iff a key has been found.
#     --
#         end of option list
# 
# Take any key (the very first) and assign it to keyVar and its value to valueVar.
# Return value is 1 iff an element has been found and 0 otherwise.
# ****************************************************************************

proc arrayHasElem {args} {
    set optli [list -remove --]
    set rm 0
    for {set i 0} {$i < [llength $args]} {incr i} {
        if {[string index [set a [lindex $args $i]] 0] ne "-"} break
        set a [::tcl::prefix match -error {-level 1} $optli $a]
        switch -- $a {
            -remove { incr rm  }
            -- { incr i;  break }
        }
    }
    # --- $i is on the first non-option.
    lassign [set akv [lrange $args $i end]] arrName aKey aValue
    switch [llength $akv] {
        0 { return -code error "missing: arrName" }
        1 { upvar 1 $arrName arr }
        2 { upvar 1 $arrName arr $aKey key }
        3 { upvar 1 $arrName arr $aKey key $aValue value }
        default { return -code error "too many arguments: $akv" }
    }
    # payload:
    if {![info exists arr]} { return 0 }
    set id [array startsearch arr]
    set nm [array nextelement arr $id]
    array donesearch arr $id
    if {$nm eq ""} { ;# check: nothing-found or ""-is-a-valid-key; (annoying!)
        # --- already 'donesearch' => no [array anymore] any more.
        if {![info exists arr([list])]} { return 0 }
    }
    set key $nm
    set value $arr($key)
    if {$rm} { unset arr($key) }
    return 1
}

# ****************************************************************************
apply {{} {
    set dct [namespace ensemble configure ::array -map]
    if {[dict exists $dct haselem]} return
    dict set dct haselem ::arrayHasElem
    namespace ensemble configure ::array -map $dct
}}

# ############################################################################
# ****************************************************************************
# Synopsis:
#     dHaselem ?-remove? dictVar ?keyVar? ?valueVar?
#    
# ****************************************************************************

proc dHaselem {args} {
    set rm 0 ;# option-handling:
    switch [llength $args] {
        0 { return -code error "dict argument missing" }
        1 { upvar 1 [lindex $args 0] d }
        default {
            if {[string index [set a [lindex $args 0]] 0] eq "-"} {
                switch -- [::tcl::prefix match {-remove} $a] {
                    -remove {
                        incr rm
                        set args [lrange $args 1 end]
                    }
                }
            }
            lassign $args dvar keyVar valueVar
            switch [llength $args] {
                0 { return -code error "dict argument missing" }
                1 { upvar 1 $dvar d }
                2 { upvar 1 $dvar d  $keyVar key }
                3 { upvar 1 $dvar d  $keyVar key  $valueVar val }
                default { return -code error "unknown arguments: $args" }
            }
        }
    }
    # payload:
    if {![info exists d]} { return 0 }
    dict for {key val} $d {
        if {$rm} { dict unset d $key }
        return 1
    }
    return 0
}

# ############################################################################
apply {{} {
    set dct [namespace ensemble configure ::dict -map]
    if {[dict exists $dct haselem]} return
    dict set dct haselem ::dHaselem
    namespace ensemble configure ::dict -map $dct
}}

# ############################################################################
# ****************************************************************************
# Synopsis:
#     lhaselem ?options? listVar ?valueVar?
#    
# Options:
#     -index index
#         only look at the required index
#     -remove
#         does remove the item iff it has been found.
#     --
#         end of option list
# 
# Return value is 1 iff an element has been found and 0 otherwise.
# ****************************************************************************

proc lhaselem {args} {
    set optli [list -index -remove --]
    set index end
    set rm 0
    switch [llength $args] {
        0 { return -code error "wrong number of arguments" }
        1 { upvar 1 [lindex $args 0] livar }
        default {
            for {set i 0} {$i < [llength $args] - 1} {incr i} {
                if {[string index [set a [lindex $args $i]] 0] ne "-"} break
                set a [::tcl::prefix match -error {-level 1} $optli $a]
                switch -- $a {
                    -index  { set index [lindex $args [incr i]] }
                    -remove { incr rm  }
                    -- { incr i;  break }
                }
            }
            # --- $i is on the first non-option.
            if {$i < [llength $args] -2} {
                return -code error "wrong number of arguments"
            } elseif {$i == [llength $args] -2} {
                upvar 1 [lindex $args end-1] livar  [lindex $args end] val
            } else {
                upvar 1 [lindex $args end] livar
            }
        }
    }
    # payload:
    if {![info exists livar]} { return 0 }
    set len [llength $livar]
    set index [string map [list end [incr len -1]] $index]
    set index [expr $index]
    if {$index < 0 || $index >= [llength $livar]} { return 0 }
    set val [lindex $livar $index]
    if {$rm} { set livar [lreplace $livar $index $index] }
    return 1
}

<th>#</th>
<th>Type</th>
<th>Tcl Version</th>
<th>Status</th>
<th>Title</th>
</tr></thead><tbody>








<tr class='project projectdraft projectdraft87 project87'>
<td valign='top'><a href='./tip/512.md'>512</a></td>
<td valign='top'>Project</td>
<td valign='top'>8.7</td>
<td valign='top'>Draft</td>
<td valign='top'># TIP 512: No stub for Tcl_SetExitProc()</td>
</tr>

<th>#</th>
<th>Type</th>
<th>Tcl Version</th>
<th>Status</th>
<th>Title</th>
</tr></thead><tbody>

<tr class='project projectdraft projectdraft87 project87'>
<td valign='top'><a href='./tip/513.md'>513</a></td>
<td valign='top'>Project</td>
<td valign='top'>8.7</td>
<td valign='top'>Draft</td>
<td valign='top'># TIP 512: Better support for &apos;agendas&apos; as arrays, dictionaries or lists</td>
</tr>
<tr class='project projectdraft projectdraft87 project87'>
<td valign='top'><a href='./tip/512.md'>512</a></td>
<td valign='top'>Project</td>
<td valign='top'>8.7</td>
<td valign='top'>Draft</td>
<td valign='top'># TIP 512: No stub for Tcl_SetExitProc()</td>
</tr>

# TIP 512: Better support for 'agendas' as arrays, dictionaries or lists
	Author:         Florian Murr <[email protected]>
	State:          Draft
	Type:           Project
	Vote:           
	Created:        02-Aug-2017
	Post-History:   
	Keywords:       Tcl,data structure
	Tcl-Version:	8.7
-----

# Abstract

This proposes new commands for Tcl to support efficient dynamically-changing
data structures.

# Proposal

The word 'agenda' has been chosen for a highly _dynamic collection_ of items,
i.e. the collection is likely to change all the time - “pulsating”.  (To
contrast the concept of an agenda with something that is not, think of `array
startseach'`+ `array nextelement` which abort the operation the very moment
any change to the array happens.)  Depending on the type of agenda, it has a
built in order, or not.

Such agendas crop up frequently in practice and Tcl should support them with
best performance and readability.  All three, better performance, better
readability and more expressivenes can be achieved simultaneously, as shown
below.  Most are familiar with agenda-types like “Stack” and “Queue”, which
can be implemented as a Tcl-list, but sometimes an array or dictionary is more
appropriate. (For an example consider Huet's unification algorithm)

The most important methods for an agenda are:

1. **check** for (non-)emptiness of the agenda
2. **put** an item on the agenda
3. **get** an item from the agenda and optionally remove it

All these operations should be O(1) and/or have maximum C-level performance.

This TIP proposes 3 functions to achieve this goal, with a synopsis close to this (details below):

1. **array haselem** ?**-remove**? _arrVar_ ?_keyVar_? ?_valueVar_?
2. **dict haselem** ?**-remove**? _dictVar_ ?_keyVar_? ?_valueVar_?
3. **lhaselem** ?_options_? _listVar_ ?_valueVar_?

Each of these functions checks the existence, gets the element and optionally
removes it in one step.  The various advantages are examined below.

## Readability Advantages

With **lhaselem** and using **lappend** to put an item on the agenda (in a Tcl
list in a variable), we can now process the elements in a Stack-agenda stack
in one single line:

    while {[lhaselem -remove -index end stack item]} {
        # use $item, lappend, ...
    }

Likewise a Queue-agenda requires just a single line:

    while {[lhaselem -remove -index 0 queue item]} {
        # use $item, lappend, ...
    }

Processing an array-agenda or dict-agenda is just as easy:

    while {[array haselem -remove arr key val]} {
        # use $key, $val, set, unset, ...
    }

These one-liners improve readability because their semantics is not scattered
upon multiple functions, that access the data multiple times and must be
mentally put together to understand it.  Their semantics is immediately
obvious, once the new functions are known.  To value how much readability
improves, consider the “payload” section in each of the prototypical
implementations (linked below) and compare that to the respective one-liner.

## Expressiveness Advantages

1. **array haselem**. Here we must pause and consider that we have a certain
   _semantic gap_ with dynamic arrays, i.e. array-agendas: Checking for
   (non-)emptiness is currently not possible with a simple O(1) operation. The
   obvious candidate `if {[array size arr]} ` is an O(N) operation. The
   alternative is using `array startseach`, `array nextelement` + `array
   donesearch` just to check whether an array is empty or not, but that is not
   appealing either. These functions are useful for more static collections,
   not for agendas. Also, typically for array-agendas cropping up in practice
   is the requirement for “anonymous access”, i.e., we need to get an element
   of the collection without having to know beforehand which specific element
   to ask for. The only direct access to array elements is currently
   `$arr($elem)`, but this is not anonymous, because you have to know `$elem`
   beforehand. With **array haselem** we gain more expressiveness, because now
   we can check (non-)emptiness with a single O(1) function call and we can
   now anonymously access an item in the collection.

2. **dict haselem**. With dicts it is not quite as bad as with arrays, but
   still we have to employ `dict for` to gain anonymous access to an
   element. And `dict size` might also not be the best we can do to check for
   (non-)emptyness, despite being an O(1) operation.

3. **lhaselem**. (see the Stack and Queue example above) 

Anyway, to have a single “atomic” operation that checks the existence, gets
the item, and optionally removes it from the collection, is a new expressive
feature.

## Performance Advantages

1. **array haselem**. At the C-level we do not need even a single hash-access
   to get an element: just pick the first one in the first bucket. And
   removing it can be done immediately, while we are at it. In contrast, when
   using current Tcl functions to get an value and remove the key, we need at
   least `if {[info exists arr]}` to check existence of the array, `array
   nextelement` to get the key, `$arr($key)` to get the value, and `unset
   arr($key)` to remove it. These employ 2 or 3 hash-accesses to get the job
   done, when in fact we need none.

2. **dict haselem**. (c.f. “payload” section in `dHaselem` in the sample
   code). We need to access the dict only once to check and remove the item,
   not twice.

3. **lhaselem**. (c.f. “payload” section in `lhaselem` in the sample code). We
   need to access the list only once to check and remove the item, not twice.

# Prototype Implementation

The [prototype implementation](../assets/513/agendas.tcl) has the desired
semantics, but does not even come close to the performance desired.  These
functions have to be implemented in C and take advantage of the internal
representation to fulfill the proposed performance gains.

# Copyright

This document has been placed in the public domain.