]>
Commit | Line | Data |
---|---|---|
1d506c26 | 1 | # Copyright 2017-2024 Free Software Foundation, Inc. |
883fd55a KS |
2 | |
3 | # This program is free software; you can redistribute it and/or modify | |
4 | # it under the terms of the GNU General Public License as published by | |
5 | # the Free Software Foundation; either version 3 of the License, or | |
6 | # (at your option) any later version. | |
7 | # | |
8 | # This program is distributed in the hope that it will be useful, | |
9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | # GNU General Public License for more details. | |
12 | # | |
13 | # You should have received a copy of the GNU General Public License | |
14 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | |
15 | ||
16 | # This file implements some simple data structures in Tcl. | |
17 | ||
18 | # A namespace/commands to support a stack. | |
19 | # | |
20 | # To create a stack, call ::Stack::new, recording the returned object ID | |
21 | # for future calls to manipulate the stack object. | |
22 | # | |
23 | # Example: | |
24 | # | |
25 | # set sid [::Stack::new] | |
26 | # stack push $sid a | |
27 | # stack push $sid b | |
28 | # stack empty $sid; # returns false | |
29 | # stack pop $sid; # returns "b" | |
30 | # stack pop $sid; # returns "a" | |
31 | # stack pop $sid; # errors with "stack is empty" | |
32 | # stack delete $sid1 | |
33 | ||
34 | namespace eval ::Stack { | |
35 | # A counter used to create object IDs | |
36 | variable num_ 0 | |
37 | ||
38 | # An array holding all object lists, indexed by object ID. | |
39 | variable data_ | |
40 | ||
41 | # Create a new stack object, returning its object ID. | |
42 | proc new {} { | |
43 | variable num_ | |
44 | variable data_ | |
45 | ||
46 | set oid [incr num_] | |
47 | set data_($oid) [list] | |
48 | return $oid | |
49 | } | |
50 | ||
51 | # Delete the given stack ID. | |
52 | proc delete {oid} { | |
53 | variable data_ | |
54 | ||
55 | error_if $oid | |
56 | unset data_($oid) | |
57 | } | |
58 | ||
59 | # Returns whether the given stack is empty. | |
60 | proc empty {oid} { | |
61 | variable data_ | |
62 | ||
63 | error_if $oid | |
64 | return [expr {[llength $data_($oid)] == 0}] | |
65 | } | |
66 | ||
67 | # Push ELEM onto the stack given by OID. | |
68 | proc push {oid elem} { | |
69 | variable data_ | |
70 | ||
71 | error_if $oid | |
72 | lappend data_($oid) $elem | |
73 | } | |
74 | ||
75 | # Return and pop the top element on OID. It is an error to pop | |
76 | # an empty stack. | |
77 | proc pop {oid} { | |
78 | variable data_ | |
79 | ||
80 | error_if $oid | |
81 | if {[llength $data_($oid)] == 0} { | |
82 | ::error "stack is empty" | |
83 | } | |
84 | set elem [lindex $data_($oid) end] | |
85 | set data_($oid) [lreplace $data_($oid) end end] | |
86 | return $elem | |
87 | } | |
88 | ||
89 | # Returns the depth of a given ID. | |
90 | proc length {oid} { | |
91 | variable data_ | |
92 | ||
93 | error_if $oid | |
94 | return [llength $data_($oid)] | |
95 | } | |
96 | ||
97 | # Error handler for invalid object IDs. | |
98 | proc error_if {oid} { | |
99 | variable data_ | |
100 | ||
101 | if {![info exists data_($oid)]} { | |
102 | ::error "object ID $oid does not exist" | |
103 | } | |
104 | } | |
105 | ||
106 | # Export procs to be used. | |
107 | namespace export empty push pop new delete length error_if | |
108 | ||
109 | # Create an ensemble command to use instead of requiring users | |
110 | # to type namespace proc names. | |
111 | namespace ensemble create -command ::stack | |
112 | } | |
113 | ||
114 | # A namespace/commands to support a queue. | |
115 | # | |
116 | # To create a queue, call ::Queue::new, recording the returned queue ID | |
117 | # for future calls to manipulate the queue object. | |
118 | # | |
119 | # Example: | |
120 | # | |
121 | # set qid [::Queue::new] | |
122 | # queue push $qid a | |
123 | # queue push $qid b | |
124 | # queue empty $qid; # returns false | |
125 | # queue pop $qid; # returns "a" | |
126 | # queue pop $qid; # returns "b" | |
127 | # queue pop $qid; # errors with "queue is empty" | |
128 | # queue delete $qid | |
129 | ||
130 | namespace eval ::Queue { | |
131 | ||
132 | # Remove and return the oldest element in the queue given by OID. | |
133 | # It is an error to pop an empty queue. | |
134 | proc pop {oid} { | |
135 | variable ::Stack::data_ | |
136 | ||
137 | error_if $oid | |
138 | if {[llength $data_($oid)] == 0} { | |
139 | error "queue is empty" | |
140 | } | |
141 | set elem [lindex $data_($oid) 0] | |
142 | set data_($oid) [lreplace $data_($oid) 0 0] | |
143 | return $elem | |
144 | } | |
145 | ||
146 | # "Unpush" ELEM back to the head of the queue given by QID. | |
147 | proc unpush {oid elem} { | |
148 | variable ::Stack::data_ | |
149 | ||
150 | error_if $oid | |
151 | set data_($oid) [linsert $data_($oid) 0 $elem] | |
152 | } | |
153 | ||
154 | # Re-use some common routines from the Stack implementation. | |
155 | namespace import ::Stack::create ::Stack::new ::Stack::empty \ | |
156 | ::Stack::delete ::Stack::push ::Stack::length ::Stack::error_if | |
157 | ||
158 | # Export procs to be used. | |
159 | namespace export new empty push pop new delete length error_if unpush | |
160 | ||
161 | # Create an ensemble command to use instead of requiring users | |
162 | # to type namespace proc names. | |
163 | namespace ensemble create -command ::queue | |
164 | } |