blob: f150bfcc15daa8826bd2d472e1152e71767f557c (
plain)
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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
# Copyright 2017-2021 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
# This file implements some simple data structures in Tcl.
# A namespace/commands to support a stack.
#
# To create a stack, call ::Stack::new, recording the returned object ID
# for future calls to manipulate the stack object.
#
# Example:
#
# set sid [::Stack::new]
# stack push $sid a
# stack push $sid b
# stack empty $sid; # returns false
# stack pop $sid; # returns "b"
# stack pop $sid; # returns "a"
# stack pop $sid; # errors with "stack is empty"
# stack delete $sid1
namespace eval ::Stack {
# A counter used to create object IDs
variable num_ 0
# An array holding all object lists, indexed by object ID.
variable data_
# Create a new stack object, returning its object ID.
proc new {} {
variable num_
variable data_
set oid [incr num_]
set data_($oid) [list]
return $oid
}
# Delete the given stack ID.
proc delete {oid} {
variable data_
error_if $oid
unset data_($oid)
}
# Returns whether the given stack is empty.
proc empty {oid} {
variable data_
error_if $oid
return [expr {[llength $data_($oid)] == 0}]
}
# Push ELEM onto the stack given by OID.
proc push {oid elem} {
variable data_
error_if $oid
lappend data_($oid) $elem
}
# Return and pop the top element on OID. It is an error to pop
# an empty stack.
proc pop {oid} {
variable data_
error_if $oid
if {[llength $data_($oid)] == 0} {
::error "stack is empty"
}
set elem [lindex $data_($oid) end]
set data_($oid) [lreplace $data_($oid) end end]
return $elem
}
# Returns the depth of a given ID.
proc length {oid} {
variable data_
error_if $oid
return [llength $data_($oid)]
}
# Error handler for invalid object IDs.
proc error_if {oid} {
variable data_
if {![info exists data_($oid)]} {
::error "object ID $oid does not exist"
}
}
# Export procs to be used.
namespace export empty push pop new delete length error_if
# Create an ensemble command to use instead of requiring users
# to type namespace proc names.
namespace ensemble create -command ::stack
}
# A namespace/commands to support a queue.
#
# To create a queue, call ::Queue::new, recording the returned queue ID
# for future calls to manipulate the queue object.
#
# Example:
#
# set qid [::Queue::new]
# queue push $qid a
# queue push $qid b
# queue empty $qid; # returns false
# queue pop $qid; # returns "a"
# queue pop $qid; # returns "b"
# queue pop $qid; # errors with "queue is empty"
# queue delete $qid
namespace eval ::Queue {
# Remove and return the oldest element in the queue given by OID.
# It is an error to pop an empty queue.
proc pop {oid} {
variable ::Stack::data_
error_if $oid
if {[llength $data_($oid)] == 0} {
error "queue is empty"
}
set elem [lindex $data_($oid) 0]
set data_($oid) [lreplace $data_($oid) 0 0]
return $elem
}
# "Unpush" ELEM back to the head of the queue given by QID.
proc unpush {oid elem} {
variable ::Stack::data_
error_if $oid
set data_($oid) [linsert $data_($oid) 0 $elem]
}
# Re-use some common routines from the Stack implementation.
namespace import ::Stack::create ::Stack::new ::Stack::empty \
::Stack::delete ::Stack::push ::Stack::length ::Stack::error_if
# Export procs to be used.
namespace export new empty push pop new delete length error_if unpush
# Create an ensemble command to use instead of requiring users
# to type namespace proc names.
namespace ensemble create -command ::queue
}
|
