1# Copyright 2017-2023 Free Software Foundation, Inc. 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 34namespace 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 130namespace 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} 165