\ Hash based lists (ala Smalltalk Set's) vandys
\ Arbitrary cell values can be inserted in a hashed list, and their
\ presence tested for efficiently using a hashing of the value.
\ The list will grow as needed to accomodate its contents
\ It is benign to add something more than once; it will exist
\ in the list only once.
\ Instance variables hold a list of values, the overall size of the list,
\ and a count of the number of values in the list (0 is not a legal value).
\ A member in the Set
\ is located at its hash modulo current count, with collisions handled
\ by simply advancing by cells until a null entry is found. It is
\ guaranteed that there will always be a null cell for this search.
only extensions definitions
\ Set--class, instance creation, and initialization vandys
Collection -> subclass: Set
ivars: intcell list intcell count intcell elems endivars
Set -> class -> :method newsize ( size self -- set )
super-> new { size set } size set Set>count !
size cells bkzalloc set Set>list ! set method;
Set -> class -> :method new ( self -- set )
(#INITHASH) swap -> newsize method;
Set -> :method empty! { self -- }
self Set>list @ self Set>count @ cells erase
self Set>elems off method;
Set -> :method free ( self -- ) dup Set>list @ bkfree
super-> free method;
\ Accessing members of Set vandys
: set>hash ( set key -- u ) (>hash) swap Set>count @ mod ; Local
Set -> :method in? { key self -- ? } self key set>hash dup { start }
cells self Set>list @ + self Set>count @ start do ( 'cell )
@+ dup key = if unloop 2drop true exit then
0= if unloop drop false exit then loop drop
self Set>list @ start 0 do ( 'cell )
@+ dup key = if unloop 2drop true exit then
0= if unloop drop false exit then loop 1 abort" List full"
method;
Set -> :method @ ( idx self -- val ) dup Set>list @ swap Set>count @
0 do ( idx 'cell )
@+ if swap ?dup 0= if cell- @ unloop exit then 1- swap then
loop 1 abort" Out of bounds" method;
\ Hash based lists--storage, rehash vandys
: setAdd ( new elem -- ) swap -> add ; scrLocal
Set -> :method swap { other self -- }
self Set>list @ self Set>count @ self Set>elems @ { list count elems }
other Set>list @ self Set>list ! other Set>count @ self Set>count !
other Set>elems @ self Set>elems !
list other Set>list ! count other Set>count ! elems other Set>elems !
method;
Set -> :method grow { self -- }
self Set>count @ (>newhash) Set -> newsize { new }
new ['] setAdd self -> do new self -> swap new -> free method;
\ Hash based lists--storage, rehash vandys
: upsize { set -- } set Set>elems inc
set Set>elems @ set Set>count @ = if set -> grow then ; scrLocal
Set -> :method add { key self -- } key dup 0= abort" Zero key"
self swap set>hash dup { start }
cells self Set>list @ + self Set>count @ start do ( 'cell )
@+ dup key = if unloop 2drop exit then
0= if cell- key swap ! unloop self upsize exit then loop drop
self Set>list @ start 0 do
@+ dup key = if unloop 2drop exit then
0= if cell- key swap ! unloop self upsize exit then loop
1 abort" List full" method;
\ Hash based lists--removal vandys
: fixups { set start -- }
start cells set Set>list @ + set Set>count @ start do
dup @ ?dup 0= if unloop drop exit then
( 'cell key ) over off set -> ! loop drop
set Set>list @ start 0 do
dup @ ?dup 0= if unloop drop exit then
( 'cell key ) over off set -> ! loop ; scrLocal
Set -> :method remove { key self -- } self key set>hash dup { start }
cells self Set>list @ + self Set>count @ start do
@+ dup key = if drop cell- off self i unloop fixups exit then
0= abort" Not in Set" loop drop
self Set>list @ start 0 do
@+ dup key = if drop cell- off self i unloop fixups exit then
0= abort" Not in Set" loop drop method;
\ Hash based lists--enumeration, display vandys
Set -> :method do { arg 'fn self -- } self Set>elems @ self Set>list @
( count 'cell ) begin over while
@+ ?dup if arg swap 'fn execute swap 1- swap then
repeat 2drop method;
Set -> :method size ( set -- u ) Set>elems @ method;
\ Hash based lists--testing vandys
false [if] \ testing
Set -> new constant s
500 constant #ITERS
create vals #ITERS cells allot
: vrfy #ITERS 0 do vals i cells + @ ?dup if
s -> in? not abort" Missing" then loop ;
: init randstate off vals #ITERS cells erase ;
: duped? ( n -- ? ) #ITERS 0 do vals i cells + @ over = if
unloop drop true exit then loop drop false ;
: nextrand ( -- n )
begin random dup duped? while drop repeat ;
: test1 init #ITERS 0 do
nextrand dup s -> ! vals i cells + ! loop vrfy ;
: test2 #ITERS 0 do vals i cells + @ s -> ! loop vrfy ;
: test3 #ITERS 5 / 0 do random #ITERS mod cells vals +
dup @ s -> remove off loop vrfy ;
: (test4) ( magic val -- ) s -> in? not abort" bad iter"
1234 - abort" bad magic" ;
: test4 1234 ['] (test4) s -> do ;
[then] \ testing
\ Hash based lists--duplication vandys
Set -> :method copy { self -- new }
self Set>count @ Set -> newsize { new } \ TBD: skip the bkzalloc of list
self Set>list @ new Set>list @ self Set>count @ cells move
self Set>elems @ new Set>elems ! new method;
Set -> :method ephem { self -- } self Set>list @ ephem drop
self super-> ephem method;
The Set class.
List of members, storage size, and count of members currently stored
:method newsize Allocate new Set, sized with the provided amount of
empty cells
:method new Create Set with default size
:method empty! Set contents of Set to be empty. Does not resize storage.
:method free Release Set storage, then let superclass free actual instance
variable memory.
: set>hash Given set and key, return starting index in Set for key
:method in? Tell if the given value exists in the Set
:method @ Fetch by indexing into underlying order of storage
: set! Store key into Set
:method swap Exchange Set contents with another Set
:method grow
vandys
:full? Bump up count of elems in Set, grow its storage when it
becomes full
:method add Add key to Set.
vandys
: fixups Walk successors of removed element, as their position may
no longer be correct. We null them out of their place in the Set,
then re-insert them.
:method remove Remove a key from the Set
vandys
:method do Invoke 'fn over each member of set
:method size Return count of # members in Set
: test1 Fill Set with numbers, verify presence of numbers
: test2 Redundant add to Set, verify numbers again
: test3 Remove some members, verify Set follows
:method copy Duplicate contents of a Set into a new Set
: setephem Make all set storage ephemeral