From f98d63ddb86859259bf12f2e276fb577cbe168eb Mon Sep 17 00:00:00 2001 From: "Paul F. Dietz" Date: Fri, 5 Aug 2005 03:28:30 +0000 Subject: [PATCH] 0.9.3.29: Add source transforms to eliminate hairy arg processing in GETHASH. --- src/code/target-hash-table.lisp | 14 ++++++++++++++ src/compiler/fndb.lisp | 4 ++++ src/compiler/srctran.lisp | 10 +++++----- version.lisp-expr | 2 +- 4 files changed, 24 insertions(+), 6 deletions(-) diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp index 5adefc9..e4d0a32 100644 --- a/src/code/target-hash-table.lisp +++ b/src/code/target-hash-table.lisp @@ -412,6 +412,20 @@ such entry. Entries can be added using SETF." (declare (type hash-table hash-table) (values t (member t nil))) + (gethash3 key hash-table default)) + +(defun gethash2 (key hash-table) + #!+sb-doc + "Two argument version of GETHASH" + (declare (type hash-table hash-table) + (values t (member t nil))) + (gethash3 key hash-table nil)) + +(defun gethash3 (key hash-table default) + #!+sb-doc + "Three argument version of GETHASH" + (declare (type hash-table hash-table) + (values t (member t nil))) (without-gcing (cond ((= (get-header-data (hash-table-table hash-table)) sb!vm:vector-must-rehash-subtype) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 49f9cfe..fdc846c 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -761,6 +761,10 @@ (defknown hash-table-p (t) boolean (movable foldable flushable)) (defknown gethash (t hash-table &optional t) (values t boolean) (flushable unsafe)) ; not FOLDABLE, since hash table contents can change +(defknown sb!impl::gethash2 (t hash-table) (values t boolean) + (flushable unsafe)) ; not FOLDABLE, since hash table contents can change +(defknown sb!impl::gethash3 (t hash-table t) (values t boolean) + (flushable unsafe)) ; not FOLDABLE, since hash table contents can change (defknown %puthash (t hash-table t) t (unsafe)) (defknown remhash (t hash-table) boolean ()) (defknown maphash (callable hash-table) null (flushable call)) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 620ab2a..7383e72 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -129,11 +129,11 @@ (define-source-transform nth (n l) `(car (nthcdr ,n ,l))) (define-source-transform last (x) `(sb!impl::last1 ,x)) -;; (define-source-transform last (x) -;; `(let* ((x (the list ,x)) -;; (r (cdr x))) -;; (do () ((atom r) x) -;; (shiftf x r (cdr r))))) +(define-source-transform gethash (&rest args) + (case (length args) + (2 `(sb!impl::gethash2 ,@args)) + (3 `(sb!impl::gethash3 ,@args)) + (t (values nil t)))) (defvar *default-nthcdr-open-code-limit* 6) (defvar *extreme-nthcdr-open-code-limit* 20) diff --git a/version.lisp-expr b/version.lisp-expr index febc033..db875ec 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.3.28" +"0.9.3.29" -- 1.7.10.4