## unt-hashtable.pkg
#
# A specialization of the hashtable generic to word keys.
# Compiled by:
#
src/lib/std/standard.lib### "You can always count on Americans
### to do the right thing -- after they've
### tried everything else."
###
### -- Winston Churchill
stipulate
package hr = hashtable_representation; # hashtable_representation is from
src/lib/src/hashtable-rep.pkg package rwv = rw_vector; # rw_vector is from
src/lib/std/src/rw-vector.pkgherein
package unt_hashtable
:
Typelocked_Hashtable # Typelocked_Hashtable is from
src/lib/src/typelocked-hashtable.api where
key::Hash_Key == Unt
=
package {
#
package key {
#
Hash_Key = Unt;
#
fun same_key (a: Unt, b) = a == b;
#
fun hash_value a = a;
};
include package key;
Hashtable X
=
HASHTABLE {
not_found_exception: Exception,
table: Ref( hr::Table( Hash_Key, X) ),
n_items: Ref( Int )
};
fun index (i, size)
=
unt::to_int_x (unt::bitwise_and (i, unt::from_int size - 0u1));
# Create a new table.
# The int is a size hint and the exception
# is to be raised by find.
#
fun make_hashtable { size_hint, not_found_exception }
=
HASHTABLE
{
not_found_exception,
table => REF (hr::allot size_hint),
n_items => REF 0
};
# Remove all elements from the table:
#
fun clear (HASHTABLE { table, n_items, ... } )
=
{ hr::clear *table;
n_items := 0;
};
# Insert an item. If the key already has an item associated with it,
# then the old item is discarded.
#
fun set (my_table as HASHTABLE { table, n_items, ... } ) (key, item)
=
{
vector = *table;
size = rwv::length vector;
hash = hash_value key;
index = index (hash, size);
fun get hr::NIL
=>
{
rwv::set (vector, index, hr::BUCKET (hash, key, item, rwv::get (vector, index)));
n_items := *n_items + 1;
hr::grow_table_if_needed (table, *n_items);
hr::NIL;
};
get (hr::BUCKET (h, k, v, r))
=>
if (hash == h
and same_key (key, k))
#
hr::BUCKET (hash, key, item, r);
else
case (get r)
#
hr::NIL => hr::NIL;
rest => hr::BUCKET (h, k, v, rest);
esac;
fi;
end;
case (get (rwv::get (vector, index)))
#
hr::NIL => ();
b => rwv::set (vector, index, b);
esac;
};
# Return TRUE if the key is in
# the domain of the table:
#
fun contains_key (HASHTABLE { table, ... } ) key
=
get' (rwv::get (vector, index))
where
vector = *table;
hash = hash_value key;
index = index (hash, rwv::length vector);
fun get' hr::NIL => FALSE;
#
get' (hr::BUCKET (h, k, v, r))
=>
((hash == h) and same_key (key, k)) or
get' r;
end;
end;
# Find an item.
# The table's exception is raised
# if the item doesn't exist:
#
fun get (HASHTABLE { table, not_found_exception, ... } ) key
=
get' (rwv::get (vector, index))
where
vector = *table;
hash = hash_value key;
index = index (hash, rwv::length vector);
fun get' hr::NIL
=>
raise exception not_found_exception;
get' (hr::BUCKET (h, k, v, r))
=>
if (hash == h
and same_key (key, k))
v;
else
get' r;
fi;
end;
end;
# Look up an item.
# Return NULL if the item doesn't exist:
#
fun find (HASHTABLE { table, ... } ) key
=
get' (rwv::get (vector, index))
where
vector = *table;
size = rwv::length vector;
hash = hash_value key;
index = index (hash, size);
fun get' hr::NIL
=>
NULL;
get' (hr::BUCKET (h, k, v, r))
=>
if (hash == h and same_key (key, k)) THE v;
else get' r;
fi;
end;
end;
stipulate
fun get_and_drop' (HASHTABLE { not_found_exception, table, n_items }, key)
=
{
vector = *table;
size = rwv::length vector;
hash = hash_value key;
index = index (hash, size);
fun get hr::NIL
=>
raise exception not_found_exception;
get (hr::BUCKET (h, k, v, r))
=>
if (hash == h and same_key (key, k))
(v, r);
else
my (item, r') = get r;
(item, hr::BUCKET (h, k, v, r'));
fi;
end;
my (item, bucket) = get (rwv::get (vector, index));
rwv::set (vector, index, bucket);
n_items := *n_items - 1;
item;
};
herein
# Remove an item.
# The table's exception is raised
# if the item doesn't exist.
#
fun get_and_drop (hashtable as HASHTABLE { not_found_exception, ... }) key
=
{ THE (get_and_drop' (hashtable, key))
except
not_found_exception = NULL;
};
fun drop hashtable key
=
{ (get_and_drop' (hashtable, key));
();
}
except
not_found_exception = ();
end;
# Return the number of items in the table:
#
fun vals_count (HASHTABLE { n_items, ... } ) = *n_items;
# Return a list of the items in the table:
#
fun vals_list (HASHTABLE { table => REF vector, n_items, ... } )
=
hr::vals_list (vector, n_items);
fun keyvals_list (HASHTABLE { table => REF vector, n_items, ... } )
=
hr::keyvals_list (vector, n_items);
# Apply a function to the entries of the table:
#
fun keyed_apply f (HASHTABLE { table, ... } ) = hr::keyed_apply f *table;
fun apply f (HASHTABLE { table, ... } ) = hr::apply f *table;
# Map a table to a new table
# that has the same keys and exception:
#
fun keyed_map f (HASHTABLE { table, n_items, not_found_exception } )
=
HASHTABLE {
table => REF (hr::keyed_map f *table),
n_items => REF *n_items,
not_found_exception
};
fun map f (HASHTABLE { table, n_items, not_found_exception } )
=
HASHTABLE {
table => REF (hr::map f *table),
n_items => REF *n_items,
not_found_exception
};
# Fold a function over the entries of the table:
#
fun foldi f init (HASHTABLE { table, ... } ) = hr::foldi f init *table;
fun fold f init (HASHTABLE { table, ... } ) = hr::fold f init *table;
# Modify the hashtable items in place:
#
fun keyed_map_in_place f (HASHTABLE { table, ... } ) = hr::keyed_map_in_place f *table;
fun map_in_place f (HASHTABLE { table, ... } ) = hr::map_in_place f *table;
# Remove any hashtable items
# that do not satisfy the given
# predicate.
#
fun keyed_filter prior (HASHTABLE { table, n_items, ... } )
=
n_items := hr::keyed_filter prior *table;
fun filter prior (HASHTABLE { table, n_items, ... } )
=
n_items := hr::filter prior *table;
# Create a copy of a hashtable:
#
fun copy (HASHTABLE { table, n_items, not_found_exception } )
=
HASHTABLE {
table => REF (hr::copy *table),
n_items => REF *n_items,
not_found_exception
};
# Return a list of the sizes of the various buckets.
# This is to allow users to gauge the quality of their
# hashing function.
#
fun bucket_sizes (HASHTABLE { table, ... } )
=
hr::bucket_sizes *table;
}; # typelocked_hashtable_g
end;