[Openmcl-cvs-notifications] r16189 - in /trunk/source: level-0/l0-hash.lisp lib/pprint.lisp

gb at clozure.com gb at clozure.com
Sat Sep 6 05:34:03 UTC 2014


Author: gb
Date: Sat Sep  6 05:34:03 2014
New Revision: 16189

Log:
Define (and inline) INVALID-HASH-KEY-P.
Don't do circularity detection on invalid hash keys.
Fixes ticket:1229 in the trunk.

Modified:
    trunk/source/level-0/l0-hash.lisp
    trunk/source/lib/pprint.lisp

Modified: trunk/source/level-0/l0-hash.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-0/l0-hash.lisp	(original)
+++ trunk/source/level-0/l0-hash.lisp	Sat Sep  6 05:34:03 2014
@@ -46,7 +46,9 @@
   (declaim (inline %hash-symbol))
   (declaim (inline hash-mod))
   (declaim (inline set-hash-key-conditional set-hash-value-conditional))
-  (declaim (inline hash-lock-free-p lock-free-gethash)))
+  (declaim (inline hash-lock-free-p lock-free-gethash))
+  (declaim (inline invalid-hash-key-p)))
+
 =

 #+eq-hash-monitor
 (progn
@@ -1127,13 +1129,16 @@
      (unlock-hash-table hash nil)
      hash)))
 =

+(defun invalid-hash-key-p (key)
+  ;; Anything else ?
+  (or (eq key free-hash-marker)
+      (eq key deleted-hash-key-marker)))
 =

 (defun puthash (key hash default &optional (value default))
   (declare (optimize (speed 3) (space 0)))
   (unless (typep hash 'hash-table)
     (report-bad-arg hash 'hash-table))
-  (when (or (eq key free-hash-marker)
-            (eq key deleted-hash-key-marker))
+  (when (invalid-hash-key-p key)
     (error "Can't use ~s as a hash-table key" key))
   (when (hash-lock-free-p hash)
     (return-from puthash (lock-free-puthash key hash value)))

Modified: trunk/source/lib/pprint.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/pprint.lisp	(original)
+++ trunk/source/lib/pprint.lisp	Sat Sep  6 05:34:03 2014
@@ -1187,8 +1187,10 @@
 ; if not pretty print a space before dot
 =

 (defun circularity-process (xp object interior-cdr? &aux (not-pretty (not =
*print-pretty*)))
+  (declare (ftype function invalid-hash-key-p))
   (unless (or (numberp object)
 	      (characterp object)
+              (invalid-hash-key-p object)
 	      (and (symbolp object)	;Reader takes care of sharing.
 		   (or (null *print-gensym*) (symbol-package object))))
     (let ((id (gethash object *circularity-hash-table*)))



More information about the Openmcl-cvs-notifications mailing list