Artifact 7334d961d31be7ff6d64dad48fcce48251149ce35a0ba7a97ddd8bf724875361:

• File psl-1983/3-1/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: 6489) [annotate] [blame] [check-ins using] [more...]

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

% Edit by Cris Perdue,  9 Apr 1983 1159-PST
% Now uses fast, open-coded operations.
% 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 data-machine numeric-operators
		   fast-vector))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% 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 (leq 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 (igetv Table i))
	then t else nil)))

(defmethod (Hash Lookup) (key)
  (let ((i (Hash$HashBucket Table (funcall HashFn Key))))
    (let ((Entry (Ass CompareFn Key (igetv 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 (igetv Table i))))
      (if Entry then (RplacD Entry value)
	  else
	  (setf (igetv Table i)
		(cons (cons (funcall KeyCopyfn key) value)
		      (igetv 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 (igetv Table i))) (Value))
      (if Entry then
          (setq Value (cdr Entry))
	  (setf (igetv Table i) (DelQIP Entry (igetv Table i)))
	  (setf Usage (- Usage 1))
	  Value
	  else
	  NullValue))))

(defmethod (Hash MapAssn) (fn)
  (for (from i 0 (Size Table))
       (do (for (in a (igetv 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 (igetv oldtable i))
		  (do (=> Self PutAssn (car a) (cdr a))))))
    Self))

%%% Internal functions

(on fast-integers)

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

(defun no-op (x) x)

%%% Useful related function

(defun StrHash (S)	 % Compute hash function of string
  (let ((len (StrLen S))
	(AvailableBits (- (wconst InfBitLength) 8))
	(HashVal 0))
    (if (> Len AvailableBits) then
	(setq Len AvailableBits))
    (setq s (StrBase (StrInf s)))
    (for (from I 0 Len)
	 (do (setq HashVal
		   (LXOR HashVal
			 (LShift (Byte S I)
				 (- AvailableBits I))))))
    HashVal))

(off fast-integers)