lpop

Difference between version 16 and 17 - Previous - Next
lpop is a built in command in Tcl 8.7

----

synopsis: lpop varName ?index ...?

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 implentation 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 installed as a Tcl only version if you 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]} {
                #for end- we will probably have to blow a few cycles stripping first and calculate the length
                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.
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