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