Artifact 108d9bea5b27082a4175f7843e4decc15c2462afff94965f9dd03269d6a67dce:

• File psl-1983/util/hash.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 6337) [annotate] [blame] [check-ins using] [more...]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Hash table package, rather general purpose.
%%% Author: Cris Perdue 8/25/82
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Edit by Cris Perdue, 25 Feb 1983 1408-PST
% Cleaned up code and documentation for demo.
% Added NBuckets as an INITable variable.

(compiletime (load if))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Hash table flavor.
%%%
%%% This is an external chaining hash table.  Thus the table can never
%%% overflow and collision path length grows slowly, though search time
%%% can theoretically grow large.  The implementation includes ability
%%% to delete an association plus several other bells and whistles.
%%%
%%% Hash table instantiation can be as simple as:
%%% (make-instance 'hash).
%%% 
%%% Options to make-instance are:
%%% NBuckets:	Number of hash buckets to create initially.  Defaults
%%% 		to 100.
%%% HashFn:	Given a key, must return a fairly large pseudo-random
%%% 		integer.  Defaults to StrHash, for string keys.
%%% NullValue:	A value for Lookup to return if no association is found.
%%% 		Defaults to NIL.
%%% MaxFillRatio: A floating point number which is the maximum ratio of
%%% 		the number of associations to the number of buckets.
%%% 		If this ratio is reached, the table will be enlarged
%%% 		to make the ratio about .5.  Defaults to 2.0.
%%% KeyCopyFn:	Used by PutAssn.  In some cases when a new association
%%% 		is created one may want to copy the key so that it
%%% 		will be guaranteed not to be modified.  Defaults to
%%% 		a function that returns its argument without any copying.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Gettable state:
%%%
%%% Usage:	Number of associations currently in the table.
%%% NullValue:  Value for Lookup to return if no association found.
%%%
%%% The following relate specifically to associations made via
%%% hash table:
%%% MaxFillRatio
%%% NBuckets
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Operations:
%%%
%%% Present?(key)
%%%
%%% Returns T or NIL depending on whether there is an association with
%%% the given key.
%%% 
%%% Lookup(key)
%%%
%%% Returns the value associated with the key, or the NullValue for the
%%% table if no association exists.
%%% 
%%% PutAssn(key value)
%%%
%%% Makes an association between the key and value, replacing any old
%%% association.  The key may be copied if a new association is created,
%%% otherwise the copy of the key already stored continues to be used.
%%% Returns the value.
%%% 
%%% DeleteAssn(key)
%%%
%%% Deletes any association that may exist for the key.  Returns a value
%%% in the manner of Lookup.
%%% 
%%% ReSize(size)
%%%
%%% Rehashes the table into "size" buckets.  This operation is specific
%%% to associations made with hash tables.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% Preliminaries: definitions, etc.

(setq bitsperword 32)		% Hack to use from LISP.
				% Available as constant in SYSLISP.
				% In this package need only be no
				%  greater than actual bits per word.

(defmacro funcall (fn . args)
  `(apply ,fn (list ,@args)))

%%% Hash flavor definition.

(defflavor Hash
  (Table (NBuckets 100) (Usage 0) OverFlowLevel (MaxFillRatio 2.0)
	 (HashFn 'StrHash) (NullValue NIL) (CompareFn 'String=)
	 (KeyCopyFn 'no-op))
  ()
  (gettable-instance-variables NBuckets Usage NullValue MaxFillRatio)
  (initable-instance-variables
   NBuckets MaxFillRatio HashFn NullValue KeyCopyFn)
  )

(defmethod (Hash init) (init-plist)

  %% Perhaps the table size should be prime . . .
  (setf Table
    (MkVect (- NBuckets 1)))
  (while (<= MaxFillRatio .5)
    (ContinuableError
     0 "Set MaxFillRatio greater than .5 before continuing" t))
  (setf OverFlowLevel (Fix (* NBuckets MaxFillRatio))))

(defmethod (Hash Present?) (key)
  (let ((i (Hash$HashBucket Table (funcall HashFn Key))))
    (if (Ass CompareFn Key (indx Table i))
	then t else nil)))

(defmethod (Hash Lookup) (key)
  (let ((i (Hash$HashBucket Table (funcall HashFn Key))))
    (let ((Entry (Ass CompareFn Key (indx Table i))))
      (if Entry then (cdr Entry) else NullValue))))

(defmethod (Hash PutAssn) (key value)
  (let ((i (Hash$HashBucket Table (funcall HashFn Key))))
    (let ((Entry (Ass CompareFn Key (indx Table i))))
      (if Entry then (RplacD Entry value)
	  else
	  (setf (indx Table i)
		(cons (cons (funcall KeyCopyfn key) value)
		      (indx Table i)))
	  (setf Usage (add1 Usage))
	  (if (not (< Usage OverFlowLevel)) then
              (=> Self resize (* 2 Usage))))))
  value)

(defmethod (Hash DeleteAssn) (key)
  (let ((i (Hash$HashBucket Table (funcall HashFn Key))))
    (let ((Entry (Ass CompareFn Key (indx Table i))) (Value))
      (if Entry then
          (setq Value (cdr Entry))
	  (setf (indx Table i) (DelQIP Entry (indx Table i)))
	  (setf Usage (- Usage 1))
	  Value
	  else
	  NullValue))))

(defmethod (Hash MapAssn) (fn)
  (for (from i 0 (Size Table))
       (do (for (in a (indx Table i))
		(do (funcall fn (car a)))))))

% Operations that are not basic

(defmethod (Hash ReSize) (new-size)
  (if (< new-size 1)
    (StdError (BldMsg "Hash table size of %p too small" new-size)))
  (let ((newtable
	 (mkvect (- new-size 1)))
	(oldtable table))
    (setf NBuckets new-size)
    (setf Table newtable)
    (setf OverFlowLevel (Fix (* NBuckets MaxFillRatio)))
    (setf Usage 0)
    (for (from i 0 (Size oldtable))
	 (do (for (in a (indx oldtable i))
		  (do (=> Self PutAssn (car a) (cdr a))))))
    Self))

%%% Internal functions

(defun Hash$HashBucket (table hashed-key) % Returns index of bucket
  (remainder hashed-key (size table)))

(defun no-op (x) x)

%%% Useful related function

(defun StrHash (S)	 % Compute hash function of string
  (let ((len (Size S))	 % (StrLen S)
	(AvailableBits (Difference BitsPerWord 8))
	(HashVal 0))
    (if (GreaterP Len AvailableBits) then
	(setq Len AvailableBits))
    % (setq s (StrInf s))
    (for (from I 0 Len)
	 (do (setq HashVal
		   (LXOR HashVal
			 (LShift (Indx S I)	 % (StrByt S I)
				 (Difference AvailableBits I))))))
    HashVal))