You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
296 lines
6.6 KiB
296 lines
6.6 KiB
# stack.tcl -- |
|
# |
|
# Stack implementation for Tcl 8.6+, or 8.5 + TclOO |
|
# |
|
# Copyright (c) 2010 Andreas Kupries |
|
# |
|
# See the file "license.terms" for information on usage and redistribution |
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
|
# |
|
# RCS: @(#) $Id: stack_oo.tcl,v 1.4 2010/09/10 17:31:04 andreas_kupries Exp $ |
|
|
|
package require Tcl 8.5 9 |
|
package require TclOO 0.6.1- ; # This includes 1 and higher. |
|
|
|
# Cleanup first |
|
catch {namespace delete ::struct::stack::stack_oo} |
|
catch {rename ::struct::stack::stack_oo {}} |
|
|
|
oo::class create ::struct::stack::stack_oo { |
|
|
|
variable mystack |
|
|
|
constructor {} { |
|
set mystack {} |
|
return |
|
} |
|
|
|
# clear -- |
|
# |
|
# Clear a stack. |
|
# |
|
# Results: |
|
# None. |
|
|
|
method clear {} { |
|
set mystack {} |
|
return |
|
} |
|
|
|
# get -- |
|
# |
|
# Retrieve the whole contents of the stack. |
|
# |
|
# Results: |
|
# items list of all items in the stack. |
|
|
|
method get {} { |
|
return [lreverse $mystack] |
|
} |
|
|
|
method getr {} { |
|
return $mystack |
|
} |
|
|
|
# peek -- |
|
# |
|
# Retrieve the value of an item on the stack without popping it. |
|
# |
|
# Arguments: |
|
# count number of items to pop; defaults to 1 |
|
# |
|
# Results: |
|
# items top count items from the stack; if there are not enough items |
|
# to fulfill the request, throws an error. |
|
|
|
method peek {{count 1}} { |
|
if { $count < 1 } { |
|
return -code error "invalid item count $count" |
|
} elseif { $count > [llength $mystack] } { |
|
return -code error "insufficient items on stack to fill request" |
|
} |
|
|
|
if { $count == 1 } { |
|
# Handle this as a special case, so single item peeks are not |
|
# listified |
|
return [lindex $mystack end] |
|
} |
|
|
|
# Otherwise, return a list of items |
|
incr count -1 |
|
return [lreverse [lrange $mystack end-$count end]] |
|
} |
|
|
|
method peekr {{count 1}} { |
|
if { $count < 1 } { |
|
return -code error "invalid item count $count" |
|
} elseif { $count > [llength $mystack] } { |
|
return -code error "insufficient items on stack to fill request" |
|
} |
|
|
|
if { $count == 1 } { |
|
# Handle this as a special case, so single item peeks are not |
|
# listified |
|
return [lindex $mystack end] |
|
} |
|
|
|
# Otherwise, return a list of items, in reversed order. |
|
incr count -1 |
|
return [lrange $mystack end-$count end] |
|
} |
|
|
|
# trim -- |
|
# |
|
# Pop items off a stack until a maximum size is reached. |
|
# |
|
# Arguments: |
|
# count requested size of the stack. |
|
# |
|
# Results: |
|
# item List of items trimmed, may be empty. |
|
|
|
method trim {newsize} { |
|
if { ![string is integer -strict $newsize]} { |
|
return -code error "expected integer but got \"$newsize\"" |
|
} elseif { $newsize < 0 } { |
|
return -code error "invalid size $newsize" |
|
} elseif { $newsize >= [llength $mystack] } { |
|
# Stack is smaller than requested, do nothing. |
|
return {} |
|
} |
|
|
|
# newsize < [llength $mystack] |
|
# pop '[llength $mystack]' - newsize elements. |
|
|
|
if {!$newsize} { |
|
set result [lreverse [my K $mystack [unset mystack]]] |
|
set mystack {} |
|
} else { |
|
set result [lreverse [lrange $mystack $newsize end]] |
|
set mystack [lreplace [my K $mystack [unset mystack]] $newsize end] |
|
} |
|
|
|
return $result |
|
} |
|
|
|
method trim* {newsize} { |
|
if { ![string is integer -strict $newsize]} { |
|
return -code error "expected integer but got \"$newsize\"" |
|
} elseif { $newsize < 0 } { |
|
return -code error "invalid size $newsize" |
|
} |
|
|
|
if { $newsize >= [llength $mystack] } { |
|
# Stack is smaller than requested, do nothing. |
|
return |
|
} |
|
|
|
# newsize < [llength $mystack] |
|
# pop '[llength $mystack]' - newsize elements. |
|
|
|
# No results, compared to trim. |
|
|
|
if {!$newsize} { |
|
set mystack {} |
|
} else { |
|
set mystack [lreplace [my K $mystack [unset mystack]] $newsize end] |
|
} |
|
|
|
return |
|
} |
|
|
|
# pop -- |
|
# |
|
# Pop an item off a stack. |
|
# |
|
# Arguments: |
|
# count number of items to pop; defaults to 1 |
|
# |
|
# Results: |
|
# item top count items from the stack; if the stack is empty, |
|
# returns a list of count nulls. |
|
|
|
method pop {{count 1}} { |
|
if { $count < 1 } { |
|
return -code error "invalid item count $count" |
|
} |
|
|
|
set ssize [llength $mystack] |
|
|
|
if { $count > $ssize } { |
|
return -code error "insufficient items on stack to fill request" |
|
} |
|
|
|
if { $count == 1 } { |
|
# Handle this as a special case, so single item pops are not |
|
# listified |
|
set item [lindex $mystack end] |
|
if {$count == $ssize} { |
|
set mystack [list] |
|
} else { |
|
set mystack [lreplace [my K $mystack [unset mystack]] end end] |
|
} |
|
return $item |
|
} |
|
|
|
# Otherwise, return a list of items, and remove the items from the |
|
# stack. |
|
if {$count == $ssize} { |
|
set result [lreverse [my K $mystack [unset mystack]]] |
|
set mystack [list] |
|
} else { |
|
incr count -1 |
|
set result [lreverse [lrange $mystack end-$count end]] |
|
set mystack [lreplace [my K $mystack [unset mystack]] end-$count end] |
|
} |
|
return $result |
|
} |
|
|
|
# push -- |
|
# |
|
# Push an item onto a stack. |
|
# |
|
# Arguments: |
|
# args items to push. |
|
# |
|
# Results: |
|
# None. |
|
|
|
method push {args} { |
|
if {![llength $args]} { |
|
return -code error "wrong # args: should be \"[self] push item ?item ...?\"" |
|
} |
|
|
|
lappend mystack {*}$args |
|
return |
|
} |
|
|
|
# rotate -- |
|
# |
|
# Rotate the top count number of items by step number of steps. |
|
# |
|
# Arguments: |
|
# count number of items to rotate. |
|
# steps number of steps to rotate. |
|
# |
|
# Results: |
|
# None. |
|
|
|
method rotate {count steps} { |
|
set len [llength $mystack] |
|
if { $count > $len } { |
|
return -code error "insufficient items on stack to fill request" |
|
} |
|
|
|
# Rotation algorithm: |
|
# do |
|
# Find the insertion point in the stack |
|
# Move the end item to the insertion point |
|
# repeat $steps times |
|
|
|
set start [expr {$len - $count}] |
|
set steps [expr {$steps % $count}] |
|
|
|
if {$steps == 0} return |
|
|
|
for {set i 0} {$i < $steps} {incr i} { |
|
set item [lindex $mystack end] |
|
set mystack [linsert \ |
|
[lreplace \ |
|
[my K $mystack [unset mystack]] \ |
|
end end] $start $item] |
|
} |
|
return |
|
} |
|
|
|
# size -- |
|
# |
|
# Return the number of objects on a stack. |
|
# |
|
# Results: |
|
# count number of items on the stack. |
|
|
|
method size {} { |
|
return [llength $mystack] |
|
} |
|
|
|
# ### ### ### ######### ######### ######### |
|
|
|
method K {x y} { set x } |
|
} |
|
|
|
# ### ### ### ######### ######### ######### |
|
## Ready |
|
|
|
namespace eval ::struct { |
|
# Get 'stack::stack' into the general structure namespace for |
|
# pickup by the main management. |
|
|
|
proc stack_tcl {args} { |
|
if {[llength $args]} { |
|
uplevel 1 [::list ::struct::stack::stack_oo create {*}$args] |
|
} else { |
|
uplevel 1 [::list ::struct::stack::stack_oo new] |
|
} |
|
} |
|
}
|
|
|