/usr/share/tcltk/tcllib1.14/stooop/xifo.tcl is in tcllib 1.14-dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 | # The lifo and fifo classes (for the stooop object oriented extension)
#
# Copyright (c) 2002 by Jean-Luc Fontaine <jfontain@free.fr>.
# This code may be distributed under the same terms as Tcl.
#
# $Id: xifo.tcl,v 1.4 2004/07/19 19:12:45 jfontain Exp $
# Here is a sample FIFO/LIFO implementation with stooop.
# Sample test code is at the bottom of this file.
# Uncomment the following lines for the bottom sample code to work:
# package require stooop
# namespace import stooop::*
::stooop::class xifo {
proc xifo {this size} {
set ($this,size) $size
empty $this
}
proc ~xifo {this} {
variable ${this}data
catch {unset ${this}data}
}
proc in {this data} {
variable ${this}data
tidyUp $this
if {[array size ${this}data] >= $($this,size)} {
unset ${this}data($($this,first))
incr ($this,first)
}
set ${this}data([incr ($this,last)]) $data
}
proc tidyUp {this} { ;# warning: for internal use only
variable ${this}data
catch {
unset ${this}data($($this,unset))
unset ($this,unset)
}
}
proc empty {this} {
variable ${this}data
catch {unset ${this}data}
catch {unset ($this,unset)}
set ($this,first) 0
set ($this,last) -1
}
proc isEmpty {this} {
return [expr {$($this,last) < $($this,first)}]
}
::stooop::virtual proc out {this}
::stooop::virtual proc data {this}
}
::stooop::class lifo {
proc lifo {this {size 2147483647}} xifo {$size} {}
proc ~lifo {this} {}
proc out {this} {
xifo::tidyUp $this
if {[array size xifo::${this}data] == 0} {
error "lifo $this out error, empty"
}
# delay unsetting popped data to improve performance by avoiding a data
# copy:
set xifo::($this,unset) $xifo::($this,last)
incr xifo::($this,last) -1
return [set xifo::${this}data($xifo::($this,unset))]
}
proc data {this} {
set list {}
set first $xifo::($this,first)
for {set index $xifo::($this,last)} {$index >= $first} {incr index -1} {
lappend list [set xifo::${this}data($index)]
}
return $list
}
}
::stooop::class fifo {
proc fifo {this {size 2147483647}} xifo {$size} {}
proc ~fifo {this} {}
proc out {this} {
xifo::tidyUp $this
if {[array size xifo::${this}data] == 0} {
error "fifo $this out error, empty"
}
# delay unsetting popped data to improve performance by avoiding a data
# copy:
set xifo::($this,unset) $xifo::($this,first)
incr xifo::($this,first)
return [set xifo::${this}data($xifo::($this,unset))]
}
proc data {this} {
set list {}
set last $xifo::($this,last)
for {set index $xifo::($this,first)} {$index <= $last} {incr index} {
lappend list [set xifo::${this}data($index)]
}
return $list
}
}
# Here are a few lines of sample code:
# proc exercise {id} {
# for {set u 0} {$u < 10} {incr u} {
# xifo::in $id $u
# }
# puts [xifo::out $id]
# puts [xifo::data $id]
# xifo::in $id $u
# xifo::in $id [incr u]
# puts [xifo::data $id]
# }
# set id [stooop::new lifo 10]
# exercise $id
# stooop::delete $id
# set id [stooop::new fifo 10]
# exercise $id
# stooop::delete $id
|