Ignore:
Timestamp:
Jan 17, 2013, 3:44:56 PM (6 years ago)
Author:
gb
Message:

Hash pathnames better. Hash strings better under EQUALP.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/l0-hash.lisp

    r15525 r15596  
    300300                (pathname (%%equalphash key))
    301301                (t (%%eqlhash key)))))))
     302
     303(defun %string-hash-folding-case (start string len)
     304  (declare (index start len)
     305           (optimize (speed 3) (safety 0)))
     306  (let* ((copy (make-string len)))
     307    (declare (dynamic-extent copy))
     308    (dotimes (i len (values (%string-hash 0 copy len)))
     309      (declare (index i))
     310      (setf (schar copy i)
     311            (char-upcase (schar string start))
     312            start (1+ start)))))
     313
     314(defun %hash-pathname (key)
     315  (let* ((logical (istruct-typep key 'logical-pathnames))
     316         (case-sensitive *case-sensitive-filesystem*)
     317         (hash 0))
     318    (flet ((incorporate (component)
     319             (setq hash (logand target::target-most-positive-fixnum
     320                                (+ hash
     321                                   (if case-sensitive
     322                                     (%%equalhash component)
     323                                     (%%equalphash component)))))))
     324      (if logical
     325        (progn
     326          (incorporate (%logical-pathname-host key))
     327          (incorporate (%logical-pathname-version key)))
     328        (incorporate (%physical-pathname-device key)))
     329      (dolist (element (%pathname-directory key))
     330        (incorporate element))
     331      (incorporate (%pathname-name key))
     332      (incorporate (%pathname-type key))
     333      (mixup-hash-code hash))))
     334   
     335
     336         
     337   
    302338
    303339(defun update-hash-flags (hash vector addressp)
     
    17261762        ((hash-table-p key)
    17271763         (equalphash-hash-table key))
     1764        ((typep key 'simple-string)
     1765         (%string-hash-folding-case 0 key (length key)))
     1766        ((typep key 'string)
     1767         (multiple-value-bind (data offset) (array-data-and-offset key)
     1768           (%string-hash-folding-case offset data (length key))))
     1769        ((pathnamep key)
     1770         (%hash-pathname key))
    17281771        ((or (istructp key)
    17291772             (structurep key))  ; was (gvectorp key)
Note: See TracChangeset for help on using the changeset viewer.