lpop is a built in command in Tcl 8.7
----
synopsis: lpop varName ?index ...?
[JMN] 2024
lpop can take a list of indices which are used as a path into a nested list structure.
If the index at any level doesn't match an element, an error will be returned.
Here is a pure Tcl implementation which I hope matches the behaviour - but you should test, and recognise that the performance is quite likely to be orders of magnitude worse.
This relies also on availability of the [lremove] command - which may also need to be installed as a Tcl only version if your interpreter doesn't have the builtin.
proc lpop {lvar args} {
upvar $lvar l
if {![llength $args]} {
set args [list end]
}
set v [lindex $l {*}$args]
set newlist $l
set path [list]
set subl $l
for {set i 0} {$i < [llength $args]} {incr i} {
set idx [lindex $args $i]
if {[list_index_resolve $subl $idx] == -1} {
error "tcl_lpop index \"$idx\" out of range"
}
lappend path [lindex $args $i]
set subl [lindex $l {*}$path]
}
set sublist_path [lrange $args 0 end-1]
set tailidx [lindex $args end]
if {![llength $sublist_path]} {
set newlist [lremove $newlist $tailidx]
} else {
set sublist [lindex $newlist {*}$sublist_path]
set sublist [lremove $sublist $tailidx]
lset newlist {*}$sublist_path $sublist
}
#puts "[set l] -> $newlist"
set l $newlist
return $v
}
proc list_index_resolve {list index} {
#Note that for an index such as $x+1 - we never see the '$x' as it is substituted in the calling command. We will get something like 10+1 - which we will resolve (hopefully safely) with expr
if {![llength $list]} {
return -1
}
set index [string map [list _ ""] $index] ;#forward compatibility with integers such as 1_000
if {[string is integer -strict $index]} {
#can match +i -i
if {$index < 0} {
return -1
} elseif {$index >= [llength $list]} {
return -1
} else {
#integer may still have + sign - normalize with expr
return [expr {$index}]
}
} else {
if {[string match end* $index]} {
if {$index ne "end"} {
set op [string index $index 3]
set offset [string range $index 4 end]
if {$op ni {+ -} || ![string is integer -strict $offset]} {error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"}
if {$op eq "+" && $offset != 0} {
return -1
}
} else {
set offset 0
}
#by now, if op = + then offset = 0 so we only need to handle the minus case
if {$offset == 0} {
set index [expr {[llength $list]-1}]
} else {
set index [expr {([llength $list]-1) - $offset}]
}
if {$index < 0} {
return -1
} else {
return $index
}
} else {
#plain +-<int> already handled above.
#we are trying to avoid evaluating unbraced expr of potentially insecure origin
if {[regexp {(.*)([+-])(.*)} $index _match a op b]} {
if {[string is integer -strict $a] && [string is integer -strict $b]} {
if {$op eq "-"} {
set index [expr {$a - $b}]
} else {
set index [expr {$a + $b}]
}
} else {
error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"
}
} else {
error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"
}
if {$index < 0 || $index >= [llength $list]} {return -1}
return $index
}
}
}
I note this is quite a bit more complex than the implementations that don't use nested indices and assume simply popping of the end item.
More elegant solutions always welcome.
Here is a brief example showing lpop on a nested structure:
% set x [list [list [list a b] [list c d]] [list [list e f] [list g h]]]
{{a b} {c d}} {{e f} {g h}}
% lpop x 1 1 0
g
% set x
{{a b} {c d}} {{e f} h}
% lpop x 1 1 0
h
% lpop x 1 1 0
index "0" out of range
%
This matches the new builtin lpop behaviour - including the error message.
The following is a more concise version of list_index_resolve - which has the advantage that we don't have to try to match Tcl's error reporting, as the right error messages should naturally pop out. Without 8.7's lseq command being available - it does manually build another list of the same size as the input list - which depending on the size involved - may be counterproductive.
The issue being worked around is that lindex will return an empty string for an index that is out of range - but that can be a valid value in the list.
proc list_index_resolve2 {list index} {
set indices [list] ;#building this may be somewhat expensive in terms of storage and compute for large lists - we could use lseq in Tcl 8.7+ but that's likely unavailable here.
for {set i 0} {$i < [llength $list]} {incr i} {
lappend indices $i
}
set idx [lindex $indices $index]
if {$idx eq ""} {
return -1
} else {
return $idx
}
}
The following seems to be the most performant replacement for the list_index_resolve commands above and will work in the lpop implementation above but doesn't resolve the index actually used - instead returning the value in a dict if the supplied index was able to be used.
proc list_index_get {list index} {
set resultlist [lrange $list $index $index]
if {![llength $resultlist]} {
return -1
} else {
#we still don't know the actual integer index for an index such as end-x or int-int without parsing and evaluating ourself.
#we can return the value - but only in a way that won't collide with our -1 out-of-range indicator
return [dict create value [lindex $resultlist 0]]
}
}
The discussion below predates this command. I'm not sure if lpop is purely 8.7+ or if it may be or is backported to any 8.6 versions.
----
lpop - remove last element of list variable
: '''lpop''' ''listVar''
This is not a command included in Tcl, but rather a common ''idiom''
for in place list manipulation used e.g. for implementing stacks.
'''lpop''' removes the last element from the list in ''listVar'' and returns it.
''listVar'' is altered in place.
See also: [lpush] alias [lappend] as the "reverse" operation of lpop, [lprepend], [lshift]
as the counterpart operating on the other end of the list, as well as
[Chart of existing list functionality].
----
** Different Interpretations **
In [ExtraL], the command accepts an optional position parameter:
: '''lpop''' ''listVar ?pos?''
If ''pos'' is given, the element at position ''pos'' of the list is 'popped' off the list
instead of the last element.
[LEG] would prefer to interpret the optional argument not as a position, but rather as the count of
elements to pop of the tail of the list.
: '''lpop''' ''listVar ?count??''
This would harmonize better with the semantics of lappend, alias lpush, which append a number of
elements to a list. Maybe `lpluck list ?pos?`, would be a better name for the [ExtraL] functionality,
where position would be specified just like in [lindex].
In [Bag of algorithms], [The anatomy of a bytecoded command] and [Searching A Star In Space], amongst
others, lpop pops off the first element of the list.
This is kind of [http://en.wikipedia.org/wiki/Pushmi-pullyu#The_Pushmi-pullyu%|%pushmi-pullyu%|%]:
On one side a convenient implementation of the stack push command s ''lappend listVar element''. Here
the last element of the list (the 'right-most') has to be seen as the top of the stack, which might appear
counterintuitive to some people. Those would, on the other side rather push elements on the stack
'to the left', and pop them from there (index 0 of the list).
A more convenient name for this second interpretation of lpop might be [lshift].
Since the Tcl-core does not provide an opposite of the [lappend] command, implementing a stack where the
top element is at list position 0 (or 'left-most') has poorer performance.
** Implementations **
[AMG]: A stack whose top is at list position zero can be implemented as follows:
======
proc push {listvar elem} {
upvar 1 $listvar list
set list [concat [list $elem] $list]
}
proc pop {listvar elemvar} {
upvar 1 $listvar list $elemvar elem
set list [lassign $list elem]
}
======
[NEM] See reference below for why this will be inefficient. Also, use [linsert] rather than [concat] for push.
This one, copied from [Performance of Various Stack Implementations], contributed by [Lars H],
is simple and best in performance.
======
proc lpop listVar {
upvar 1 $listVar l
set r [lindex $l end]
set l [lreplace $l [set l end] end] ; # Make sure [lreplace] operates on unshared object
return $r
}
======
Note: the 'set l end' idiom is a trick to "unset" l and at the same time provide the verb 'end'
to lreplace resulting in 'lreplace $l end end'.
You can use this programming idiom also without having the lpop command, e.g. with the [K] combinator:
======
K [lindex $l end] [set l [lreplace $l [set l end] end]
======
This one is a similiar implementation with optional element count:
======
proc lpop {listVar {count 1}} {
upvar 1 $listVar l
set r [lrange $l end-[incr count -1] end]
set l [lreplace $l end-$count [set l end]]
set r
}
======
And the following is a full fledged version with error handling:
======
proc lpop {listVar {count 1}} {
upvar 1 $listVar l
if {![info exists l]} {
error "can't read \"$listVar\": no such variable"
}
if {![llength $l]} {error Empty}
set r [lrange $l end-[incr count -1] end]
set l [lreplace $l end-$count [set l end]]
return $r
}
======
----
[Sarnold] I hacked this one today:(updated 23 May 2009)
======
proc lpop {listvar args} {
set len [llength $args]
if {$len==0} {return}
upvar 1 $listvar list
set tail [lrange $list end-[expr {$len-1}] end]
uplevel 1 [list foreach $args $tail break]
set list [lrange $list 0 end-$len]
}
set list {1 3 5 7 9 11}
lpop list a b c
puts "$a $b $c";# 7 9 11
======
[KPV]: https://core.tcl.tk/tips/doc/trunk/tip/523.md%|%Tip 523: New lpop command%|% proposes adding lpop into the core.
I couldn't resist adding my own one-line implementation of lpop:
======
set stack [lreverse [lassign [lreverse $stack] item]]
======
<<categories>> Command