Home | History | Annotate | Line # | Download | only in lib 
      1 # Copyright 2017-2024 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 
     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 }
    165