From 3ba801e57a919c338466a31a7130c113dbe5ad9b Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 10 Aug 2006 11:24:03 +0000 Subject: [PATCH] 0.9.15.24: Cosmetic change ... s/pcl-funcallable-instance/standard-funcallable-instance/ (where by "STANDARD" we begin to mean CLOS/AMOP-compatible) --- src/pcl/boot.lisp | 3 ++- src/pcl/braid.lisp | 44 +++++++++++++++++++++++++++----------------- src/pcl/fsc.lisp | 4 ++-- src/pcl/low.lisp | 4 ++-- version.lisp-expr | 2 +- 5 files changed, 34 insertions(+), 23 deletions(-) diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index 562ad47..8758d01 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -1930,7 +1930,8 @@ bootstrapping. (defun make-early-gf (spec &optional lambda-list lambda-list-p function argument-precedence-order source-location) - (let ((fin (allocate-funcallable-instance *sgf-wrapper* *sgf-slots-init*))) + (let ((fin (allocate-standard-funcallable-instance + *sgf-wrapper* *sgf-slots-init*))) (set-funcallable-instance-function fin (or function diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index 008eb02..5a808ae 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -52,28 +52,38 @@ :initial-element +slot-unbound+)))) instance)) -(defmacro allocate-funcallable-instance-slots (wrapper &optional - slots-init-p slots-init) +(defmacro allocate-standard-funcallable-instance-slots + (wrapper &optional slots-init-p slots-init) `(let ((no-of-slots (wrapper-no-of-instance-slots ,wrapper))) - ,(if slots-init-p - `(if ,slots-init-p - (make-array no-of-slots :initial-contents ,slots-init) - (make-array no-of-slots :initial-element +slot-unbound+)) - `(make-array no-of-slots :initial-element +slot-unbound+)))) - -(defun allocate-funcallable-instance (wrapper &optional - (slots-init nil slots-init-p)) - (let ((fin (%make-pcl-funcallable-instance nil nil - (get-instance-hash-code)))) + ,(if slots-init-p + `(if ,slots-init-p + (make-array no-of-slots :initial-contents ,slots-init) + (make-array no-of-slots :initial-element +slot-unbound+)) + `(make-array no-of-slots :initial-element +slot-unbound+)))) + +(define-condition unset-funcallable-instance-function + (reference-condition simple-error) + () + (:default-initargs + :references (list '(:amop :generic-function allocate-instance) + '(:amop :function set-funcallable-instance-function)))) + +(defun allocate-standard-funcallable-instance + (wrapper &optional (slots-init nil slots-init-p)) + (let ((fin (%make-standard-funcallable-instance + nil nil (get-instance-hash-code)))) (set-funcallable-instance-function fin #'(lambda (&rest args) (declare (ignore args)) - (error "The function of the funcallable-instance ~S has not been set." - fin))) + (error 'unset-funcallable-instance-function + :format-control "~@" + :format-arguments (list fin)))) (setf (fsc-instance-wrapper fin) wrapper - (fsc-instance-slots fin) (allocate-funcallable-instance-slots - wrapper slots-init-p slots-init)) + (fsc-instance-slots fin) + (allocate-standard-funcallable-instance-slots + wrapper slots-init-p slots-init)) fin)) (defun allocate-structure-instance (wrapper &optional @@ -197,7 +207,7 @@ ())) (setq proto (if (eq meta 'funcallable-standard-class) - (allocate-funcallable-instance wrapper) + (allocate-standard-funcallable-instance wrapper) (allocate-standard-instance wrapper))) (setq direct-slots diff --git a/src/pcl/fsc.lisp b/src/pcl/fsc.lisp index 8739040..8313078 100644 --- a/src/pcl/fsc.lisp +++ b/src/pcl/fsc.lisp @@ -40,14 +40,14 @@ 'fsc-instance-slots) (defmethod raw-instance-allocator ((class funcallable-standard-class)) - 'allocate-funcallable-instance) + 'allocate-standard-funcallable-instance) (defmethod allocate-instance ((class funcallable-standard-class) &rest initargs) (declare (ignore initargs)) (unless (class-finalized-p class) (finalize-inheritance class)) - (allocate-funcallable-instance (class-wrapper class))) + (allocate-standard-funcallable-instance (class-wrapper class))) (defmethod make-reader-method-function ((class funcallable-standard-class) slot-name) diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp index 930dfd9..525f3cc 100644 --- a/src/pcl/low.lisp +++ b/src/pcl/low.lisp @@ -76,12 +76,12 @@ ;;;; PCL's view of funcallable instances -(!defstruct-with-alternate-metaclass pcl-funcallable-instance +(!defstruct-with-alternate-metaclass standard-funcallable-instance ;; KLUDGE: Note that neither of these slots is ever accessed by its ;; accessor name as of sbcl-0.pre7.63. Presumably everything works ;; by puns based on absolute locations. Fun fun fun.. -- WHN 2001-10-30 :slot-names (clos-slots name hash-code) - :boa-constructor %make-pcl-funcallable-instance + :boa-constructor %make-standard-funcallable-instance :superclass-name function :metaclass-name standard-classoid :metaclass-constructor make-standard-classoid diff --git a/version.lisp-expr b/version.lisp-expr index 75973b1..625c1e7 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.15.23" +"0.9.15.24" -- 1.7.10.4