english
version "1.0"
identify "@(#)set.sts 1.20 96/05/24"

#: Copyright (c) 1991, 1992, 1993, 1994, 1995, 2003 by Wayne C. Gramlich.
#, All rights reserved.
#,
#, Permission to use, copy, modify, distribute, and sell this software
#, for any purpose is hereby granted without fee provided that the above
#, copyright notice and this permission are retained.  The author makes
#, no representations about the suitability of this software for any purpose.
#, It is provided "as is" without express or implied warranty.

module set

#: This module implements a mathematical set abstraction using hash tables.
#, This implementation will grow the hash table as it starts to fill up.
#, The hash table is incrementally grown so that there will not be long
#, pauses during insertion.

define header[item]		#: Header for hash buckets.
    record
	rehash_size unsigned	#: Table size the last time header was rehashed
	items vector[item]	#: Items in this line of hash table
	hashs vector[unsigned]	#: Corresponding hash values for items
    generate allocate, print, erase

define set[item]		#: Set of items
    record
	headers	vector[header[item]] #: One header per slot
	limit unsigned		#: Rehash when {size >= limit}
	mask unsigned		#: Hash mask {assert mask = slots - 1}
	mask_minimum unsigned	#: Minimum mask value
	size unsigned		#: Number of items in set
	slots unsigned		#: Number of headers slots (must be power of 2)
    generate address_get, allocate, erase, identical, print



# {set} procedures:

procedure xcreate@set[item]
    takes
	size unsigned		# Suggestion for initial number of slots
    returns set[item]

    #: This procedure will create and return a new empty set allocated
    #, with space for about {size} items at first.


procedure delete@set[item]
    takes
	set set[item]
	item item
    returns logical
    needs
	procedure hash@item
	    takes item
	    returns unsigned
	procedure equal@item
	    takes item, item
	    returns logical

    #: This proecudure will delete {item} from {set}.  {true} is returned
    #, if {item} is not in {set} and {false} otherwise.


procedure exists@set[item]
    takes
	set set[item]
	item item
    returns logical
    needs
	procedure hash@item
	    takes item
	    returns unsigned
	procedure equal@item
	    takes item, item
	    returns logical

    #: {exists} will return {true} if {item} is in {set} and {false} otherwise.


procedure header_fetch@set[item]
    takes
	set set[item]
	hash unsigned
    returns header[item]

    #:{fetch1} will return the {hash}'th header from {set} after doing
    #, needed lazy rehashing.


procedure fetch1@set[item]
    takes
	set set[item]
	item item
    returns item
    needs
	procedure hash@item
	    takes item
	    returns unsigned
	procedure equal@item
	    takes item, item
	    returns logical

    #: {fetch1} will return the item matching {item} stored in {set}.
    #, If there is no matching item, {??@item} is returned.


procedure insert@set[item]
    takes
	set set[item]
	item item
    returns logical
    needs
	procedure hash@item
	    takes item
	    returns unsigned
	procedure equal@item
	    takes item, item
	    returns logical

    #: This procedure will insert {item} intoo {set}.  {true} is returned

procedure items_get@set[item]
    takes
	set set[item]
    returns vector[item]

    #: This procedure will return a new vector that contains all
    #, of the current items in {set}.


procedure lookup@set[item]
    takes
	set set[item]
	item item
    returns item, logical
    needs
	procedure hash@item
	    takes item
	    returns unsigned
	procedure equal@item
	    takes item, item
	    returns logical

    #: {lookup} will return the item matching {item} stored in {set}.
    #, If there is no matching item, the boolean return value is set to
    #, {true} and the returned item is the initial object; otherwise
    #, {false} is returned along with the matching item.


procedure read@set[item]
    takes
	in_stream in_stream
    returns set[item]
    needs
	procedure read@item
	    takes in_stream
	    returns item

    #: This procedure will read in a set from {in_stream} and return it.
    #, The set must have been written using {write}@{out_stream}().


procedure store1@set[item]
    takes
	set set[item]
	item item
	replace_item item
    returns_nothing
    needs
	procedure hash@item
	    takes item
	    returns unsigned
	procedure equal@item
	    takes item, item
	    returns logical

    #: This procedure will store {replace_item} into {set} under the
    #, index {item}.


procedure unique@set[item]
    takes
	set set[item]
	item item
    returns item
    needs
	procedure hash@item
	    takes item
	    returns unsigned
	procedure equal@item
	    takes item, item
	    returns logical

    #: This procedure will check to see whether {item} is in {set};
    #, if it is present, the matching {item} from set is returned;
    #, otherwise, {item} is inserted into {set} and returned.


procedure unique_copy@set[item]
    takes
	set set[item]
	item item
    returns item
    needs
	procedure copy@item
	    takes item
	    returns item
	procedure equal@item
	    takes item, item
	    returns logical
	procedure hash@item
	    takes item
	    returns unsigned

    #: This procedure will ensure that {item} is in {set}.  If {item}
    #, is already present in {set}, the version from {set} is returned.
    #, Otherwise, {copy@item} is called make a "copy" of {item}
    #, prior to inserting it into {set}; in this case, the "copied"
    #, version of {item} is returned.  When {copy@item is called,
    #, it is passed {item} as its first argument.


procedure unique_copy_shallow@set[item]
    takes
	set set[item]
	item item
    returns item
    needs
	procedure copy_shallow@item
	    takes item
	    returns item
	procedure equal@item
	    takes item, item
	    returns logical
	procedure hash@item
	    takes item
	    returns unsigned

    #: This procedure will ensure that {item} is in {set}.  If {item}
    #, is already present in {set}, the version from {set} is returned.
    #, Otherwise, {copy_shallow@item} is called make a "copy" of {item}
    #, prior to inserting it into {set}; in this case, the "copied"
    #, version of {item} is returned.  When {copy_shallow@item is called,
    #, it is passed {item} as its first argument.


procedure write@set[item]
    takes
	set set[item]
	out_stream out_stream
    returns_nothing
    needs
	procedure write@item
	    takes item, out_stream
	    returns_nothing

    #: This procedure will write {set} to {out_stream} so that it
    #, can be read by {read}@{set}().