@ -174,6 +174,18 @@ tcl::namespace::eval punk::lib::check {
set description "lsearch -stride with -subindices -inline -all and single index - incorrect results." set description "lsearch -stride with -subindices -inline -all and single index - incorrect results."
return [dict create bug $bug bugref 5a1aaa201d description $description level major] return [dict create bug $bug bugref 5a1aaa201d description $description level major]
} }
proc has_tclbug_lseq_sign {} {
#https://core.tcl-lang.org/tcl/tktview/999b6966b2
if {[catch {lseq 1 10}]} {
set bug 0
} else {
set r1 [lseq 1 10 -9]
set r2 [lseq 1 10 -10]
set bug [expr {$r1 ne $r2}]
}
set description "lseq step sign not matching sequence direction - inconsistent results."
return [dict create bug $bug bugref 999b6966b2 description $description level minor]
}
proc has_tclbug_list_quoting_emptyjoin {} { proc has_tclbug_list_quoting_emptyjoin {} {
#https://core.tcl-lang.org/tcl/tktview/e38dce74e2 #https://core.tcl-lang.org/tcl/tktview/e38dce74e2
@ -827,23 +839,67 @@ namespace eval punk::lib {
#tcl 8.7+ lseq significantly faster, especially for larger ranges #tcl 8.7+ lseq significantly faster, especially for larger ranges
#The internal rep can be an 'arithseries' with no string representation #The internal rep can be an 'arithseries' with no string representation
#support minimal set from to #support minimal set from to
proc range {from to} { proc range {from to {by 1}} {
lseq $from $to #note inconsistency with lseq 1 10 by -9 vs lseq 1 10 by -10
#https://core.tcl-lang.org/tcl/tktview/999b6966b2
lseq $from $to by $by
} }
} else { } else {
#lseq accepts basic expressions e.g 4-2 for both arguments #lseq accepts basic expressions e.g 4-2 for both arguments
#e.g we can do lseq 0 [llength $list]-1 #e.g we can do lseq 0 [llength $list]-1
#if range is to be consistent with the lseq version above - it should support that, even though we don't support most lseq functionality in either wrapper. #if range is to be consistent with the lseq version above - it should support that, even though we don't support most lseq functionality in either wrapper.
proc range {from to} { #our range function doesn't support double like lseq does. (deliberate) review
proc range {from to {by ""}} {
if {$by eq "0"} {
#as per lseq, step (by) zero always gives no result
return [list]
}
set to [offset_expr $to] set to [offset_expr $to]
set from [offset_expr $from] set from [offset_expr $from]
if {$by ne ""} {
set by [offset_expr $by]
}
#assert $by is now empty string or an integer
if {$to > $from} { if {$to > $from} {
set count [expr {($to -$from) + 1}] switch -- $by {
if {$from == 0} { "" - 1 {
return [lsearch -all [lrepeat $count 0] *] set count [expr {($to -$from) + 1}]
} else { if {$from == 0} {
incr from -1 return [lsearch -all [lrepeat $count 0] *]
return [lmap v [lrepeat $count 0] {incr from}] } else {
incr from -1
return [lmap v [lrepeat $count 0] {incr from}]
}
}
default {
set count [expr {($to - $from + $by) / $by}]
if {$count <= 0} {
#return [list]
#https://core.tcl-lang.org/tcl/tktview/999b6966b2
return [list $from] ;#review
}
set result [list]
for {set i $from} {$i <= $to} {incr i $by} {
lappend result $i
}
return $result
#if we don't have lseq, we probably don't have lsearch -stride, which would make things simpler.
#set count [expr {($to -$from) + 1}]
#if {$from == 0} {
# set fullrange [lsearch -all [lrepeat $count 0] *]
#} else {
# incr from -1
# set fullrange [lmap v [lrepeat $count 0] {incr from}]
#}
#set result [list]
#for {set i 0} {$i < $count} {incr i} {
# if {$i % $by == 0} {
# lappend result [lindex $fullrange $i]
# }
#}
#return $result
}
} }
#slower methods. #slower methods.
#2) #2)
@ -858,13 +914,28 @@ namespace eval punk::lib {
#} #}
#return $L #return $L
} elseif {$from > $to} { } elseif {$from > $to} {
set count [expr {$from - $to} + 1] switch -- $by {
#1) "" - -1 {
if {$to == 0} { set count [expr {$from - $to} + 1]
return [lreverse [lsearch -all [lrepeat $count 0] *]] if {$to == 0} {
} else { return [lreverse [lsearch -all [lrepeat $count 0] *]]
incr from } else {
return [lmap v [lrepeat $count 0] {incr from -1}] incr from
return [lmap v [lrepeat $count 0] {incr from -1}]
}
}
default {
set count [expr {($to - $from + $by) / $by}]
if {$count <= 0} {
#return [list]
return [list $from] ;#review
}
set result [list]
for {set i $from} {$i >= $to} {incr i $by} {
lappend result $i
}
return $result
}
} }
#2) #2)
@ -2468,7 +2539,7 @@ namespace eval punk::lib {
#supports *safe* ultra basic offset expressions as used by lindex etc, but without the 'end' features #supports *safe* ultra basic offset expressions as used by lindex etc, but without the 'end' features
#safe in that we don't evaluate the expression as a string. #safe in that we don't evaluate the expression as a string.
proc offset_expr {expression} { proc offset_expr {expression} {
set expression [tcl::string::map {_ {}} $expression] set expression [tcl::string::map {_ {}} $expression] ;#review - this is for 8.6 to understand underscored ints
if {[tcl::string::is integer -strict $expression]} { if {[tcl::string::is integer -strict $expression]} {
return [expr {$expression}] return [expr {$expression}]
} }
@ -2531,22 +2602,35 @@ namespace eval punk::lib {
if {$rposn >= 0} { if {$rposn >= 0} {
set sepsize 2 set sepsize 2
set step 1 set step 1
} else { #review - whitespace between ints?
lappend validateindices {*}[string range $r 0 $rposn-1] {*}[string range $r $rposn+2 end]
} elseif {[string first . $r] >= 0} {
set stripped [string map {. ""} $r]
if {[tcl::string::length $stripped] != [tcl::string::length $r]-2} {
#if one dot exists - must be exactly 2 dots in total - possibly separated by positive/negative int (not zero)
return 0
}
#assert - we have exactly 2 dots separated by something.
#check for .n. 'stepped' range #check for .n. 'stepped' range
set fdot [string first . $r] set fdot [string first . $r]
set ldot [string last . $r] set ldot [string last . $r]
set step [string range $r $fdot+1 $ldot-1] set step [string range $r $fdot+1 $ldot-1]
#todo - allow basic mathops for step: 2+1 2+-1 etc same as tcl lindex, lseq #todo - allow basic mathops for step: 2+1 2+-1 etc same as tcl lindex, lseq
if {![string is integer -strict $step]} { #1.0.10 should be valid but behave similarly to lseq 1 0 by 0 ie returns nothing
}
}
if {$rposn >= 0} { #1.end.10 or similar shouldn't be valid - but we need to allow other basic index expressions.
lappend validateindices {*}[string range $r 0 $rposn-1] {*}[string range $r $rposn+2 end] if {[string match *end* $step] || [catch {lindex {} $step}]} {
return 0
}
#if {![string is integer -strict $step] || $step == 0} {
# return 0
#}
lappend validateindices {*}[string range $r 0 $fdot-1] {*}[string range $r $ldot+1 end]
} else { } else {
#'range' is just an index #'range' is just an index
set validateindices [list $r] set validateindices [list $r]
} }
foreach v $validateindices { foreach v $validateindices {
if {$v eq "" || $v eq "end"} {continue} if {$v eq "" || $v eq "end"} {continue}
if {[string is integer -strict $v]} {continue} if {[string is integer -strict $v]} {continue}
@ -2558,6 +2642,7 @@ namespace eval punk::lib {
return 1 return 1
} }
#review - compare to IMAP4 methods of specifying ranges? #review - compare to IMAP4 methods of specifying ranges?
#TODO add tests to test::punk::lib indexset_resolve is a little tricky
punk::args::define { punk::args::define {
@id -id ::punk::lib::indexset_resolve @id -id ::punk::lib::indexset_resolve
@cmd -name punk::lib::indexset_resolve\ @cmd -name punk::lib::indexset_resolve\
@ -2568,13 +2653,44 @@ namespace eval punk::lib {
e.g in a basic case: for a list of 10 items, 'indexset_resolve 10 end' will return the index 9 e.g in a basic case: for a list of 10 items, 'indexset_resolve 10 end' will return the index 9
An indexset consists of a comma delimited list of indexes or index-ranges. An indexset consists of a comma delimited list of indexes or index-ranges.
Ranges must be specified with .. as the separator, with an empty value at either side of the Ranges must be specified with a range-indicator such as .. as the separator, with an empty value at
separator representing beginning and end of the index range respectively. either side of the separator representing beginning and end of the index range respectively.
The range-separator can be of the form .x. where x is an integer or basic expression
(single +/- operation) that indicates the step value to use. This is equivalent to the 'by' value
in the tcl9 lseq command.
When the start index is lower than the end, the step value defaults to 1.
ie indexset_resolve 0..7 is equivalent to indexset_resolve 0.1.7
When the start index is higher than the end, the step value defaults to -1.
ie indexset_resolve 7..0 is equivalent to indexset_resolve 0.-1.7
If start and end are ommitted, increasing order is assumed if the step isn't specified.
eg
.. represents the range from the base to the end
.-1. would represent end to base with step -1
If start is omitted and only the end is supplied:
The default step is 1 indicating ascension and the missing end is equivalent to 'end'
indexset_resolve 5 2..
-> 2 3 4
The default end is the base if the step is negative
indexset_resolve 5 2.-1.
-> 2 1 0
If end is omitted and onlthe start is supplied:
The default step is 1 indicating ascension and the missing start is equivalent to the base.
indexset_resolve 5 ..2
-> 0 1 2
The default start is 'end' if the step is negative
indexset_resolve 5 .-1.2
-> 4 3 2
Like the tcl9 lseq command - a step (by) value of zero produces no results.
The indexes are 0-based by default, but the base can be specified. The indexes are 0-based by default, but the base can be specified.
indexset_resolve 7 .. indexset_resolve 7 ..
-> 0 1 2 3 4 5 6 -> 0 1 2 3 4 5 6
indexset_resolve 7 .. -3 indexset_resolve -base -3 7 ..
-> -3 -2 -1 0 1 2 3 -> -3 -2 -1 0 1 2 3
Whitespace is ignored. Whitespace is ignored.
@ -2599,10 +2715,9 @@ namespace eval punk::lib {
output the first 3 indices, and the last index. output the first 3 indices, and the last index.
end-1..0 end-1..0
output the indexes in reverse order from 2nd last item to first item." output the indexes in reverse order from 2nd last item to first item."
@values -min 2 -max 3 @leaders -min 0 -max 0
numitems -type integer @opts
indexset -type indexset -help "comma delimited specification for indices to return" -base -type integer -prefix 1 -default 0 -help\
base -type integer -default 0 -help\
"This is the starting index. It can be positive, negative or zero. "This is the starting index. It can be positive, negative or zero.
This affects the start and end calculations, limiting what indices will be This affects the start and end calculations, limiting what indices will be
returned. returned.
@ -2613,73 +2728,175 @@ namespace eval punk::lib {
For base 1, index 0 is considered to be below the range. For base 1, index 0 is considered to be below the range.
ie ie
indexset_resolve 10 0..3 1 indexset_resolve -base 1 10 0..3
-> 1 2 3 -> 1 2 3
indexset_resolve 10 0..3 0 indexset_resolve -base 0 10 0..3
-> 0 1 2 3 -> 0 1 2 3
It does not *convert* integer s within the range. It does not *convert* indexe s within the range.
indexset_resolve 10 5 1 indexset_resolve -base 1 10 5
-> 5 -> 5
indexset_resolve 10 5 0 indexset_resolve -base 0 10 5
-> 5 -> 5
ie if you ask for a 1 based indexset the integers that are within the ie if you ask for a 1-based resolution of an indexset the integers that are within
range will come out the same, so the result needs to be treated as a the range will come out the same, so the result needs to be treated as a 1-based
1-based set of indices when performing further operations. set of indices when performing further operations.
" "
@values -min 2 -max 3
numitems -type integer
indexset -type indexset -help "comma delimited specification for indices to return"
} }
proc indexset_resolve {numitems indexset {base 0}} {
#limit punk::args parsing to unhappy paths where possible
proc indexset_resolve {args} {
# --------------------------------------------------
# Manual parsing of happy path args instead of using punk::args::parse $args withid ::punk::lib::indexset_resolve
# This is because indexset_resolve is *somewhat* low level, has only a few args, and we don't want any overhead.
# for the unhappy path - the punk::args::parse is fine to generate the usage/error information.
# --------------------------------------------------
if {[llength $args] < 2} {
punk::args::resolve $args withid ::punk::lib::indexset_resolve
}
set indexset [lindex $args end]
set numitems [lindex $args end-1]
if {![string is integer -strict $numitems] || ![is_indexset $indexset]} { if {![string is integer -strict $numitems] || ![is_indexset $indexset]} {
#use parser on unhappy path only #use parser on unhappy path only
set errmsg [punk::args::usage -scheme error ::punk::lib::indexset_resolve] set errmsg [punk::args::usage -scheme error ::punk::lib::indexset_resolve]
uplevel 1 [list return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg] uplevel 1 [list return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg]
} }
#assert we have 2 or more args
set base 0 ;#default
if {[llength $args] > 2} {
#if more than just numitems and indexset - we expect only -base <int> ie 4 args in total
if {[llength $args] != 4} {
set errmsg [punk::args::usage -scheme error ::punk::lib::indexset_resolve]
uplevel 1 [list return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg]
}
set optname [lindex $args 0]
set optval [lindex $args 1]
set fulloptname [tcl::prefix::match -error "" -base $optname]
if {$fulloptname ne "-base" || ![string is integer -strict $optval]} {
set errmsg [punk::args::usage -scheme error ::punk::lib::indexset_resolve]
uplevel 1 [list return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg]
}
set base $optval
}
# --------------------------------------------------
set indexset [string map [list " " "" \t "" \r\n "" \n ""] $indexset] ;#collapse basic whitespace set indexset [string map [list " " "" \t "" \r\n "" \n ""] $indexset] ;#collapse basic whitespace
set index_list [list] ;#list of actual indexes within the range set index_list [list] ;#list of actual indexes within the range
set iparts [split $indexset ,] set iparts [split $indexset ,]
set based_max [expr {$numitems -1 + $base}] set based_max [expr {$numitems -1 + $base}]
#we already did is_indexset check above, so we can make assumptions about well-formedness of each part
foreach ipart $iparts { foreach ipart $iparts {
set ipart [string trim $ipart] set ipart [string trim $ipart]
set rposn [string first .. $ipart] #we need to cater for n..m as well as n.s.m where s is 'step'
set rposn [string first . $ipart]
if {$rposn>=0} { if {$rposn>=0} {
#range #if we found one dot - there must be exactly 2 dots in the ipart, separated by nothing, or a basic integer-expression
lassign [punk::lib::string_splitbefore_indices $ipart $rposn $rposn+2] rawa _ rawb set rposn2 [string last . $ipart]
set rawa [string trim $rawa] if {$rposn2 == $rposn+1} {
set rawb [string trim $rawb] #..
if {$rawa eq ""} {set rawa $base} set step "default" ;#could be 1 or -1
set a [punk::lib::lindex_resolve $numitems $rawa $base] } else {
if {$a == -Inf} { set step [tcl::string::range $ipart $rposn+1 $rposn2-1]
#(was -3)
#undershot - leave negative
} elseif {$a == Inf} {
#overshot
set a [expr {$based_max + 1}] ;#put it outside the range on the upper side
} }
#review - a may be -Inf lassign [punk::lib::string_splitbefore_indices $ipart $rposn $rposn2+1] rawa _ rawb
if {$rawb eq ""} { set rawa [string trim $rawa]
if {$a > $based_max} { set rawb [string trim $rawb]
set rawb $a ;#make sure <overshot>.. doesn't return last item - should return nothing if {$rawa eq "" && $rawb eq ""} {
if {$step eq "default"} {
set step 1 ;#default ascending when no start and no end
}
if {$step < 0} {
set rawa end
set rawb $base
} else { } else {
set rawa $base
set rawb end set rawb end
} }
} #if neither start nor end specified - we won't get out of range results from lindex_resolve
set b [punk::lib::lindex_resolve $numitems $rawb $base] set a [punk::lib::lindex_resolve $numitems $rawa $base]
if {$b == -Inf} { set b [punk::lib::lindex_resolve $numitems $rawb $base]
#undershot - leave negative } else {
} elseif {$b == Inf} { if {$rawa eq ""} {
#set b [expr {$numitems}] ;#overshot - put it outside the range on the upper side if {$step eq "default"} {
set b [expr {$based_max + 1}] ;#overshot - put it outside the range on the upper side #when start not specified, but end is - default direction always ascending
#(even if end is base or below range)
set step 1
}
if {$step < 0} {
set rawa end
} else {
set rawa $base
}
}
set a [punk::lib::lindex_resolve $numitems $rawa $base]
if {$a == -Inf} {
#undershot - leave negative
} elseif {$a == Inf} {
#overshot
set a [expr {$based_max + 1}] ;#put it outside the range on the upper side
}
#review - a may be -Inf
if {$rawb eq ""} {
if {$step eq "default"} {
set step 1
}
if {$step < 0} {
if {$a < $base} {
#make sure both <undershot>
#mathfunc::isinf is tcl9+
if {[catch {
if {[::tcl::mathfunc::isinf $a]} {
set a [expr {$base -1}]
}
}]} {
if {[string match -nocase *inf* $a]} {
set a [expr {$base -1}]
}
}
set rawb $a
} else {
set rawb $base
}
} else {
if {$a > $based_max} {
set rawb $a ;#make sure <overshot>.. doesn't return last item - should return nothing
} else {
set rawb end
}
}
}
set b [punk::lib::lindex_resolve $numitems $rawb $base]
if {$b == -Inf} {
#undershot - leave negative
} elseif {$b == Inf} {
#set b [expr {$numitems}] ;#overshot - put it outside the range on the upper side
set b [expr {$based_max + 1}] ;#overshot - put it outside the range on the upper side
}
} }
#JJJ #JJJ
#e.g make sure <overshot>.. doesn't return last item - should return nothing as both are above the range. #e.g make sure <overshot>.. doesn't return last item - should return nothing as both are above the range.
if {$a >= $base && $a <= $based_max && $b >=$base && $b <= $based_max} { if {$a >= $base && $a <= $based_max && $b >=$base && $b <= $based_max} {
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally. #assert a & b are integers within the range
if {$step eq "default"} {
#unspecified step - base direction on order of a & b
if {$a <= $b} {
set step 1
} else {
set step -1
}
}
lappend index_list {*}[punk::lib::range $a $b $step] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} else { } else {
if {$a >= $base && $a <= $based_max} { if {$a >= $base && $a <= $based_max} {
#only a is in the range #only a is in the range
@ -2688,27 +2905,57 @@ namespace eval punk::lib {
} else { } else {
set b $based_max set b $based_max
} }
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally. if {$step eq "default"} {
if {$a <= $b} {
set step 1
} else {
set step -1
}
}
lappend index_list {*}[punk::lib::range $a $b $step] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} elseif {$b >=$base && $b <= $based_max} { } elseif {$b >=$base && $b <= $based_max} {
#only b is in the range #only b is in the range
if {$a < $base} { if {$step eq "default"} {
set a $base if {$a <= $b} {
set step 1
} else {
set step -1
}
}
if {$step < 0} {
if {$a < $base} {
#negative step from below - doesn't matter if b is in range - recast both to an int below $base
#(a may be -Inf)
set a [expr {$base -1}]
set b $a
set step 0 ;#we should return nothing
}
} else { } else {
set a $based_max if {$a < $base} {
set a $base
} else {
set a $based_max
}
} }
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally. lappend index_list {*}[punk::lib::range $a $b $step ] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} else { } else {
#both outside the range #both outside the range
if {$a < $base && $b > $base} { if {$a < $base && $b > $base} {
#spans the range in forward order #spans the range in forward order
set a $base set a $base
set b $based_max set b $based_max
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally. if {$step eq "default"} {
set step 1
}
lappend index_list {*}[punk::lib::range $a $b $step] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} elseif {$a > $base && $b < $base} { } elseif {$a > $base && $b < $base} {
#spans the range in reverse order #spans the range in reverse order
set a $based_max set a $based_max
set b $base set b $base
lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally. if {$step eq "default"} {
set step -1
}
lappend index_list {*}[punk::lib::range $a $b $step] ;#required for tcl8.6, on tcl9 this will call lseq internally.
} }
#both outside of range on same side #both outside of range on same side
} }
