@ -174,6 +174,18 @@ tcl::namespace::eval punk::lib::check {
set description "lsearch -stride with -subindices -inline -all and single index - incorrect results."
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 {} {
#https://core.tcl-lang.org/tcl/tktview/e38dce74e2
@ -827,17 +839,30 @@ namespace eval punk::lib {
#tcl 8.7+ lseq significantly faster, especially for larger ranges
#The internal rep can be an 'arithseries' with no string representation
#support minimal set from to
proc range {from to} {
lseq $from $to
proc range {from to {by 1}} {
#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 {
#lseq accepts basic expressions e.g 4-2 for both arguments
#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.
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 from [offset_expr $from]
if {$by ne ""} {
set by [offset_expr $by]
}
#assert $by is now empty string or an integer
if {$to > $from} {
switch -- $by {
"" - 1 {
set count [expr {($to -$from) + 1}]
if {$from == 0} {
return [lsearch -all [lrepeat $count 0] *]
@ -845,6 +870,37 @@ namespace eval punk::lib {
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.
#2)
#set i -1
@ -858,14 +914,29 @@ namespace eval punk::lib {
#}
#return $L
} elseif {$from > $to} {
switch -- $by {
"" - -1 {
set count [expr {$from - $to} + 1]
#1)
if {$to == 0} {
return [lreverse [lsearch -all [lrepeat $count 0] *]]
} else {
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)
#set i -1
@ -2468,7 +2539,7 @@ namespace eval punk::lib {
#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.
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]} {
return [expr {$expression}]
}
@ -2531,22 +2602,35 @@ namespace eval punk::lib {
if {$rposn >= 0} {
set sepsize 2
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
set fdot [string first . $r]
set ldot [string last . $r]
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
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} {
lappend validateindices {*}[string range $r 0 $rposn-1] {*}[string range $r $rposn+2 end]
#1.end.10 or similar shouldn't be valid - but we need to allow other basic index expressions.
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 {
#'range' is just an index
set validateindices [list $r]
}
foreach v $validateindices {
if {$v eq "" || $v eq "end"} {continue}
if {[string is integer -strict $v]} {continue}
@ -2558,6 +2642,7 @@ namespace eval punk::lib {
return 1
}
#review - compare to IMAP4 methods of specifying ranges?
#TODO add tests to test::punk::lib indexset_resolve is a little tricky
punk::args::define {
@id -id ::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
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
separator representing beginning and end of the index range respectively.
Ranges must be specified with a range-indicator such as .. as the separator, with an empty value at
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.
indexset_resolve 7 ..
-> 0 1 2 3 4 5 6
indexset_resolve 7 .. -3
indexset_resolve -base -3 7 ..
-> -3 -2 -1 0 1 2 3
Whitespace is ignored.
@ -2599,10 +2715,9 @@ namespace eval punk::lib {
output the first 3 indices, and the last index.
end-1..0
output the indexes in reverse order from 2nd last item to first item."
@values -min 2 -max 3
numitems -type integer
indexset -type indexset -help "comma delimited specification for indices to return"
base -type integer -default 0 -help\
@leaders -min 0 -max 0
@opts
-base -type integer -prefix 1 -default 0 -help\
"This is the starting index. It can be positive, negative or zero.
This affects the start and end calculations, limiting what indices will be
returned.
@ -2613,46 +2728,116 @@ namespace eval punk::lib {
For base 1, index 0 is considered to be below the range.
ie
indexset_resolve 10 0..3 1
indexset_resolve -base 1 10 0..3
-> 1 2 3
indexset_resolve 10 0..3 0
indexset_resolve -base 0 10 0..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
indexset_resolve 10 5 0
indexset_resolve -base 0 10 5
-> 5
ie if you ask for a 1 based indexset the integers that are within the
range will come out the same, so the result needs to be treated as a
1-based set of indices when performing further operations.
ie if you ask for a 1-based resolution of an indexset the integers that are within
the range will come out the same, so the result needs to be treated as a 1-based
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"
}
#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
}
proc indexset_resolve {numitems indexset {base 0}} {
set indexset [lindex $args end]
set numitems [lindex $args end-1]
if {![string is integer -strict $numitems] || ![is_indexset $indexset]} {
#use parser on unhappy path only
set errmsg [punk::args::usage -scheme error ::punk::lib::indexset_resolve]
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 index_list [list] ;#list of actual indexes within the range
set iparts [split $indexset ,]
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 {
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} {
#range
lassign [punk::lib::string_splitbefore_indices $ipart $rposn $rposn+2] rawa _ rawb
#if we found one dot - there must be exactly 2 dots in the ipart, separated by nothing, or a basic integer-expression
set rposn2 [string last . $ipart]
if {$rposn2 == $rposn+1} {
#..
set step "default" ;#could be 1 or -1
} else {
set step [tcl::string::range $ipart $rposn+1 $rposn2-1]
}
lassign [punk::lib::string_splitbefore_indices $ipart $rposn $rposn2+1] rawa _ rawb
set rawa [string trim $rawa]
set rawb [string trim $rawb]
if {$rawa eq ""} {set rawa $base}
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 {
set rawa $base
set rawb end
}
#if neither start nor end specified - we won't get out of range results from lindex_resolve
set a [punk::lib::lindex_resolve $numitems $rawa $base]
set b [punk::lib::lindex_resolve $numitems $rawb $base]
} else {
if {$rawa eq ""} {
if {$step eq "default"} {
#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} {
#(was -3)
#undershot - leave negative
} elseif {$a == Inf} {
#overshot
@ -2661,12 +2846,34 @@ namespace eval punk::lib {
#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
@ -2674,12 +2881,22 @@ namespace eval punk::lib {
#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
#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} {
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 {
if {$a >= $base && $a <= $based_max} {
#only a is in the range
@ -2688,27 +2905,57 @@ namespace eval punk::lib {
} else {
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} {
#only b is in the range
if {$step eq "default"} {
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 {
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 {
#both outside the range
if {$a < $base && $b > $base} {
#spans the range in forward order
set a $base
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} {
#spans the range in reverse order
set a $based_max
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
}
