| # 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 |
| } |