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.
see also the forward-compatible lremove command
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]
#inlined list_index_get test
if {![llength [lrange $subl $idx $idx]]} {
error "index \"$idx\" out of range"
}
#See list_index_resolve/list_index_get below for explanation
#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 [lreplace $newlist $tailidx $tailidx]
} else {
set sublist [lindex $newlist {*}$sublist_path]
set sublist [lreplace $sublist $tailidx $tailidx]
lset newlist {*}$sublist_path $sublist
}
#puts "[set l] -> $newlist" ;#we can do without the newlist variable - but it's here to enable easier debug/verification that we are duplicating builtin lpop
set l $newlist
return $v
}
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.
Determining whether the indices are valid was slightly more complex than anticipated. Tcl's lindex/lset etc will often silently 'do the right thing' when an index is out of range etc. In this particular case we need to be strict about the indices in order to raise errors when necessary, and to avoid accidentally appending when we shouldn't. The first shot at determining this was to parse the limited set of indices understood by Tcl list commands (end-x x+-x etc)
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
}
}
}
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.
In the end, inlining the lrange test from list_index_get seems like a reasonable approach.
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
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.
In ExtraL, the command accepts an optional position parameter:
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.
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 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.
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 11KPV: 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]]