PreviousUpNext

15.4.1022  src/lib/src/unt-hashtable.pkg

## 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.pkg
herein

    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;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext