X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Flow.lisp;h=dd2295d91c7abafbdfad80703ba1fbc45fe2a1d7;hb=316eddc9b2b1aa24012ed826ce700105fdbcdfdb;hp=44c4036d957ab5ccb65a39fcb590abf8fc7fbf34;hpb=4eb1a6d3ad2b7dcc19ac0ec979a1eb1eb049659a;p=sbcl.git diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp index 44c4036..dd2295d 100644 --- a/src/pcl/low.lisp +++ b/src/pcl/low.lisp @@ -97,31 +97,16 @@ (import 'sb-kernel:funcallable-instance-p) -;;; This "works" on non-PCL FINs, which allows us to weaken -;;; FUNCALLABLE-INSTANCE-P to return true for all FINs. This is also -;;; necessary for bootstrapping to work, since the layouts for early -;;; GFs are not initially initialized. -(defmacro funcallable-instance-data-1 (fin slot) - (ecase (eval slot) - (wrapper `(sb-kernel:%funcallable-instance-layout ,fin)) - (slots `(sb-kernel:%funcallable-instance-info ,fin 0)))) - -;;; FIXME: Now that we no longer try to make our CLOS implementation -;;; portable to other implementations of Common Lisp, all the -;;; funcallable instance wrapper logic here can go away in favor -;;; of direct calls to native SBCL funcallable instance operations. (defun set-funcallable-instance-fun (fin new-value) (declare (type function new-value)) (aver (funcallable-instance-p fin)) (setf (sb-kernel:funcallable-instance-fun fin) new-value)) (defmacro fsc-instance-p (fin) `(funcallable-instance-p ,fin)) -(defmacro fsc-instance-class (fin) - `(wrapper-class (funcallable-instance-data-1 ,fin 'wrapper))) (defmacro fsc-instance-wrapper (fin) - `(funcallable-instance-data-1 ,fin 'wrapper)) + `(sb-kernel:%funcallable-instance-layout ,fin)) (defmacro fsc-instance-slots (fin) - `(funcallable-instance-data-1 ,fin 'slots)) + `(sb-kernel:%funcallable-instance-info ,fin 0)) (declaim (inline clos-slots-ref (setf clos-slots-ref))) (declaim (ftype (function (simple-vector index) t) clos-slots-ref)) @@ -180,10 +165,10 @@ ;;; SET-FUN-NAME-INTERN which takes a list spec for a function ;;; name and turns it into a symbol if need be. ;;; -;;; When given a funcallable instance, SET-FUN-NAME *must* -;;; side-effect that FIN to give it the name. When given any other -;;; kind of function SET-FUN-NAME is allowed to return a new -;;; function which is "the same" except that it has the name. +;;; When given a funcallable instance, SET-FUN-NAME *must* side-effect +;;; that FIN to give it the name. When given any other kind of +;;; function SET-FUN-NAME is allowed to return a new function which is +;;; "the same" except that it has the name. ;;; ;;; In all cases, SET-FUN-NAME must return the new (or same) ;;; function. (Unlike other functions to set stuff, it does not return @@ -199,10 +184,7 @@ (typep fcn 'generic-function) (eq (class-of fcn) *the-class-standard-generic-function*)) (setf (sb-kernel:%funcallable-instance-info fcn 1) new-name) - (error 'simple-type-error - :datum fcn - :expected-type 'generic-function - :format-control "internal error: bad function type")) + (bug "unanticipated function type")) fcn) (t ;; pw-- This seems wrong and causes trouble. Tests show