## typelocked-double-keyed-hashtable-g.pkg
## AUTHOR: John Reppy
## AT&T Bell Laboratories
## Murray Hill, NJ 07974
## jhr@research.att.com
# Compiled by:
# src/lib/std/standard.lib# hashtables that are keyed by two keys (in different domains).
### "The only man who never makes a mistake
### is the man who never does anything.
###
### Do not be afraid to make mistakes
### providing you do not make the same one twice."
###
### -- Theodore Roosevelt
generic package typelocked_double_keyed_typelocked_hashtable_g (
#
package key1: Hash_Key; # Hash_Key is from src/lib/src/hash-key.api package key2: Hash_Key; # Hash_Key is from src/lib/src/hash-key.api )
: (weak)
Typelocked_Double_Keyed_Hashtable # Typelocked_Double_Keyed_Hashtable is from src/lib/src/typelocked-double-keyed-hashtable.api{
package key1 = key1;
package key2 = key2;
package htrep= hashtable_representation; # hashtable_representation is from src/lib/src/hashtable-rep.pkg # The representation of a double-keyed hashtable is two tables
# that will always hold the same number of items and be the same
# size.
#
Hashtable X = TABLE {
not_found: Exception,
table1: Ref( htrep::Table( key1::Hash_Key, (key2::Hash_Key, X) ) ),
table2: Ref( htrep::Table( key2::Hash_Key, (key1::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 (n, exn)
=
TABLE {
not_found => exn,
table1 => REF (htrep::allot n),
table2 => REF (htrep::allot n),
n_items => REF 0
};
# Remove all elements from the table:
#
fun clear (TABLE { table1, table2, n_items, ... } )
=
{
htrep::clear *table1;
htrep::clear *table2;
n_items := 0;
};
# Remove an item, returning the item. The table's exception is raised if
# the item doesn't exist.
#
fun remove (hash_value, same_key) (arr, not_found, key)
=
item
where
hash = hash_value key;
index = index (hash, rw_vector::length arr);
fun get' htrep::NIL => raise exception not_found;
get' (htrep::BUCKET (h, k, v, r))
=>
if (hash == h and same_key (key, k))
(v, r);
else
my (item, r') = get' r;
(item, htrep::BUCKET (h, k, v, r'));
fi;
end;
my (item, bucket)
=
get' (rw_vector::get (arr, index));
rw_vector::set (arr, index, bucket);
end;
fun delete1 (table, not_found, k)
=
remove (key1::hash_value, key1::same_key) (table, not_found, k);
fun delete2 (table, not_found, k)
=
remove (key2::hash_value, key2::same_key) (table, not_found, k);
fun remove1 (TABLE { table1, table2, n_items, not_found, ... } ) k1
=
item
where
my (k2, item)
=
delete1 (*table1, not_found, k1);
delete2 (*table2, not_found, k2);
n_items := *n_items - 1;
end;
fun remove2 (TABLE { table1, table2, n_items, not_found, ... } ) k2
=
item
where
my (k1, item)
=
delete2 (*table2, not_found, k2);
delete1 (*table1, not_found, k1);
n_items := *n_items - 1;
end;
# Insert an item. If there is already an item that has either of the two keys,
# then the old item is discarded (from both tables)
#
fun set (TABLE { table1, table2, n_items, ... } ) (k1, k2, item)
=
{ arr1 = *table1;
arr2 = *table2;
size = rw_vector::length arr1;
h1 = key1::hash_value k1;
h2 = key2::hash_value k2;
i1 = index (h1, size);
i2 = index (h2, size);
fun get1 htrep::NIL
=>
{ rw_vector::set (arr1, i1,
htrep::BUCKET (h1, k1, (k2, item), rw_vector::get (arr1, i1)));
# We increment the number of items
# and grow the tables here,
# but not when inserting into table2.
n_items := *n_items + 1;
if (htrep::grow_table_if_needed (table1, *n_items))
table2 := htrep::grow_table (arr2, rw_vector::length *table1);
fi;
htrep::NIL;
};
get1 (htrep::BUCKET (h1', k1', (k2', v), r))
=>
if (h1' == h1 and key1::same_key (k1', k1))
if (not (key2::same_key (k2, k2')))
ignore (delete2 (arr2, DIE "insert::lookUp1", k2'));
fi;
htrep::BUCKET (h1, k1, (k2, item), r);
else
case (get1 r)
htrep::NIL => htrep::NIL;
rest => htrep::BUCKET (h1', k1', (k2', v), rest);
esac;
fi;
end; # end case
fun get2 htrep::NIL
=>
{
rw_vector::set (arr2, i2,
htrep::BUCKET (h2, k2, (k1, item), rw_vector::get (arr2, i2)));
htrep::NIL;
};
get2 (htrep::BUCKET (h2', k2', (k1', v), r))
=>
if (h2' == h2 and key2::same_key (k2', k2))
if (not (key1::same_key (k1, k1')))
ignore (delete1 (arr1, DIE "insert::lookUp2", k1'));
fi;
htrep::BUCKET (h2, k2, (k1, item), r);
else
case (get2 r)
htrep::NIL => htrep::NIL;
rest => htrep::BUCKET (h2, k2, (k1, v), rest);
esac;
fi;
end;
case ( get1 (rw_vector::get (arr1, i1)),
get2 (rw_vector::get (arr2, i2))
)
(htrep::NIL, htrep::NIL) => ();
(b1, b2)
=>
{
# NOTE: both b1 and b2 should be non-NIL, since we should
# have replaced an item in both tables.
rw_vector::set (arr1, i1, b1);
rw_vector::set (arr2, i2, b2);
};
esac;
};
# Return TRUE, if the key is in the domain of the table
#
fun contains_key (hash_value, same_key) table key
=
{
arr = *table;
hash = hash_value key;
index = index (hash, rw_vector::length arr);
fun get' htrep::NIL
=>
FALSE;
get' (htrep::BUCKET (h, k, v, r))
=>
((hash == h) and same_key (key, k)) or get' r;
end;
get' (rw_vector::get (arr, index));
};
fun in_domain1 (TABLE { table1, ... } ) = contains_key (key1::hash_value, key1::same_key) table1;
fun in_domain2 (TABLE { table2, ... } ) = contains_key (key2::hash_value, key2::same_key) table2;
# Look for an item, the table's exception is raised if the item doesn't exist
#
fun get (hash_value, same_key) (table, not_found) key
=
get' (rw_vector::get (arr, index))
where
arr = *table;
hash = hash_value key;
index = index (hash, rw_vector::length arr);
fun get' htrep::NIL
=>
raise exception not_found;
get' (htrep::BUCKET (h, k, (_, v), r))
=>
if ((hash == h) and same_key (key, k)) v;
else get' r;
fi;
end;
end;
fun get1 (TABLE { table1, not_found, ... } )
=
get (key1::hash_value, key1::same_key) (table1, not_found);
fun get2 (TABLE { table2, not_found, ... } )
=
get (key2::hash_value, key2::same_key) (table2, not_found);
# Look for an item, return NULL if the item doesn't exist
#
fun find (hash_value, same_key) table key
=
get' (rw_vector::get (arr, index))
where
arr = *table;
size = rw_vector::length arr;
hash = hash_value key;
index = index (hash, size);
fun get' htrep::NIL
=>
NULL;
get' (htrep::BUCKET (h, k, (_, v), r))
=>
if (hash == h and same_key (key, k)) THE v;
else get' r;
fi;
end;
end;
fun find1 (TABLE { table1, ... } ) = find (key1::hash_value, key1::same_key) table1;
fun find2 (TABLE { table2, ... } ) = find (key2::hash_value, key2::same_key) table2;
# Return the number of items in the table
#
fun vals_count (TABLE { n_items, ... } )
=
*n_items;
# Return a list of the items (and their keys) in the table
#
fun vals_list (TABLE { table1, ... } )
=
htrep::fold (\\ ((_, item), l) = item ! l) [] *table1;
fun keyvals_list (TABLE { table1, ... } )
=
htrep::foldi (\\ (k1, (k2, item), l) = (k1, k2, item) ! l) [] *table1;
# Apply a function to the entries of the table
#
fun apply f (TABLE { table1, ... } )
=
htrep::apply (\\ (_, v) = f v) *table1;
fun keyed_apply f (TABLE { table1, ... } )
=
htrep::keyed_apply (\\ (k1, (k2, v)) = f (k1, k2, v)) *table1;
# Map a table to a new table that has the same keys
#
fun map f (TABLE { table1, table2, n_items, not_found } )
=
new_table
where
size = rw_vector::length *table1;
new_table = TABLE {
table1 => REF (htrep::allot size),
table2 => REF (htrep::allot size),
n_items => REF 0,
not_found
};
fun ins (k1, (k2, v))
=
set new_table (k1, k2, f v);
htrep::keyed_apply ins *table1;
end;
fun keyed_map f (TABLE { table1, table2, n_items, not_found } )
=
new_table
where
size = rw_vector::length *table1;
new_table = TABLE {
table1 => REF (htrep::allot size),
table2 => REF (htrep::allot size),
n_items => REF 0,
not_found
};
fun ins (k1, (k2, v))
=
set new_table (k1, k2, f (k1, k2, v));
htrep::keyed_apply ins *table1;
end;
fun fold f init (TABLE { table1, ... } )
=
htrep::fold (\\ ((_, v), accum) = f (v, accum)) init *table1;
fun foldi f init (TABLE { table1, ... } )
=
htrep::foldi (\\ (k1, (k2, v), accum) = f (k1, k2, v, accum)) init *table1;
# Remove any hashtable items that
# do not satisfy the given predicate:
#
fun filter prior (TABLE { table1, table2, n_items, ... } )
=
{
fun ins (k1, (k2, v))
=
if (not (prior v))
delete1 (*table1, DIE "filter", k1);
delete2 (*table2, DIE "filter", k2);
n_items := *n_items - 1;
fi;
htrep::keyed_apply ins *table1;
};
fun keyed_filter prior (TABLE { table1, table2, n_items, not_found } )
=
{
fun ins (k1, (k2, v))
=
if (prior (k1, k2, v))
delete1 (*table1, DIE "keyed_filter", k1);
delete2 (*table2, DIE "keyed_filter", k2);
n_items := *n_items - 1;
fi;
htrep::keyed_apply ins *table1;
};
# Create a copy of a hashtable
#
fun copy (TABLE { table1, table2, n_items, not_found } )
=
TABLE {
table1 => REF (htrep::copy *table1),
table2 => REF (htrep::copy *table2),
n_items => REF *n_items,
not_found
};
# returns 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 (TABLE { table1, table2, ... } )
=
(htrep::bucket_sizes *table1, htrep::bucket_sizes *table2);
}; # Typelocked_Double_Keyed_Hashtable
## COPYRIGHT (c) 1996 by AT&T Research.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.