From 7b05c6dadd973896d3d60c2a5ae36db2d048d38d Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 13 Aug 2007 13:40:40 +0000 Subject: [PATCH] 1.0.8.23: merge CAN-OPTIMIZE-ACCESS and CAN-OPTIMIZE-ACCESS1 * First is the only caller of the first, so just move the body to the call site. --- src/pcl/vector.lisp | 65 +++++++++++++++++++++------------------------------ version.lisp-expr | 2 +- 2 files changed, 27 insertions(+), 40 deletions(-) diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp index fb0d537..1a6f79f 100644 --- a/src/pcl/vector.lisp +++ b/src/pcl/vector.lisp @@ -310,45 +310,32 @@ (slot-boundp 'boundp))) (var (cadr form)) (slot-name (eval (caddr form)))) ; known to be constant - (can-optimize-access1 var required-parameters env type slot-name))) - -;;; FIXME: This looks like an internal helper function for -;;; CAN-OPTIMIZE-ACCESS, and it is used that way, but it's also called -;;; bare from several places in the code. Perhaps the two functions -;;; should be renamed CAN-OPTIMIZE-ACCESS-FOR-FORM and -;;; CAN-OPTIMIZE-ACCESS-FOR-VAR. If so, I'd just as soon use keyword -;;; args instead of optional ones, too. -(defun can-optimize-access1 (var required-parameters env - &optional type slot-name) - (when (and (consp var) (eq 'the (car var))) - ;; FIXME: We should assert list of length 3 here. Or maybe we - ;; should just define EXTRACT-THE, replace the whole - ;; (WHEN ..) - ;; form with - ;; (AWHEN (EXTRACT-THE VAR) - ;; (SETF VAR IT)) - ;; and then use EXTRACT-THE similarly to clean up the other tests - ;; against 'THE scattered through the PCL code. - (setq var (caddr var))) - (when (symbolp var) - (let* ((rebound? (caddr (var-declaration '%variable-rebinding var env))) - (parameter-or-nil (car (memq (or rebound? var) - required-parameters)))) - (when parameter-or-nil - (let* ((class-name (caddr (var-declaration '%class - parameter-or-nil - env))) - (class (find-class class-name nil))) - (when (or (not (eq *boot-state* 'complete)) - (and class (not (class-finalized-p class)))) - (setq class nil)) - (when (and class-name (not (eq class-name t))) - (when (or (null type) - (not (and class - (memq *the-class-structure-object* - (class-precedence-list class)))) - (optimize-slot-value-by-class-p class slot-name type)) - (cons parameter-or-nil (or class class-name))))))))) + (when (and (consp var) (eq 'the (car var))) + ;; FIXME: We should assert list of length 3 here. Or maybe we + ;; should just define EXTRACT-THE, replace the whole (WHEN ..) + ;; form with (AWHEN (EXTRACT-THE VAR) (SETF VAR IT)) and then + ;; use EXTRACT-THE similarly to clean up the other tests against + ;; 'THE scattered through the PCL code. + (setq var (caddr var))) + (when (symbolp var) + (let* ((rebound? (caddr (var-declaration '%variable-rebinding var env))) + (parameter-or-nil (car (memq (or rebound? var) + required-parameters)))) + (when parameter-or-nil + (let* ((class-name (caddr (var-declaration '%class + parameter-or-nil + env))) + (class (find-class class-name nil))) + (when (or (not (eq *boot-state* 'complete)) + (and class (not (class-finalized-p class)))) + (setq class nil)) + (when (and class-name (not (eq class-name t))) + (when (or (null type) + (not (and class + (memq *the-class-structure-object* + (class-precedence-list class)))) + (optimize-slot-value-by-class-p class slot-name type)) + (cons parameter-or-nil (or class class-name)))))))))) ;;; Check whether the binding of the named variable is modified in the ;;; method body. diff --git a/version.lisp-expr b/version.lisp-expr index 0adb185..bfe2318 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".) -"1.0.8.22" +"1.0.8.23" -- 1.7.10.4