X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fslots-boot.lisp;h=9208b634f13aa001a5361c8ad9484f1139601698;hb=8a55e8e2feb7fd0faaaed6d420beec97dade94e4;hp=4ee0df1179a5a280c4f38168cbfe02b2abb7e05b;hpb=6c129930bd75f25a66aa0cbf0e5bc8091401d5ce;p=sbcl.git diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp index 4ee0df1..9208b63 100644 --- a/src/pcl/slots-boot.lisp +++ b/src/pcl/slots-boot.lisp @@ -65,16 +65,8 @@ (let ((slot-name (eval slot-name))) `(slot-boundp-normal ,object ',slot-name))) -(defun structure-slot-boundp (object) - (declare (ignore object)) - t) - (defun make-structure-slot-boundp-function (slotd) - (let* ((reader (slot-definition-internal-reader-function slotd)) - (fun (lambda (object) - (not (eq (funcall reader object) +slot-unbound+))))) - (declare (type function reader)) - fun)) + (lambda (object) (declare (ignore object)) t)) (defun get-optimized-std-accessor-method-function (class slotd name) (if (structure-class-p class) @@ -162,10 +154,8 @@ (defun make-optimized-structure-slot-value-using-class-method-function (function) (declare (type function function)) (lambda (class object slotd) - (let ((value (funcall function object))) - (if (eq value +slot-unbound+) - (slot-unbound class object (slot-definition-name slotd)) - value)))) + (declare (ignore class slotd)) + (funcall function object))) (defun make-optimized-structure-setf-slot-value-using-class-method-function (function) (declare (type function function)) @@ -173,11 +163,10 @@ (declare (ignore class slotd)) (funcall function nv object))) -(defun make-optimized-structure-slot-boundp-using-class-method-function (function) - (declare (type function function)) +(defun make-optimized-structure-slot-boundp-using-class-method-function () (lambda (class object slotd) - (declare (ignore class slotd)) - (not (eq (funcall function object) +slot-unbound+)))) + (declare (ignore class object slotd)) + t)) (defun get-optimized-std-slot-value-using-class-method-function (class slotd @@ -188,8 +177,7 @@ (slot-definition-internal-reader-function slotd))) (writer (make-optimized-structure-setf-slot-value-using-class-method-function (slot-definition-internal-writer-function slotd))) - (boundp (make-optimized-structure-slot-boundp-using-class-method-function - (slot-definition-internal-writer-function slotd)))) + (boundp (make-optimized-structure-slot-boundp-using-class-method-function))) (let* ((fsc-p (cond ((standard-class-p class) nil) ((funcallable-standard-class-p class) t) (t (error "~S is not a standard-class" class))))