(FILECREATED "23-Jan-86 18:05:27" {ERIS}<LISPCORE>LIBRARY>CMLHASH.;6 6076   

      changes to:  (FNS SXHASH REMHASH MAKE-HASH-TABLE CLHASH::EQLHASHBITSFN)
                   (MACROS SXHASH-ROT SXHASH-STRING SXHASH-LIST)
                   (VARS CMLHASHCOMS)

      previous date: "20-Jan-86 22:16:51" {ERIS}<LISPCORE>LIBRARY>CMLHASH.;3)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT CMLHASHCOMS)

(RPAQQ CMLHASHCOMS [(* * External interface)
                    (PROP SETFN CL:GETHASH)
                    (FNS CL:MAPHASH CL:PUTHASH HASH-TABLE-COUNT HASH-TABLE-P MAKE-HASH-TABLE SXHASH)
                    (P (MOVD (QUOTE GETHASH)
                             (QUOTE CL:GETHASH)))
                    (* * Internal interface)
                    (CONSTANTS SXHASH-MAX)
                    (MACROS SXHASH-LIST SXHASH-ROT SXHASH-STRING)
                    (FNS CLHASH::EQLHASHBITSFN)
                    (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                           (ADDVARS (NLAMA)
                                  (NLAML)
                                  (LAMA MAKE-HASH-TABLE CL:PUTHASH])
(* * External interface)


(PUTPROPS CL:GETHASH SETFN CL:PUTHASH)
(DEFINEQ

(CL:MAPHASH

  (CL:LAMBDA (
FUNCTION
 HASH-TABLE)                         (* raf "17-Nov-85 02:35")

    [
MAPHASH
 HASH-TABLE (
FUNCTION
 (LAMBDA (VALUE KEY)
		   (
FUNCALL
 FUNCTION KEY VALUE]
    NIL))

(CL:PUTHASH

  (CL:LAMBDA (KEY HASH-TABLE VALUE &OPTIONAL DEFAULT)
    (
PUTHASH
 KEY VALUE HASH-TABLE)))

(HASH-TABLE-COUNT

  (CL:LAMBDA (HASH-TABLE)
    (
HARRAYPROP
 HASH-TABLE (
QUOTE
 NUMKEYS))))

(HASH-TABLE-P

  (CL:LAMBDA (OBJECT)
    (
HARRAYP
 OBJECT)))

(MAKE-HASH-TABLE
  (CL:LAMBDA (&KEY (TEST (FUNCTION EQL))
                   (SIZE 65)
                   REHASH-SIZE REHASH-THRESHOLD)                           (* raf 
                                                                           "23-Jan-86 16:53")
                                                                           (* 
                                                                           "Creates and returns a hash table.  See manual for details.")
    [COND
       ((EQ TEST (FUNCTION EQ))
        (SETQ TEST (QUOTE EQ)))
       ((EQ TEST (FUNCTION EQL))
        (SETQ TEST (QUOTE EQL)))
       ((EQ TEST (FUNCTION CL:EQUAL))
        (SETQ TEST (QUOTE CL:EQUAL]
    (COND
       ((EQ TEST (QUOTE EQ))
        (HASHARRAY SIZE REHASH-SIZE))
       ((EQ TEST (QUOTE EQL))
        (HASHARRAY SIZE REHASH-SIZE (FUNCTION CLHASH::EQLHASHBITSFN)
               (FUNCTION EQL)))
       ((EQ TEST (QUOTE EQUAL))
        (HASHARRAY SIZE REHASH-SIZE (FUNCTION SXHASH)
               (FUNCTION CL:EQUAL)))
       (ERROR "Bad TEST for MAKE-HASH-ARRAY" TEST))))

(SXHASH
  [LAMBDA (OBJECT)                                                         (* raf 
                                                                           "23-Jan-86 18:03")
    (TYPECASE OBJECT (SIMPLE-STRING (STRINGHASHBITS OBJECT))
           (SYMBOL (STRINGHASHBITS (SYMBOL-NAME OBJECT)))
           (STRING (SXHASH-STRING OBJECT))
           (LIST (SXHASH-LIST OBJECT))
           (ARRAY (ARRAY-RANK OBJECT))
           (FLOAT (LOGXOR (fetch (FLOATP HIWORD) of OBJECT)
                         (fetch (FLOATP LOWORD) of OBJECT)))
           (INTEGER (LOGAND OBJECT 65535))
           [RATIO (LOGXOR (SXHASH (NUMERATOR OBJECT))
                         (SXHASH (DENOMINATOR OBJECT]
           [COMPLEX (LOGXOR (SXHASH (REALPART OBJECT))
                           (SXHASH (IMAGPART OBJECT]
           (T (\EQHASHINGBITS OBJECT])
)
(MOVD (QUOTE GETHASH)
      (QUOTE CL:GETHASH))
(* * Internal interface)

(DECLARE: EVAL@COMPILE 

(RPAQQ SXHASH-MAX 13)

(CONSTANTS SXHASH-MAX)
)
(DECLARE: EVAL@COMPILE 
[DEFMACRO SXHASH-LIST (SEQUENCE)
       (BQUOTE (CL:DO ((SEQUENCE (\, SEQUENCE)
                              (CDR SEQUENCE))
                       (INDEX 0 (1+ INDEX))
                       (HASH 2))
                      ((OR (ATOM SEQUENCE)
                           (= INDEX SXHASH-MAX))
                       HASH)
                      (DECLARE (TYPE FIXNUM HASH))
                      (SETQ HASH (SXHASH-ROT (LOGXOR HASH (SXHASH (CAR SEQUENCE)))
                                        7]
[DEFMACRO SXHASH-ROT (X NUM)
       "Rotates x left by num bits."
       (BQUOTE (ROT (\, X)
                    (\, NUM)
                    (\, (INTEGERLENGTH MOST-POSITIVE-FIXNUM]
[DEFMACRO SXHASH-STRING (SEQUENCE)
       "Returns hash value for a non-simple string."
       (BQUOTE (CL:DO ((I 0 (1+ I))
                       (LENGTH (MAX (CL:LENGTH (\, SEQUENCE))
                                    SXHASH-MAX))
                       (HASH 0))
                      ((= I LENGTH)
                       HASH)
                      (DECLARE (TYPE FIXNUM I LENGTH HASH))
                      (SETQ HASH (SXHASH-ROT (LOGXOR HASH (CHAR-INT (AREF (\, SEQUENCE)
                                                                          I)))
                                        7]
)
(DEFINEQ

(CLHASH::EQLHASHBITSFN
  [LAMBDA (OBJ)                                                            (* raf 
                                                                           "23-Jan-86 17:23")
    (TYPECASE OBJECT (CHARACTER)
           (INTEGER (LOGAND OBJ 65535))
           (FLOAT (LOGXOR (fetch (FLOATP HIWORD) of OBJ)
                         (fetch (FLOATP LOWORD) of OBJ)))
           [RATIO (LOGXOR (CLHASH::EQLHASHBITSFN (NUMERATOR OBJECT))
                         (CLHASH::EQLHASHBITSFN (DENOMINATOR OBJECT]
           [COMPLEX (LOGXOR (CLHASH::EQLHASHBITSFN (REALPART OBJECT))
                           (CLHASH::EQLHASHBITSFN (IMAGPART OBJECT]
           (T (\EQHASHINGBITS OBJECT])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA MAKE-HASH-TABLE CL:PUTHASH)
)
(PUTPROPS CMLHASH COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1233 3671 (CL:MAPHASH 1243 . 1461) (CL:PUTHASH 1463 . 1573) (HASH-TABLE-COUNT 1575 . 
1676) (HASH-TABLE-P 1678 . 1744) (MAKE-HASH-TABLE 1746 . 2824) (SXHASH 2826 . 3669)) (5133 5847 (
CLHASH::EQLHASHBITSFN 5143 . 5845)))))
STOP