15.4.15  src/app/c-glue-maker/hash.pkg

#
# hash.pkg - Generating unique hash codes
#            for C function types and
#            for Mythryl types.
#
#  (C) 2002, Lucent Technologies, Bell Labs
#
# author: Matthias Blume (blume@research.bell-labs.com)

# Compiled by:
#     src/app/c-glue-maker/c-glue-maker.lib



package hash: (weak)
api {
     make_fhasher:  Void -> spec::Cft -> Int;
     make_thasher:  Void -> prettyprint::Mltype -> Int;
}
{

    package s= spec;    # spec  is from   src/app/c-glue-maker/spec.pkg
    package pp= prettyprint;    # prettyprint   is from   src/app/c-glue-maker/prettyprint.pkg
    package sm= string_map;     # string_map    is from   src/lib/src/string-map.pkg
    package lm= int_list_map;   # int_list_map  is from   src/app/c-glue-maker/intlist-map.pkg

    fun ty_con_id s::SCHAR     =>  0;
        ty_con_id s::UCHAR     =>  1;
        ty_con_id s::SINT      =>  2;
        ty_con_id s::UINT      =>  3;
        ty_con_id s::SSHORT    =>  4;
        ty_con_id s::USHORT    =>  5;
        ty_con_id s::SLONG     =>  6;
        ty_con_id s::ULONG     =>  7;
        ty_con_id s::SLONGLONG =>  6;   # Repeat -- POTENTIAL MAINTENANCE PROBLEM! BUGGO XXX
        ty_con_id s::ULONGLONG =>  7;   # Repeat -- POTENTIAL MAINTENANCE PROBLEM! BUGGO XXX
        ty_con_id s::FLOAT     =>  8;
        ty_con_id s::DOUBLE    =>  9;
        ty_con_id s::VOIDPTR   => 10;
        ty_con_id _ => raise exception DIE "typId";
    end;

    fun con_con_id s::RW => 0;
        con_con_id s::RO => 1;
    end;

    fun get (next, find, insert) tab k
        =
        case (find (*tab, k))
          
             THE i => i;

             NULL
                  =>
                  {   i =   *next;
                      next := i + 1;
                      tab := insert (*tab, k, i);
                      i;
                  };
        esac;



    # Create a function which hashes
    # C function types down to integers: 

    fun make_fhasher ()                 # "fhasher" == "function type hasher"
        =
        cfthash                         # "cft" == "C function type", I think.
        where

            stab =   REF sm::empty;     # "stab" == "struct table"
            utab =   REF sm::empty;     # "utab" == "union  table"
            etab =   REF sm::empty;     # "etab" == "enum   table"
            ltab =   REF lm::empty;     # "ltab" == ?              Anyhow, it is for pointers and arrays.

            next =   REF 11;            # This is probably supposed to be (ty_con_id s::VOIDPTR) +1?
                                        # POTENTIAL MAINTENANCE PROBLEM! BUGGO XXX FIXME

            tlook =   get (next, sm::get, sm::set);
            llook =   get (next, lm::get, lm::set) ltab;

            fun hash (s::STRUCT t)    =>   tlook stab t;
                hash (s::UNION  t)    =>   tlook utab t;
                hash (s::ENUM (t, _)) =>   tlook etab t;

                hash (s::FPTR x)      =>   cfthash x;

                hash (s::PTR (c, type))    => llook [1, con_con_id c, hash type];
                hash (s::ARR { t, d, esz } ) => llook [2, hash t, d, esz];

                hash type =>   ty_con_id type;
            end 

            also
            fun cfthash { args, result }
                =
                llook (0 ! opthash result ! map hash args)

            also
            fun opthash NULL         =>   0;
                opthash (THE type) =>   1 + hash type;
            end;
        end;


    # Create a function which hashes
    # a Mythryl type down to an integer:

    fun make_thasher ()                 # "thasher" == "type hasher", I think
        =
        hash
        where
            stab =   REF sm::empty;
            ltab =   REF lm::empty;

            next =   REF 0;

            slook =   get (next, sm::get, sm::set) stab;
            llook =   get (next, lm::get, lm::set) ltab;

            fun hash (pp::ARROW (t, t'))              =>   llook [0, hash t, hash t'];
                hash (pp::TUPLE tl)                   =>   llook (1 ! map hash tl);
                hash (pp::TYP (c, tl))   =>   llook (2 ! slook c ! map hash tl);
                hash (pp::RECORD pl)                  =>   llook (3 ! map phash pl);
            end 

           also
           fun phash (n, t)             # Appears to hash record selector tags.  ("p" == ... ?)
                =
                llook [4, slook n, hash t];

        end;
};