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
|
