'''[ycl%|%nxs]''', by [PYK], is a command that manipulates values in a
'''N'''ested e'''X'''tensible heterogeneous data '''S'''tructure.



** Description **

'''nxs''' provides built-in handling for [list] and [dict%|%dictionary] types.
Other types of structures can be registered by adding command prefixes to
'''`$set`''' and '''`$get`''' that provide the same semantics as the builtin
types.

I struggled for a while to find some way to pass the extracted values back up
through the recursive calls to `nxs`, and eventually came up with this
strategy: 

======
catch {uplevel $nsetlevel [list ::tailcall lindex $struct]}
======

This takes advantage of a quirk of the implementation of `[tailcall]`,
described on the `[uplevel]` page, where `[tailcall]` doesn't itself tear
down the current level and replace it, but just calls return in the current
level after arranging for it to be replaced upon return.  It's combine with
`[catch]` to supress the `[return]` call arranged by `[tailcall]`.  It's a
bit hacky, but it works, and the alternatives weren't that appealing.

[PYK] 2015-09-23:  Update:  Now that the procedure has been divided into
`nset` and `nset_internal`, and alternative to `[catch] {[tailcall] ...}`
would be to set the result in the local scope of `nset`.

nxs is included in [ycl%|%ycl struct], along with a test suite that provides
examples.

To extract the third item from the fifth list in the second list:

======
nxs get $data 1 4 2
#or
nxs get $data {1 4 2}
======

To extract the first through third and fifth through seventh items from the fifth list in the second list:

======
nxs get $data 1 4 2 {{0 2} {4 6}}
#or
nxs get $data {1 4 2 {{0 2} {4 6}}}
======

To look up a name in the third dictionary in the second list of dictionaries:

======
nxs get $data l 0 2 d name
nxs nset data l 0 2 d name
======

To nset the same name:

======
nxs nset data l 0 2 d = name Vincentio
======

To nset the third item in a deeply nested list:

======
nxs nset data l 4 1 l = 2 newvalue
======

To replace the third item in a deeply nested list with three items that are
expanded (i.e., the list more elements than it originally did) into the
list:

======
nxs nset data l 4 1 l = 2 value1 value2 value3
======

To prepend multiple items to a deeply-nested list:

======
nxs nset data l 4 1 l = -1 value1 value2 valu3
======

To append three values to a deeply-nested list:

======
nxs nset data l 4 1 l = + value1 value2 valu3
======

To unset the fourth item in a deeply-nested list

======
nxs nset data l 4 1 l - 3
======

To unset range ranges of items in a deeply-nested list

====== 
nxs nset data l 4 1 l - {2 5} {7 10}
======



** Code **


======
#! /bin/env tclsh

if 0 {
    Use {ycl ns dupensemble} to duplicate and specialize this namespace . To
    add handlers for a new structure,  choose an unused name add to $set and
    $unset command prefixes conforming to the semantics of the built-in
    handlers. 
}

# When args is empty , set nothing , return the indicated indices .

# When args is a list containing only the empty string , set the specified
# items to the empty string

# When keys is empty , operate on the primary value 
variable set {
    d {apply {{op name keys args} {
        upvar 1 $name var

        if {[llength $args]} {
            set res {}

            if {[llength $args] % 2 && [llength $keys]} {
                set args [list [lindex $keys end] {*}$args]
                set keys [lreplace $keys[set keys {}] end end]
            }
            foreach {key val} $args {
                dict set var {*}$keys $key $val[::set val {}]
                dict set res {*}$keys $key [dict get $var {*}$keys $key]
            }
        } else {
            set res [dict get $var {*}$keys]
        }

        if {[info exists outer]} {
            dict set outer {*}$keys $var
            set var $outer
        }
        return $res
    }}}
    l {apply {{op name keys args} {
        upvar 1 $name var
        set keycount [llength $keys]
        set valscount [llength $args]
        set i 0
        set lastval {}
        if {[llength $args]} {
            foreach key $keys val $args {
                if {$i >= $valscount} {
                    set val $lastval
                } else {
                    set lastval $val
                }
                if {[llength $key] == 2}  {
                    lassign $key[set key {}] firstkey lastkey
                } else {
                    set firstkey $key
                    set lastkey $key
                }
                if {$i == $keycount -1} {
                    set val [list $val {*}[lrange $args[set args {}] $i+1 end]]
                    if {$key eq {+}} {
                        lappend var {*}$val
                    } else {
                        set var [lreplace $var[set var {}] $firstkey $lastkey {*}$val]
                    }
                } else {
                    if {$key eq {+}} {
                        lappend var $val
                    }
                    set var [lreplace $var[set var {}] $firstkey $lastkey $val]
                }
                incr i
                if {$i >= $keycount} break 
            }
            return $var
        } else {
            foreach key $keys {
                if {[llength $key] == 2} {
                    lassign $key[set key {}] firstkey lastkey
                    lappend res [lrange $var $firstkey $lastkey]
                } else {
                    lappend res [lindex $var $key]
                }
            }
            if {[llength $res] == 1} {
                set res [lindex $res[set res {}] 0]
            }
            return $res
        }
    }}}
}


