A nested list is simply a list that occurs as an element of another list (which may of course itself be an element of another list, etc.).
Common reasons nested lists arise are:
[Discuss when using a nested list is important or useful - what are cases where it is a good solution]
Before Tcl 8.4, nested lists were quite difficult to work with -- getting nested elements required nesting lindex commands, and the nightmare of setting elements in nested lists without the help of lset is better forgotten -- and as a result older code often uses arrays even in cases where the first-class data status (being possible to pass by value) of a list would have been very useful.
[Discuss which Tcl built in commands can be used to build, search, and maintain the list]
In LISP, lists are built by linking "cons cells", which is simply a pair of values (typically implemented close to the hardware, e.g. as a C-struct of two pointers; a Tcl_Obj is a higher level concept) where the first (the head) by convention is the first list element and the second (the tail) is the rest of the list; in the last cell of a list the tail pointer is NULL. The following is (yet another) implementation of this, with Tcl lists of length 2 serving as cons cells. It is probably not of any practical interest.
FM: Maybe an higher concept level has some higher conceptuals properties. Who knows ? A Tcl'ers is always dealing with such things, so why do not have some proc to experiment with it ?
set nl2 {
{2lindex {translate between nest list index and list index}}
{append {append at the end of the 2-length nested list variable (like lappend)}}
{assign {assign each member of the 2-length nested list value to variables (like lassign)}}
{concat {To do : concat for list work on non-list object too, so I haven't find what to do for this command}}
{flat {convert a 2-length nested list value as a flat list}}
{index {retrieve one or all element of the 2-length nested list value}}
{insert {insert one element at the place specified to a 2-length nested list value - return a new value}}
{iorder {return the list of the subindex in the order of a specific nested list}}
is {
{left {test if the given object value is a 2-length left nested list}}
{right {test if the given object value is a 2-length right nested list}}
{mixed {test if the given object value is a 2-length left nested list, whose elements are 2-length right nested list and vice-versa}}
}
{join {convert the nested list as a string in the style of join for list}}
{left {make a left nested list with all arguments}}
{length {return the depth of the nested list}}
{merge {merge a right 2-length nested list with a left 2-length nested list to a middle 3-length nested list }}
{merge-left {merge a right 2-length nested list with a left 2-length nested list to a left 3-length nested list}}
{merge-right {merge a right 2-length nested list with a left 2-length nested list to a left 3-length nested list}}
{merge-dict {merge a right 2-length nested list with a left 2-length nested list as a dict}}
{range {return a range of elements of a 2-length nested list value ans return it as nested list}}
repeat {
left {like lrepeat but make a left 2-length nested list}
right {like lrepeat but make a right 2-length nested list}
}
{reverse {reverse the order of a 2-length nested list value}}
{rindice {return the recursif indice (nest indice) of a specific nested list}}
{right {make a left nested list with all arguments}}
{search {like lsearch for 2-length nested list}}
{sort {like sort for 2-length nested list}}
{set {set an element of a 2-length nested list variable}}
{transpose {change a 2-length left nested list value in a 2 length right nested list value (and vice-versa)}}
{type {return the type of the 2-length nested list, if any, return "" otherwise}}
{{!type} {return the type "left" for a right 2-length nested list value, or "right" for a left 2-length nested list}}
}
namespace eval nl2 {
proc 2lindex {type index} {
::set nl nl[::set len 2]
::set depth [expr {($index)/($len-1)}]
::set reste [expr {($index)%($len-1)}]
return [list {*}[lrepeat [expr {$depth}] [$nl rindice $type]] [lindex [$nl iorder $type] $reste]]
}
proc append {L args} {
# nl2 append ...
::upvar $L nl
::if {[::set type [nl2 type $nl]] ne ""} {
::set l [nl2 flat $nl]
::set nl [nl2 $type {*}[lappend l {*}$args]]
return $nl
} else {
return -error -message "bad list type"
}
}
proc assign {L varname args} {
# nl2 assign ...
if {[nl2 is left $L]} {
return [nl2 left {*}[uplevel [subst {lassign {[nl2 flat $L]} $varname $args}]]]
} elseif {[nl2 is right $L]} {
return [nl2 right {*}[uplevel [subst {lassign {[nl2 flat $L]} $varname $args}]]]
}
}
proc concat {} {
# nl2 concat ...
# to do, but what ?
}
proc flat {L} {
# nl2 flat ...
::if {[nl2 is left $L]} {
::for {::set i 1} {[::llength [::lindex $L {*}$i]]!=0} {::set i [::linsert $i 0 0]} {
::lappend Res {*}[::lindex $L {*}$i]
}
return $Res
} elseif {[nl2 is right $L]} {
::for {::set i 0} {[::llength [::lindex $L {*}$i]]!=0} {::set i [::linsert $i 0 1]} {
::lappend Res {*}[::lindex $L {*}$i]
}
return $Res
}
}
proc index {L args} {
# nl2 index ...
::return [::lindex [nl2 flat $L] $args]
}
proc insert {L index element args} {
# nl2 insert ...
if {[nl2 is left $L]} {
::return [nl2 left {*}[linsert [nl2 flat $L] $index $element {*}$args]]
} elseif {[nl2 is right $L]} {
::return [nl2 right {*}[linsert [nl2 flat $L] $index $element {*}$args]]
}
}
proc iorder {type} {
# nl3 iorder ...
switch -- $type {
left {return 1}
right {return 0}
default {return ""}
}
}
namespace eval is {
proc left {L} {
# nl2 is left ...
::set res 1
::if {[::llength $L] == 2 && [::llength [::lindex $L 0]] == 0} {
::set res 1
} elseif {[::llength $L] == 2 && [::llength [::lindex $L 0]] == 2} {
::set res [nl2 is left [::lindex $L 0]]
} else {
::set res 0
}
::set res
}
proc mixed {L} {
# nl2 is mixed ...
set res 0
if {[set type [nl2 type $L]] eq ""} {return $res}
set res 1
foreach e [nl2 index $L] {
set res [expr {$res && ([nl2 !type $e] eq $type)}]
}
return $res
}
proc right {L} {
# nl2 is right ...
::set res 1
::if {[::llength $L] == 2 && [::llength [::lindex $L 1]] == 0} {
::set res 1
} elseif {[::llength $L] == 2 && [::llength [::lindex $L 1]] == 2} {
::set res [nl2 is right [::lindex $L 1]]
} else {
::set res 0
}
::set res
}
namespace export *
namespace ensemble create
}
proc join {L {sz { }}} {
# nl2 join ...
::join [nl2 flat $L] $sz
}
proc left {args} {
# nl2 left ...
::set L [::list ""]
::set i 0
::foreach e $args {
if {[::llength $e] != 1} {::set e [list $e]}
::lset L {*}$i [::list "" $e]
::lappend i 0
}
::return {*}$L
}
proc length {L} {
# nl2 length ...
::set j 1
::if {[nl2 is left $L]} {
::for {::set i 0} {[::llength [::lindex $L {*}$i]]!=0} {::lappend i 0; incr j} {}
} elseif {[nl2 is right $L]} {
::for {::set i 1} {[::llength [::lindex $L {*}$i]]!=0} {::lappend i 1; incr j} {}
} else {
::set j 0
}
::return $j
}
proc merge {L0 L1} {
if {[nl2 is left $L0] && [nl2 is right $L1]} {
::set L [list {}]; ::set i {}
foreach e0 [nl2 index $L0] e1 [nl2 index $L1] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
lset L 0 {*}$i [list $e0 {} $e1]
::set i [linsert $i 0 1]
}
return {*}$L
} elseif {[nl2 is left $L1] && [nl2 is right $L0]} {
::set L [list {}]; ::set i {}
foreach e0 [nl2 index $L1] e1 [nl2 index $L0] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
lset L 0 {*}$i [list $e0 {} $e1]
::set i [linsert $i 0 1]
}
return {*}$L
}
}
proc merge-dict {L0 L1} {
if {[nl2 is left $L0] && [nl2 is right $L1]} {
foreach e0 [nl2 index $L0] e1 [nl2 index $L1] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
::lappend L $e0 $e1
}
return $L
} elseif {[nl2 is left $L1] && [nl2 is right $L0]} {
foreach e0 [nl2 index $L0] e1 [nl2 index $L1] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
::lappend L $e0 $e1
}
return $L
}
}
proc merge-left {L0 L1} {
if {[nl2 is left $L0] && [nl2 is right $L1]} {
::set L [list {}]; ::set i {}
foreach e0 [nl2 index $L0] e1 [nl2 index $L1] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
lset L 0 {*}$i [list {} $e0 $e1]
::set i [linsert $i 0 0]
}
return {*}$L
} elseif {[nl2 is left $L1] && [nl2 is right $L0]} {
::set L [list {}]; ::set i {}
foreach e0 [nl2 index $L1] e1 [nl2 index $L0] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
lset L 0 {*}$i [list {} $e0 $e1]
::set i [linsert $i 0 0]
}
return {*}$L
}
}
proc merge-right {L0 L1} {
if {[nl2 is left $L0] && [nl2 is right $L1]} {
::set L [list {}]; ::set i {}
foreach e0 [nl2 index $L0] e1 [nl2 index $L1] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
lset L 0 {*}$i [list $e0 $e1 {}]
::set i [linsert $i 0 2]
}
return {*}$L
} elseif {[nl2 is left $L1] && [nl2 is right $L0]} {
::set L [list {}]; ::set i {}
foreach e0 [nl2 index $L1] e1 [nl2 index $L0] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
lset L 0 {*}$i [list $e0 $e1 {}]
::set i [linsert $i 0 2]
}
return {*}$L
}
}
proc range {L debut fin} {
# nl2 range ...
if {[nl2 is left $L]} {
::return [nl2 left {*}[::lrange [nl2 flat $L] $debut $fin]]
} elseif {[nl2 is right $L]} {
::return [nl2 right {*}[::lrange [nl2 flat $L] $debut $fin]]
}
}
namespace eval repeat {
proc left {count element args} {
# nl2 left repeat ...
::return [nl2 left {*}[lrepeat $count $element {*}$args]]
}
proc right {count element args} {
# nl2 left repeat ...
::return [nl2 right {*}[lrepeat $count $element {*}$args]]
}
namespace export *
namespace ensemble create
}
proc reverse {L} {
# nl2 reverse ...
if {[nl2 is left $L]} {
return [nl2 left {*}[lreverse [nl2 flat $L]]]
} elseif {[nl2 is right $L]} {
return [nl2 right {*}[lreverse [nl2 flat $L]]]
}
}
proc right {args} {
# nl2 right ...
::set L [::list ""]
::set i 0
::foreach e $args {
if {[::llength $e] != 1} {::set e [::list $e]}
::lset L {*}$i [::list $e ""]
::lappend i 1
}
::return {*}$L
}
proc rindice {type} {
switch -- $type {
left {return 0}
right {return 1}
default {return ""}
}
}
proc search {args} {
# nl2 search ...
::set options [lassign [lreverse $args] pattern L]
if {"-inline" in $options} {
if {[nl2 is left $L]} {
::return [nl2 left {*}[::lsearch {*}$options [nl2 flat $L] $pattern]]
} elseif {[nl2 is right $L]} {
::return [nl2 right {*}[::lsearch {*}$options [nl2 flat $L] $pattern]]
}
} else {
::return [::lsearch {*}$options [nl2 flat $L] $pattern]
}
}
proc sort {args} {
# nl2 sort ...
::set options [lassign [lreverse $args] L]
if {[nl2 is left $L]} {
::return [nl2 left {*}[lsort {*}$options [nl2 flat $L]]]
} elseif {[nl2 is right $L]} {
::return [nl2 right {*}[lsort {*}$options [nl2 flat $L]]]
}
}
proc set {args} {
# nl2 set ...
::set args [lassign $args L]
upvar $L nl
::set index [lassign [lreverse $args] newValue]
if {[nl2 is left $nl]} {
::set nl [nl2 flat $nl]
::return [::set nl [nl2 left {*}[lset nl {*}$index $newValue]]]
} elseif {[nl2 is right $nl]} {
::set nl [nl2 flat $nl]
::return [::set nl [nl2 right {*}[lset nl {*}$index $newValue]]]
}
}
proc transpose {type L} {
# nl2 transpose ...
return [nl2 $type {*}[nl2 flat $L]]
}
proc type {L} {
if {[nl2 is right $L]} {
return "right"
} elseif {[nl2 is left $L]} {
return "left"
}
}
proc !type {L} {
if {[nl2 is right $L]} {
return "left"
} elseif {[nl2 is left $L]} {
return "right"
}
}
namespace export *
namespace ensemble create
}
package provide nl2 0.1if 0 {
The nl2 package has an interface that is close to that of list, making it so easy to remember, with some extra functionality added. There is indoubtly some bugs, please tell me.
Let's test it :
}
console show
puts [set Left [nl2 left A B C]]
# {{{} C} B} A
puts [nl2 is left $Left]
# A
puts [nl2 type $Left]
# left
puts [nl2 !type $Left]
# right
puts "index 0 : [nl2 index $Left 0], index 1 : [nl2 index $Left 1], index 2 : [nl2 index $Left 2], index all : [nl2 index $Left]"
# index 0 : A, index 1 : B, index C : 3, index all : A B C
puts [set Middle [nl2 merge $Left $Right]]
# gives
# {1 {2 {3 {} C} B} A} if 0 {
i.e. a purely nested list of 3 constant length.
How to access such list ? Let's introduce a proc which give all valid indices of a list
}
proc spectre {L {indice 0}} {
set i 0
set Spectre [list]
set Map {
{L i} {
foreach a $L {
lappend res [linsert $a 0 $i]
}
set res
}
}
if {[llength $L] > 0} {
foreach a $L {
if {[llength $a] > 1} {
lappend Spectre {*}[::apply $Map [spectre $a $indice] $i]
} else {
lappend Spectre [list $i]
}
incr i
}
}
return $Spectre
}if 0 {
We have :
}
spectre $Left
# == {0 0 0} {0 0 1} {0 1} 1
spectre $Right
# == 0 {1 0} {1 1 0} {1 1 1}
spectre $Middle
# == 0 {1 0} {1 1 0} {1 1 1} {1 1 2} {1 2} 2if 0 {
So, the first element of a 2-length left-nested list is at index 1. the next element is found in inserting a 0 in the index list of the current element
The first element of a 2-length right-nested list is at index 0. the next element is found in inserting a 1 in the index list of the current element
For 3-length middle-nested list, the first element is at index 0, the second is at index 2. the next element is found :
Given the lists Left and Right, as used just above :
}
puts [set Left [nl2 left A B C]]
# {{{} C} B} A
puts [set Right [nl2 right A B C]]
# A {B {C {}}}
puts [expr {$Left eq $Right}]
# 0if 0 {
The last command shows the more interesting property : even with the same data, even sorted, Left nested lists are always different from Right nested list and that can be tested. It's like a basic type, since extra information is encoded in the structure. Each kind of purely nested list could be seen as a different type, for instance
To illustrate that, let's imagine a proc which is use to configure a widget.
}
interp alias {} isOptions {} nl2 is left
interp alias {} isPack {} nl2 is right
proc confwidget {args} {
foreach l $args {
if {[isOptions $l]} {
puts "widget configure {*}[nl2 index $l]"
} elseif {[isPack $l]} {
puts "pack configure widget {*}[nl2 index $l]"
} else {
foreach {e0 e1} $l {
puts "bind widget $e0 $e1"
}
}
}
}
set Option [nl2 left -bg red -borderwidth 2 -relief flat -text hello]
# {{{{{{{{} hello} -text} flat} -relief} 2} -borderwidth} red} -bg
set Pack [nl2 right -after Other -side left -expand 1 -fill both]
# -after {Other {-side {left {-expand {1 {-fill {both {}}}}}}}}
set Bind [dict create <Button-1> {script1} <Button-2> {script2}]
# <Button-1> script1 <Button-2> script2
confwidget $Option
# widget configure {*}-bg red -borderwidth 2 -relief flat -text hello
confwidget $Pack
# pack configure widget {*}-after Other -side left -expand 1 -fill both
confwidget $Bind
# bind widget <Button-1> script1
# bind widget <Button-2> script2
# or, doing with all kind :
confwidget $Pack $Option $Bind
# pack configure widget {*}-after Other -side left -expand 1 -fill both
# widget configure {*}-bg red -borderwidth 2 -relief flat -text hello
# bind widget <Button-1> script1
# bind widget <Button-2> script2
# in another order :
confwidget $Option $Pack $Bind
# widget configure {*}-bg red -borderwidth 2 -relief flat -text hello
# pack configure widget {*}-after Other -side left -expand 1 -fill both
# bind widget <Button-1> script1
# bind widget <Button-2> script2if 0 {
Temporary conclusion : purely nested lists can be used as a pseudo-type. That's not a big suprise. A C-struct can be easily indexed, and also verified, since its length in memory is constant. So should it be for purely-nested list, since their llength are constant (at least if they are constructed with a {} terminator). At each level of representation, high or low, this is the regularity of the structure which helps a programmer to deal with.
FM Using the same principles, here is an interface to deal with purely nested list of 3 constant llength. Such lists are of 3 kinds : I choose to name them left, right and middle. Example :
}
set L [nl3 left A B C D E F]; # == {{{} F E} D C} B A
set M [nl3 middle A B C D E F]; # == A {C {E {} F} D} B
set R [nl3 right A B C D E F]; # == A B {C D {E F {}}}
spectre $L; # == {0 0 0} {0 0 1} {0 0 2} {0 1} {0 2} 1 2
spectre $M; # == 0 {1 0} {1 1 0} {1 1 1} {1 1 2} {1 2} 2
spectre $R; # == 0 1 {2 0} {2 1} {2 2 0} {2 2 1} {2 2 2}if 0 {
}
namespace eval nl3 {
proc 2lindex {type index} {
::set nl nl[::set len 3]
::set depth [expr {($index)/($len-1)}]
::set reste [expr {($index)%($len-1)}]
return [list {*}[lrepeat [expr {$depth}] [$nl rindice $type]] [lindex [$nl iorder $type] $reste]]
}
proc append {L args} {
# nl3 append ...
::upvar $L nl
::if {[::set type [nl3 type $nl]] ne ""} {
::set l [nl3 flat $nl]
::set nl [nl3 $type {*}[lappend l {*}$args]]
return $nl
} else {
return -error -message "bad list type"
}
}
proc assign {L varname args} {
# nl3 assign ...
if {[::set type [nl3 type $L]] ne ""} {
return [nl3 $type {*}[uplevel [subst {lassign {[nl3 flat $L]} $varname $args}]]]
}
}
# proc concat {} {
# # nl3 concat ...
# # to do
# }
proc depth {L} {
if {[::set type [nl3 type $L]] ne {}} {
::return [expr {[nl3 length $L]/2}]
}
}
proc flat {L} {
# nl3 flat ...
if {[::set type [nl3 type $L]] ne {}} {
::for {::set i {}} {[::llength [::lindex $L {*}$i]]!=0} {::set i [::linsert $i 0 [nl3 rindice $type]]} {
foreach j [nl3 iorder $type] {
::lappend Res {*}[::lindex $L {*}$i $j]
}
}
return $Res
}
}
proc flat-dict {L} {
# nl3 flat ...
::if {[nl3 is left $L]} {
::for {::set i {}} {[::llength [::lindex $L {*}$i]]!=0} {::set i [::linsert $i 0 0]} {
dict set Res {*}[::lindex $L {*}$i 2] {*}[::lindex $L {*}$i 1]
}
return $Res
} elseif {[nl3 is middle $L]} {
::for {::set i {}} {[::llength [::lindex $L {*}$i]]!=0} {::set i [::linsert $i 0 1]} {
dict set Res {*}[::lindex $L {*}$i 0] {*}[::lindex $L {*}$i 2]
}
return $Res
} elseif {[nl3 is right $L]} {
::for {::set i {}} {[::llength [::lindex $L {*}$i]]!=0} {::set i [::linsert $i 0 2]} {
dict set Res {*}[::lindex $L {*}$i 0] {*}[::lindex $L {*}$i 1]
}
return $Res
}
}
proc index {L args} {
# nl3 index ...
::return [::lindex [nl3 flat $L] $args]
}
proc insert {L index element args} {
if {[::set type [nl3 type $L]] ne ""} {
::return [nl3 $type {*}[linsert [nl3 flat $L] $index $element {*}$args]]
}
}
proc iorder {type} {
# nl3 iorder ...
switch -- $type {
left {return [list 2 1]}
middle {return [list 0 2]}
right {return [list 0 1]}
default {return ""}
}
}
namespace eval is {
proc left {L} {
# nl3 is left ...
::set res 1
::if {[::llength $L] == 3 && [::llength [::lindex $L 0]] == 0} {
::set res 1
} elseif {[::llength $L] == 3 && [::llength [::lindex $L 0]] == 3} {
::set res [nl3 is left [::lindex $L 0]]
} else {
::set res 0
}
::set res
}
proc middle {L} {
# nl3 is middle ...
::set res 1
::if {[::llength $L] == 3 && [::llength [::lindex $L 1]] == 0} {
::set res 1
} elseif {[::llength $L] == 3 && [::llength [::lindex $L 1]] == 3} {
::set res [nl3 is middle [::lindex $L 1]]
} else {
::set res 0
}
::set res
}
proc right {L} {
# nl3 is right ...
::set res 1
::if {[::llength $L] == 3 && [::llength [::lindex $L 2]] == 0} {
::set res 1
} elseif {[::llength $L] == 3 && [::llength [::lindex $L 2]] == 3} {
::set res [nl3 is right [::lindex $L 2]]
} else {
::set res 0
}
::set res
}
namespace export *
namespace ensemble create
}
proc join {L {sz " "}} {
# nl3 join ...
::join [nl3 flat $L] $sz
}
proc left {args} {
# nl3 left ...
::set L [::list ""]
::set i 0
::set Reste [expr [llength $args]%2]
::foreach {e0 e1} [lrange $args 0 end-$Reste] {
if {[::llength $e0]!=1} {::set e0 [list $e0]}
if {[::llength $e1]!=1} {::set e1 [list $e1]}
::lset L {*}$i [::list "" $e1 $e0]
::lappend i 0
}
if {$Reste > 0} {
lassign [lrange $args end-[expr {$Reste-1}] end] e0 e1
if {[::llength $e0]>1} {::set e0 [list $e0]}
if {[::llength $e1]>1} {::set e1 [list $e1]}
::lset L {*}$i [::list "" $e1 $e0]
}
::return {*}$L
}
proc length {L} {
# nl3 length ...
if {[::set type [nl3 type $L]] ne {}} {
::return [::llength [nl3 flat $L]]
}
}
proc merge {L0 L1} {
# nl3 merge ...
if {([::set type0 [nl3 type $L0]] ne {}) && ([::set type1 [nl3 type $L1]] ne {})} {
::set L [::list ""]
::set i 0
foreach {e00 e01} [nl3 flat $L0] {e10 e11} [nl3 flat $L1] {
if {[::llength $e00]!=1} {::set e00 [list $e00]}
if {[::llength $e01]!=1} {::set e01 [list $e01]}
if {[::llength $e10]!=1} {::set e10 [list $e10]}
if {[::llength $e11]!=1} {::set e11 [list $e11]}
lappend TempList $e00 $e01 $e11 $e10
::set TempList [linsert $TempList [::set r [expr {[nl3 rindice $type0]+[nl3 rindice $type1]}]] ""]
::lset L {*}$i $TempList
unset TempList
lappend i $r
}
return {*}$L
}
}
proc merge-dict {} {
# nl3 merge-dict ...
# source ./nl3/merge-dict/id.tcl
}
proc middle {args} {
# nl3 middle ...
::set L [::list ""]
::set i 0
::set Reste [expr [llength $args]%2]
::foreach {e0 e1} [lrange $args 0 end-$Reste] {
if {[::llength $e0]!=1} {::set e0 [list $e0]}
if {[::llength $e1]!=1} {::set e1 [list $e1]}
::lset L {*}$i [::list $e0 "" $e1]
::lappend i 1
}
if {$Reste > 0} {
lassign [lrange $args end-[expr {$Reste-1}] end] e0 e1
if {[::llength $e0]>1} {::set e0 [list $e0]}
if {[::llength $e1]>1} {::set e1 [list $e1]}
::lset L {*}$i [::list $e0 "" $e1]
}
::return {*}$L
}
proc range {L debut fin} {
# nl3 range ...
if {[::set type [nl3 type $L]] ne {}} {
::return [nl3 $type {*}[::lrange [nl3 flat $L] $debut $fin]]
}
}
proc repeat {type count args} {
return [nl3 $type {*}[lrepeat $count {*}$args]]
}
proc nindex {L nindex {index {}}} {
if {[::set type [nl3 type $L]] ne {}} {
if {[string match end* $nindex]} {
if {[::set less [lindex [split $nindex -] 1]] ne {}} {
::set nindex [expr {[nl3 depth $L]-$less-1}]
} else {
::set nindex [expr {[nl3 depth $L]-1}]
}
}
::for {::set I 0; ::set i {}} {[::llength [::lindex $L {*}$i]]!=0} {::set i [::linsert $i 0 [nl3 rindice $type]]} {
if {$I == $nindex} {
foreach j [nl3 iorder $type] {
::lappend Res {*}[::lindex $L {*}$i $j]
}
return [lindex $Res {*}$index]
}
incr I
}
}
}
proc reverse {L} {
# nl3 reverse ...
if {[::set type [nl3 type $L]] ne {}} {
return [nl3 $type {*}[lreverse [nl3 flat $L]]]
}
}
proc rindice {type} {
switch -- $type {
left {return 0}
middle {return 1}
right {return 2}
default {return ""}
}
}
proc right {args} {
# nl3 right ...
::set L [::list ""]
::set i 0
::set Reste [expr [llength $args]%2]
::foreach {e0 e1} [lrange $args 0 end-$Reste] {
if {[::llength $e0]!=1} {::set e0 [list $e0]}
if {[::llength $e1]!=1} {::set e1 [list $e1]}
::lset L {*}$i [::list $e0 $e1 ""]
::lappend i 2
}
if {$Reste > 0} {
if {[::llength $e0]>1} {::set e0 [list $e0]}
if {[::llength $e1]>1} {::set e1 [list $e1]}
lassign [lrange $args end-[expr {$Reste-1}] end] e0 e1
::lset L {*}$i [::list $e0 $e1 ""]
}
::return {*}$L
}
proc search {args} {
# nl3 search ...
::set options [lassign [lreverse $args] pattern L]
if {[::set type [nl3 type $L]] ne {}} {
if {"-inline" in $options} {
::return [nl3 $type {*}[::lsearch {*}$options [nl3 flat $L] $pattern]]
} else {
::return [::lsearch {*}$options [nl3 flat $L] $pattern]
}
}
}
proc set {args} {
# nl3 set ...
::set args [lassign $args L]
upvar $L nl
if {[::set type [nl3 type $nl]] ne {}} {
::set index [lassign [lreverse $args] newValue]
::set nl [nl3 flat $nl]
::return [::set nl [nl3 $type {*}[lset nl {*}$index $newValue]]]
}
}
proc sort {args} {
# nl3 sort ...
::set options [lassign [lreverse $args] L]
if {[::set type [nl3 type $L]] ne {}} {
::return [nl3 $type {*}[lsort {*}$options [nl3 flat $L]]]
}
}
proc transpose {type L} {
# nl3 transpose ...
::return [nl3 $type {*}[nl3 flat $L]]
}
proc type {L} {
# nl3 type ...
if {[nl3 is left $L]} {
return "left"
} elseif {[nl3 is middle $L]} {
return "middle"
} elseif {[nl3 is right $L]} {
return "right"
} else {
return
}
}
namespace export *
namespace ensemble create
}
package provide nl3 0.1if 0 {
for a long application, see Trees as nested lists
FM Using the same principles, here is an interface to deal with purely nested list of 4 constant llength. Such lists are of 4 kinds : I choose to name them east, north, south, west.
}
namespace eval nl4 {
proc 2lindex {type index} {
::set nl nl[::set len 4]
::set depth [expr {($index)/($len-1)}]
::set reste [expr {($index)%($len-1)}]
return [list {*}[lrepeat [expr {$depth}] [$nl rindice $type]] [lindex [$nl iorder $type] $reste]]
}
proc append {L args} {
# nl4 append ...
::upvar $L nl
::if {[::set type [nl4 type $nl]] ne ""} {
::set l [nl4 flat $nl]
::set nl [nl4 $type {*}[lappend l {*}$args]]
return $nl
} else {
return -error -message "bad list type"
}
}
proc assign {L varname args} {
# nl4 assign ...
if {[::set type [nl4 type $L]] ne ""} {
return [nl4 $type {*}[uplevel [subst {lassign {[nl4 flat $L]} $varname $args}]]]
}
}
# proc concat {} {
# # nl4 concat ...
# # source ./nl4/concat/id.tcl
# }
proc depth {L} {
if {[::set type [nl4 type $L]] ne {}} {
::return [expr {[nl4 length $L]/3}]
}
}
proc east {args} {
# nl4 east ...
::set L [::list ""]
::set i 0
::set Reste [expr [llength $args]%3]
::foreach {e0 e1 e2} [lrange $args 0 end-$Reste] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
if {[llength $e2] !=1} {::set e2 [list $e2]}
::lset L {*}$i [::list $e0 $e1 $e2 ""]
::lappend i 3
}
::if {$Reste > 0} {
lassign [lrange $args end-[expr {$Reste-1}] end] e0 e1 e2
if {[llength $e0]>1} {::set e0 [list $e0]}
if {[llength $e1]>1} {::set e1 [list $e1]}
if {[llength $e2]>1} {::set e2 [list $e2]}
::lset L {*}$i [::list $e0 $e1 $e2 ""]
}
::return {*}$L
}
proc flat {L} {
# nl4 flat ...
if {[::set type [nl4 type $L]] ne {}} {
::for {::set i {}} {[::llength [::lindex $L {*}$i]]!=0} {::set i [::linsert $i 0 [nl4 rindice $type]]} {
foreach j [nl4 iorder $type] {
::lappend Res {*}[::lindex $L {*}$i $j]
}
}
return $Res
}
}
proc index {L args} {
# nl4 index ...
::return [::lindex [nl4 flat $L] $args]
}
proc iorder {type} {
switch -- $type {
east {return [list 0 1 2]}
north {return [list 3 2 0]}
south {return [list 0 1 3]}
west {return [list 3 2 1]}
default {return ""}
}
}
proc insert {L index element args} {
# nl4 insert ...
if {[::set type [nl4 type $L]] ne ""} {
::return [nl4 $type {*}[linsert [nl4 flat $L] $index $element {*}$args]]
}
}
namespace eval is {
proc east {L} {
# nl4 is east ...
::set res 1
::if {[::llength $L] == 4 && [::llength [::lindex $L 3]] == 0} {
::set res 1
} elseif {[::llength $L] == 4 && [::llength [::lindex $L 3]] == 4} {
::set res [nl4 is east [::lindex $L 3]]
} else {
::set res 0
}
::set res
}
proc north {L} {
# nl4 is north ...
::set res 1
::if {[::llength $L] == 4 && [::llength [::lindex $L 1]] == 0} {
::set res 1
} elseif {[::llength $L] == 4 && [::llength [::lindex $L 1]] == 4} {
::set res [nl4 is north [::lindex $L 1]]
} else {
::set res 0
}
::set res
}
proc south {L} {
# nl4 is south ...
::set res 1
::if {[::llength $L] == 4 && [::llength [::lindex $L 2]] == 0} {
::set res 1
} elseif {[::llength $L] == 4 && [::llength [::lindex $L 2]] == 4} {
::set res [nl4 is south [::lindex $L 2]]
} else {
::set res 0
}
::set res
}
proc west {L} {
# nl4 is west ...
::set res 1
::if {[::llength $L] == 4 && [::llength [::lindex $L 0]] == 0} {
::set res 1
} elseif {[::llength $L] == 4 && [::llength [::lindex $L 0]] == 4} {
::set res [nl4 is west [::lindex $L 0]]
} else {
::set res 0
}
::set res
}
namespace export *
namespace ensemble create
}
proc join {L {sz ""}} {
# nl4 join ...
return [::join [nl4 flat $L] $sz]
}
proc length {L} {
# nl4 length ...
if {[::set type [nl4 type $L]] ne {}} {
::return [::llength [nl4 flat $L]]
}
}
proc merge {L0 L1} {
# nl4 merge ...
if {([::set type0 [nl4 type $L0]] ne {}) && ([::set type1 [nl4 type $L1]] ne {})} {
::set L [::list ""]
::set i 0
foreach {e00 e01 e02} [nl4 flat $L0] {e10 e11 e12} [nl4 flat $L1] {
if {[::llength $e00]!=1} {::set e00 [list $e00]}
if {[::llength $e01]!=1} {::set e01 [list $e01]}
if {[::llength $e02]!=1} {::set e02 [list $e02]}
if {[::llength $e10]!=1} {::set e10 [list $e10]}
if {[::llength $e11]!=1} {::set e11 [list $e11]}
if {[::llength $e12]!=1} {::set e12 [list $e12]}
lappend TempList $e00 $e01 $e02 $e12 $e11 $e10
::set TempList [linsert $TempList [::set r [expr {[nl4 rindice $type0]+[nl4 rindice $type1]}]] ""]
::lset L {*}$i $TempList
lappend i $r
unset TempList
}
return {*}$L
}
}
proc nindex {L nindex {index {}}} {
if {[::set type [nl4 type $L]] ne {}} {
if {[string match end* $nindex]} {
if {[::set less [lindex [split $nindex -] 1]] ne {}} {
::set nindex [expr {[nl4 depth $L]-$less-1}]
} else {
::set nindex [expr {[nl4 depth $L]-1}]
}
}
::for {::set I 0; ::set i {}} {[::llength [::lindex $L {*}$i]]!=0} {::set i [::linsert $i 0 [nl4 rindice $type]]} {
if {$I == $nindex} {
foreach j [nl4 iorder $type] {
::lappend Res {*}[::lindex $L {*}$i $j]
}
return [lindex $Res {*}$index]
}
incr I
}
}
}
proc north {args} {
# nl4 north ...
::set L [::list ""]
::set i 0
::set Reste [expr [llength $args]%3]
::foreach {e0 e1 e2} [lrange $args 0 end-$Reste] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
if {[llength $e2] !=1} {::set e2 [list $e2]}
::lset L {*}$i [::list $e2 "" $e1 $e0]
::lappend i 1
}
::if {$Reste > 0} {
lassign [lrange $args end-[expr {$Reste-1}] end] e0 e1 e2
if {[llength $e0]>1} {::set e0 [list $e0]}
if {[llength $e1]>1} {::set e1 [list $e1]}
if {[llength $e2]>1} {::set e2 [list $e2]}
::lset L {*}$i [::list $e2 "" $e1 $e0]
}
::return {*}$L
}
proc range {L debut fin} {
# nl4 range ...
if {[::set type [nl4 type $L]] ne {}} {
::return [nl4 $type {*}[::lrange [nl4 flat $L] $debut $fin]]
}
}
proc repeat {type count args} {
return [nl4 $type {*}[lrepeat $count {*}$args]]
}
proc reverse {L} {
# nl4 reverse ...
# source ./nl4/reverse/id.tcl
if {[::set type [nl4 type $L]] ne {}} {
return [nl3 $type {*}[lreverse [nl4 flat $L]]]
}
}
proc rindice {type} {
switch -- $type {
east {return 3}
north {return 1}
south {return 2}
west {return 0}
default {return ""}
}
}
proc search {args} {
# nl4 search ...
::set options [lassign [lreverse $args] pattern L]
if {[::set type [nl4 type $L]] ne {}} {
if {"-around" in $options} {
::set options [lsearch -inline -not -all $options -around]
::set allaround 1
} else {
::set allaround 0
}
if {"-lindex" ni $options} {
if {"-inline" in $options} {
::set options [lsearch -inline -not -all $options -inl*]
::set Indices [::lsearch {*}$options [nl4 flat $L] $pattern]
::set K [list]
foreach i $Indices {
if {$allaround} {
::set nIndex [expr {$i/3}]
} else {
::set nIndex [list [expr {$i/3}] [expr {$i%3}]]
}
lappend K {*}[nl4 nindex $L {*}$nIndex]
}
if {$allaround} {
return [nl4 $type {*}$K]
} else {
return [nl2 right {*}$K]
}
} else {
::set Indices [::lsearch {*}$options [nl4 flat $L] $pattern]
::set nIndex [list]
foreach i $Indices {
if {$allaround} {
::set nIndex [expr {$i/3}]
} else {
::lappend nIndex [list [expr {$i/3}] [expr {$i%3}]]
}
}
return $nIndex
}
} else {
if {$allaround} {
return -error "option -around and -lindex not allowed together"
}
::set options [lsearch -inline -not -all $options -lindex]
return [::lsearch {*}$options [nl4 flat $L] $pattern]
}
}
}
proc set {args} {
# nl4 set ...
::set args [lassign $args L]
upvar $L nl
if {[::set type [nl4 type $nl]] ne {}} {
::set index [lassign [lreverse $args] newValue]
::set nl [nl4 flat $nl]
::return [::set nl [nl4 $type {*}[lset nl {*}$index $newValue]]]
}
}
proc sort {args} {
# nl4 sort ...
::set options [lassign [lreverse $args] L]
if {[::set type [nl4 type $L]] ne {}} {
::return [nl4 $type {*}[lsort {*}$options [nl4 flat $L]]]
}
}
proc south {args} {
# nl4 south ...
::set L [::list ""]
::set i 0
::set Reste [expr [llength $args]%3]
::foreach {e0 e1 e2} [lrange $args 0 end-$Reste] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
if {[llength $e2] !=1} {::set e2 [list $e2]}
::lset L {*}$i [::list $e0 $e1 "" $e2]
::lappend i 2
}
::if {$Reste > 0} {
lassign [lrange $args end-[expr {$Reste-1}] end] e0 e1 e2
if {[llength $e0]>1} {::set e0 [list $e0]}
if {[llength $e1]>1} {::set e1 [list $e1]}
if {[llength $e2]>1} {::set e2 [list $e2]}
::lset L {*}$i [::list $e0 $e1 "" $e2]
}
::return {*}$L
}
proc transpose {type L} {
# nl4 transpose ...
::return [nl4 $type {*}[nl4 flat $L]]
}
proc type {L} {
# nl4 type ...
if {[nl4 is east $L]} {
return "east"
} elseif {[nl4 is north $L]} {
return "north"
} elseif {[nl4 is south $L]} {
return "south"
} elseif {[nl4 is west $L]} {
return "west"
} else {
return ""
}
}
proc west {args} {
# nl4 west ...
::set L [::list ""]
::set i 0
::set Reste [expr [llength $args]%3]
::foreach {e0 e1 e2} [lrange $args 0 end-$Reste] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
if {[llength $e2] !=1} {::set e2 [list $e2]}
::lset L {*}$i [::list "" $e2 $e1 $e0]
::lappend i 0
}
::if {$Reste > 0} {
lassign [lrange $args end-[expr {$Reste-1}] end] e0 e1 e2
if {[llength $e0]>1} {::set e0 [list $e0]}
if {[llength $e1]>1} {::set e1 [list $e1]}
if {[llength $e2]>1} {::set e2 [list $e2]}
::lset L {*}$i [::list "" $e2 $e1 $e0]
}
::return {*}$L
}
namespace export *
namespace ensemble create
}
package provide nl4 0.1if 0 {
For an application, see Menu as trees as nested list
FM Using the same principles, here is an interface to deal with purely nested list of 5 constant llength. Such lists are of 5 kinds : I choose to name them east, north, center, south, west.
}
namespace eval nl5 {
proc 2lindex {type index} {
::set nl nl[::set len 5]
::set depth [expr {($index)/($len-1)}]
::set reste [expr {($index)%($len-1)}]
return [list {*}[lrepeat [expr {$depth}] [$nl rindice $type]] [lindex [$nl iorder $type] $reste]]
}
proc append {L args} {
# nl5 append ...
::upvar $L nl
::if {[::set type [nl5 type $nl]] ne ""} {
::set l [nl5 flat $nl]
::set nl [nl5 $type {*}[lappend l {*}$args]]
return $nl
} else {
return -error -message "bad list type"
}
}
proc assign {L varname args} {
# nl5 assign ...
if {[::set type [nl5 type $L]] ne ""} {
return [nl5 $type {*}[uplevel [subst {lassign {[nl5 flat $L]} $varname $args}]]]
}
}
proc center {args} {
# nl5 center ...
::set L [::list ""]
::set i 0
::set Reste [expr [llength $args]%4]
::foreach {e0 e1 e2 e3} [lrange $args 0 end-$Reste] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
if {[llength $e2] !=1} {::set e2 [list $e2]}
if {[llength $e3] !=1} {::set e3 [list $e3]}
::lset L {*}$i [::list $e0 $e1 "" $e3 $e2]
::lappend i 2
}
::if {$Reste > 0} {
lassign [lrange $args end-[expr {$Reste-1}] end] e0 e1 e2 e3
if {[llength $e0]>1} {::set e0 [list $e0]}
if {[llength $e1]>1} {::set e1 [list $e1]}
if {[llength $e2]>1} {::set e2 [list $e2]}
if {[llength $e3]>1} {::set e3 [list $e3]}
::lset L {*}$i [::list $e0 $e1 "" $e3 $e2]
}
::return {*}$L
}
proc concat {args} {
# nl5 concat ...
# source ./nl5/concat/id.tcl
}
proc depth {L} {
if {[::set type [nl5 type $L]] ne {}} {
::return [expr {[nl5 length $L]/4}]
}
}
proc east {args} {
# nl5 east ...
::set L [::list ""]
::set i 0
::set Reste [expr [llength $args]%4]
::foreach {e0 e1 e2 e3} [lrange $args 0 end-$Reste] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
if {[llength $e2] !=1} {::set e2 [list $e2]}
if {[llength $e3] !=1} {::set e3 [list $e3]}
::lset L {*}$i [::list $e0 $e1 $e2 $e3 ""]
::lappend i 4
}
::if {$Reste > 0} {
lassign [lrange $args end-[expr {$Reste-1}] end] e0 e1 e2 e3
if {[llength $e0]>1} {::set e0 [list $e0]}
if {[llength $e1]>1} {::set e1 [list $e1]}
if {[llength $e2]>1} {::set e2 [list $e2]}
if {[llength $e3]>1} {::set e3 [list $e3]}
::lset L {*}$i [::list $e0 $e1 $e2 $e3 ""]
}
::return {*}$L
}
proc flat {L} {
# nl5 flat ...
if {[::set type [nl5 type $L]] ne {}} {
::for {::set i {}} {[::llength [::lindex $L {*}$i]]!=0} {::set i [::linsert $i 0 [nl5 rindice $type]]} {
foreach j [nl5 iorder $type] {
# A voir.
if {[llength [::lindex $L {*}$i $j]] > 1} {
::lappend Res [::lindex $L {*}$i $j]
} else {
::lappend Res {*}[::lindex $L {*}$i $j]
}
}
}
return $Res
}
}
proc index {L args} {
# nl5 index ...
::return [::lindex [nl5 flat $L] $args]
}
proc insert {L index element args} {
# nl5 insert ...
if {[::set type [nl5 type $L]] ne ""} {
::return [nl5 $type {*}[linsert [nl5 flat $L] $index $element {*}$args]]
}
}
proc iorder {type} {
# nl5 iorder ...
switch -- $type {
center {return [list 0 1 4 3]}
east {return [list 0 1 2 3]}
north {return [list 4 3 2 0]}
south {return [list 0 1 2 4]}
west {return [list 4 3 2 1]}
default {return ""}
}
}
namespace eval is {
proc center {L} {
# nl5 is center ...
::set res 1
::if {[::llength $L] == 5 && [::llength [::lindex $L 2]] == 0} {
::set res 1
} elseif {[::llength $L] == 5 && [::llength [::lindex $L 2]] == 5} {
::set res [nl5 is center [::lindex $L 2]]
} else {
::set res 0
}
return $res
}
proc east {L} {
# nl5 is east ...
::set res 1
::if {[::llength $L] == 5 && [::llength [::lindex $L 4]] == 0} {
::set res 1
} elseif {[::llength $L] == 5 && [::llength [::lindex $L 4]] == 5} {
::set res [nl5 is east [::lindex $L 4]]
} else {
::set res 0
}
return $res
}
proc north {L} {
# nl5 is north ...
::set res 1
::if {[::llength $L] == 5 && [::llength [::lindex $L 1]] == 0} {
::set res 1
} elseif {[::llength $L] == 5 && [::llength [::lindex $L 1]] == 5} {
::set res [nl5 is north [::lindex $L 1]]
} else {
::set res 0
}
return $res
}
proc south {L} {
# nl5 is south ...
::set res 1
::if {[::llength $L] == 5 && [::llength [::lindex $L 3]] == 0} {
::set res 1
} elseif {[::llength $L] == 5 && [::llength [::lindex $L 3]] == 5} {
::set res [nl5 is south [::lindex $L 3]]
} else {
::set res 0
}
return $res
}
proc west {L} {
# nl5 is west ...
::set res 1
::if {[::llength $L] == 5 && [::llength [::lindex $L 0]] == 0} {
::set res 1
} elseif {[::llength $L] == 5 && [::llength [::lindex $L 0]] == 5} {
::set res [nl5 is west [::lindex $L 0]]
} else {
::set res 0
}
return $res
}
namespace export *
namespace ensemble create
}
proc join {L {sz " "}} {
# nl5 join ...
return [::join [nl5 flat $L] $sz]
}
proc length {L} {
# nl5 length ...
if {[::set type [nl5 type $L]] ne {}} {
::return [::llength [nl5 flat $L]]
}
# source ./nl5/length/id.tcl
}
proc merge {L0 L1} {
# nl4 merge ...
if {([::set type0 [nl5 type $L0]] ne {}) && ([::set type1 [nl5 type $L1]] ne {})} {
::set L [::list ""]
::set i 0
foreach {e00 e01 e02 e03} [nl5 flat $L0] {e10 e11 e12 e13} [nl5 flat $L1] {
if {[::llength $e00]!=1} {::set e00 [list $e00]}
if {[::llength $e01]!=1} {::set e01 [list $e01]}
if {[::llength $e02]!=1} {::set e02 [list $e02]}
if {[::llength $e03]!=1} {::set e03 [list $e03]}
if {[::llength $e10]!=1} {::set e10 [list $e10]}
if {[::llength $e11]!=1} {::set e11 [list $e11]}
if {[::llength $e12]!=1} {::set e12 [list $e12]}
if {[::llength $e13]!=1} {::set e13 [list $e13]}
lappend TempList $e00 $e01 $e02 $e03 $e13 $e12 $e11 $e10
::set TempList [linsert $TempList [::set r [expr {[nl5 rindice $type0]+[nl5 rindice $type1]}]] ""]
::lset L {*}$i $TempList
lappend i $r
unset TempList
}
return {*}$L
}
}
proc nindex {L nindex {index {}}} {
if {[::set type [nl5 type $L]] ne {}} {
if {[string match end* $nindex]} {
if {[::set less [lindex [split $nindex -] 1]] ne {}} {
::set nindex [expr {[nl5 depth $L]-$less-1}]
} else {
::set nindex [expr {[nl5 depth $L]-1}]
}
}
::for {::set I 0; ::set i {}} {[::llength [::lindex $L {*}$i]]!=0} {::set i [::linsert $i 0 [nl5 rindice $type]]} {
if {$I == $nindex} {
foreach j [nl5 iorder $type] {
::lappend Res {*}[::lindex $L {*}$i $j]
}
return [lindex $Res {*}$index]
}
incr I
}
}
}
proc north {args} {
# nl5 north ...
::set L [::list ""]
::set i 0
::set Reste [expr [llength $args]%4]
::foreach {e0 e1 e2 e3} [lrange $args 0 end-$Reste] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
if {[llength $e2] !=1} {::set e2 [list $e2]}
if {[llength $e3] !=1} {::set e3 [list $e3]}
::lset L {*}$i [::list $e3 "" $e2 $e1 $e0]
::lappend i 1
}
::if {$Reste > 0} {
lassign [lrange $args end-[expr {$Reste-1}] end] e0 e1 e2 e3
if {[llength $e0]>1} {::set e0 [list $e0]}
if {[llength $e1]>1} {::set e1 [list $e1]}
if {[llength $e2]>1} {::set e2 [list $e2]}
if {[llength $e3]>1} {::set e3 [list $e3]}
::lset L {*}$i [::list $e3 "" $e2 $e1 $e0]
}
::return {*}$L
}
proc range {L debut fin} {
# nl5 range ...
if {[::set type [nl5 type $L]] ne {}} {
::return [nl5 $type {*}[::lrange [nl5 flat $L] $debut $fin]]
}
}
proc repeat {type count args} {
::return [nl5 $type {*}[lrepeat $count $args]]
}
proc reverse {L} {
# nl5 reverse ...
if {[::set type [nl5 type $L]] ne {}} {
return [nl5 $type {*}[lreverse [nl5 flat $L]]]
}
}
proc rindice {type} {
# nl5 rindice ...
switch -- $type {
center {return 2}
east {return 4}
north {return 1}
south {return 3}
west {return 0}
default {return ""}
}
}
proc search {args} {
# nl5 search ...
::set options [lassign [lreverse $args] pattern L]
if {[::set type [nl5 type $L]] ne {}} {
if {"-inline" in $options} {
::return [nl5 $type {*}[::lsearch {*}$options [nl5 flat $L] $pattern]]
} else {
::return [::lsearch {*}$options [nl5 flat $L] $pattern]
}
}
}
proc set {args} {
# nl5 set ...
::set args [lassign $args L]
upvar $L nl
if {[::set type [nl5 type $nl]] ne {}} {
::set index [lassign [lreverse $args] newValue]
::set nl [nl5 flat $nl]
::return [::set nl [nl5 $type {*}[lset nl {*}$index $newValue]]]
}
}
proc sort {args} {
# nl5 sort ...
::set options [lassign [lreverse $args] L]
if {[::set type [nl5 type $L]] ne {}} {
::return [nl5 $type {*}[lsort {*}$options [nl5 flat $L]]]
}
}
proc south {args} {
# nl5 south ...
::set L [::list ""]
::set i 0
::set Reste [expr [llength $args]%4]
::foreach {e0 e1 e2 e3} [lrange $args 0 end-$Reste] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
if {[llength $e2] !=1} {::set e2 [list $e2]}
if {[llength $e3] !=1} {::set e3 [list $e3]}
::lset L {*}$i [::list $e0 $e1 $e2 "" $e3]
::lappend i 3
}
::if {$Reste > 0} {
lassign [lrange $args end-[expr {$Reste-1}] end] e0 e1 e2 e3
if {[llength $e0]>1} {::set e0 [list $e0]}
if {[llength $e1]>1} {::set e1 [list $e1]}
if {[llength $e2]>1} {::set e2 [list $e2]}
if {[llength $e3]>1} {::set e3 [list $e3]}
::lset L {*}$i [::list $e0 $e1 $e2 "" $e3]
}
::return {*}$L
}
proc transpose {type L} {
# nl5 transpose ...
::return [nl5 $type {*}[nl5 flat $L]]
}
proc type {L} {
# nl5 type ...
if {[nl5 is center $L]} {
return "center"
} elseif {[nl5 is east $L]} {
return "east"
} elseif {[nl5 is north $L]} {
return "north"
} elseif {[nl5 is south $L]} {
return "south"
} elseif {[nl5 is west $L]} {
return "west"
} else {
return ""
}
}
proc west {args} {
# nl5 west ...
::set L [::list ""]
::set i 0
::set Reste [expr [llength $args]%4]
::foreach {e0 e1 e2 e3} [lrange $args 0 end-$Reste] {
if {[llength $e0] !=1} {::set e0 [list $e0]}
if {[llength $e1] !=1} {::set e1 [list $e1]}
if {[llength $e2] !=1} {::set e2 [list $e2]}
if {[llength $e3] !=1} {::set e3 [list $e3]}
::lset L {*}$i [::list "" $e3 $e2 $e1 $e0]
::lappend i 0
}
::if {$Reste > 0} {
lassign [lrange $args end-[expr {$Reste-1}] end] e0 e1 e2 e3
if {[llength $e0]>1} {::set e0 [list $e0]}
if {[llength $e1]>1} {::set e1 [list $e1]}
if {[llength $e2]>1} {::set e2 [list $e2]}
if {[llength $e3]>1} {::set e3 [list $e3]}
::lset L {*}$i [::list "" $e3 $e2 $e1 $e0]
}
::return {*}$L
}
namespace export *
namespace ensemble create
}
package provide nl5 0.1if 0 {
for an example, see MegaWidgets as nested list
To do.
Knowing the llength of the list, and the nested indice (recursive indice), it should be possible generate the code when needed.
This is the case when it's possible to deduce from the depth of a nested list, its llength and the nest indice (the indice where to find the nexts elements)
Construction procedure example :
}
proc nl% {args} {
# nl% ...
::set L [::list ""]
::set i 0
::set j 0
::set depth 1
set Elements {{depth} {
for {set i 1} {$i <= [::apply $::Length $depth]} {incr i} {
lappend E e$i
}
return $E
}}
for {set i 0} {$i < [llength $args]} {incr depth} {
lassign [lrange $args $i [incr i [::apply $::Length $depth]]] {*}[set E [::apply $Elements $depth]]
foreach e $E {
if {[::llength $e] != 1} {
lappend EE [list [subst \$$e]]
} else {
lappend EE [subst \$$e]
}
}
set EE [linsert $EE [::apply $::Nindice $depth] ""]
::lset L {*}$j $EE
::lappend j [::apply $::Nindice $depth]
set EE [list]
set E [list]
}
::return {*}$L
}
# some lambda to test
# left nested list of 2-constant length
set ::Length {{depth} {
return 1
}}
set ::Nindice {{depth} {
return 0
}}
nl% A B C D E F G H I J K L M N O
# {{{{{{{{{{{{{{{} O} N} M} L} K} J} I} H} G} F} E} D} C} B} A
nl2 left A B C D E F G H I J K L M N O
# {{{{{{{{{{{{{{{} O} N} M} L} K} J} I} H} G} F} E} D} C} B} A
# llength = depth²
set ::Length {{depth} {
return [expr (entier(pow(2,$depth)))]
}}
set ::Nindice {{depth} {
return [expr (entier(pow(2,$depth)))/2]
}}
nl% A B C D E F G H I J K L M N
# A {C D {G H I J {} K L M N} E F} B -> depth = 1, llength = 2; depth = 2, llength = 4; depth = 3, llength = 8, ...
# periodic
set ::Length {{depth} {
set pi [expr {acos(-1)}]
return [expr (entier(sin($pi/2*$depth)))+2]
}}
set ::Nindice {{depth} {
return 1
}}
nl% A B C D E F G H I J K L M N O P
# A {D {F {G {I {L {N {O {} P}} M} J K} H}} E} B C -> \
depth = 1, llength = 4; depth = 2, llength = 3; depth = 3, llength = 2; depth = 4, llength = 3; depth = 5, llength = 4 ; etc...
# logarithmic
set ::Length {{depth} {
return [expr (entier(log($depth))+1)]
}}
set ::Nindice {{depth} {
return [expr (entier(log($depth))+1)/2]
}}
nl% A B C D E F G H I J K L M N O;# give
# {{C {E {G {I {K {M {} N O} L} J} H} F} D} B} A
# irrationnal (decimals of pi)
set ::Length {{depth} {
set L [lsearch -all -not -inline [split [set pi [expr acos(-1)]] {}] .]
return [lindex $L $depth-1]
}}
set ::Nindice {{depth} {
return 1
}}
nl% A B C D E F G H I J K L M O P Q R S T U V W X
# A {D {E {I {J {P {} Q R S T U V W X} K L M O}} F G H}} B C; (80 members max)
## etc ...