variable unset {
    d {apply {{op name keys} {
        upvar 1 $name var
        foreach key $keys {
            dict unset var $key 
        }
        return $var
    }}}
    l {apply {{op name indices} {
        set res {}
        upvar 1 $name var
        foreach index $indices {
            # Make sure to return the result as a list if a range was provided,
            # or as single value if an index was provided
            if {[llength $index] == 2} {
                lassign $index[set index {}] first last
                lappend res [lrange $var $first $last]
            } else {
                lappend res [lindex $var $index]
                set first $index
                set last $index
            }
            set var [lreplace $var[set var {}] $first $last]
        }
        if {[llength $res] == 1} {
            set res [lindex $res[set res {}] end]
        }
        return $res
    }}}
}

proc nget {struct args} {
    nset struct {*}$args
}

variable doc::set {
    description {

        Set and retrieve values in a nested heterogeneous structure .
    }
    args {

        synopsis {
            set varname ?KEYTYPE KEYS ...? ?OPERATOR KEYTYPE|ARGUMENT? ...
        }
        args {

            Each key type is followed by a sequence keys indicating which nodes
            to traverse , with the final key being itself a list of keys
            indicating which items to select. If there is only one argument
            between key types, that argument interpreted as if its items had
            occurred as individual key arguments.  The items specified by
            theargumetns are returned.  If an operator occurs in the position
            of a key type , subsequent arguments are processed as defined for
            that operator before the results are returned .


            builtin key types 

                d
                    dictionary

                    operators

                        =

                            If the key list is empty , the entire dictionary is
                            replaced . If the key listcontains exactly one
                            items and there is an odd number of subsequent
                            arguments , the items in the key list is
                            considered the first key , the next argument the
                            first value , and remaining arguments alternating
                            keys and values , which are all set in the
                            dictionary . 



                        -

                            Each argument is a key in the dictionary to unset .

                l

                    list


                    operators

                        =
                            The key list contains indices or ranges , as
                            describe for [lrange] , of items to replace .  If
                            keylist is empty , the entire list is replaced .
                            If there is one argument , it is the value to be
                            set .  If there are multiple arguments each
                            argument becomes an additional value in the
                            modified list , in the same fashion as with the {*}
                            Tcl operator .  This replacement happens
                            individually for each index in KEYLIST. The
                            selection is finalized before any replacement is
                            performed , and as replacement proceeds , the
                            remaining selections are adjusted so that the
                            replacement affects values indicated by the index
                            before the beginning of the entire operation .  If
                            there are no values , the selected items in are
                            removed from the list . If the key list is empty ,
                            the entire list is replaced with the value . Each
                            index or range consumes one argument , and the
                            final index or range consumes the remaining
                            arguments .

                        -

                            Each argument is an index to unset . If the
                            argument is a two-items list , it is a range , as
                            described for [lrange] .

        }
    }
}
proc nset {name args} {
    set nsetlevel -1 
    upvar 1 $name struct
    nset_internal struct {*}$args
}

proc nset_internal {name args} {
    upvar 1 nsetlevel nsetlevel
    incr nsetlevel
    variable set
    variable unset
    upvar 1 $name struct
    set length [llength $args]
    set args [lassign $args[set args {}] type keys]
    if {[info exists struct]} {
        set prevstruct $struct
    }

    if {$keys in {= -}} {
        set op $keys
        set args [lassign $args[set args {}] keys]
        switch $op {
            - {
                set res [ 
                    {*}[dict get $unset $type] $op struct [list $keys {*}$args]]
            }
            =  {
                if {$keys eq {}} {
                    set res [set struct $args]
                } else {
                    set res [{*}[dict get $set $type] $op struct $keys {*}$args]
                }
            }
        }
        catch {uplevel $nsetlevel [list ::tailcall lindex $res]}
    } elseif {$args == 1} {
        tailcall [lindex [info level 0] 0] $name $type $keys = {*}$args
    } else {
        while {[llength $args] > 0 && [lindex $args 0] ni {= -}
            && ![dict exists $set [lindex $args 0]]} {
            # Must be another key
            set args [lassign $args[set args {}] key]
            lappend keys $key
        }

        if {[llength $keys] > 1} {
            set keys [lassign $keys[set keys {}] key1]
            # Expand key here so that in the future , multiple branches can
            # be manipulated .
            set struct [{*}[dict get $set $type] {} prevstruct {*}$key1]
            #Reduce the reference count of the Tcl_Obj behind $struct
            {*}[dict get $set $type] {} prevstruct {*}$key1

            set oldnsetlevel $nsetlevel
            set nsetlevel -1
            set struct2 [[lindex [info level 0] 0] struct $type $keys {*}$args]
            set nsetlevel $oldnsetlevel
            catch {uplevel $nsetlevel [list ::tailcall lindex $struct2]}


            {*}[dict get $set $type] {} prevstruct $key1 $struct
            set struct $prevstruct[set prevstruct $struct; list]

        } else {
            set struct [{*}[dict get $set $type] {} prevstruct $keys]
            #Reduce the reference count of the Tcl_Obj behind $struct
            {*}[dict get $set $type] {} prevstruct $keys {}

            if {[llength $args]} {
                [lindex [info level 0] 0] struct {*}$args
            } else {
                catch {uplevel $nsetlevel [list ::tailcall lindex $struct]}
            }
            {*}[dict get $set $type] {} prevstruct $keys $struct
            set struct $prevstruct[set prevstruct $struct; list]
        }

    } 
    incr nsetlevel -1
    return
}
======