(in-package "SB-PCL")
\f
-(defmethod shared-initialize :after ((slotd standard-slot-definition)
- slot-names &key)
- (declare (ignore slot-names))
- (with-slots (allocation class)
- slotd
- (setq allocation (if (eq allocation :class) class allocation))))
-
-(defmethod shared-initialize :after ((slotd structure-slot-definition)
- slot-names
- &key (allocation :instance))
- (declare (ignore slot-names))
- (unless (eq allocation :instance)
- (error "Structure slots must have :INSTANCE allocation.")))
-
-(defmethod inform-type-system-about-class ((class structure-class) (name t))
- nil)
;;; methods
;;;
lambda-list lambda-list-p))
(when namep
- (set-function-name generic-function name))
+ (set-fun-name generic-function name))
(flet ((initarg-error (initarg value string)
(error "when initializing the generic function ~S:~%~
;; in the usual sort of way. For efficiency don't bother to
;; keep specialized-argument-positions sorted, rather depend
;; on our caller to do that.
- (iterate ((type-spec (list-elements (method-specializers method)))
- (pos (interval :from 0)))
- (unless (eq type-spec *the-class-t*)
- (pushnew pos specialized-argument-positions)))
+ (let ((pos 0))
+ (dolist (type-spec (method-specializers method))
+ (unless (eq type-spec *the-class-t*)
+ (pushnew pos specialized-argument-positions))
+ (incf pos)))
;; Finally merge the values for this method into the values
;; for the exisiting methods and return them. Note that if
;; num-of-requireds is NIL it means this is the first method
specialized-argument-positions)))
(defun make-discriminating-function-arglist (number-required-arguments restp)
- (nconc (gathering ((args (collecting)))
- (iterate ((i (interval :from 0 :below number-required-arguments)))
- (gather (intern (format nil "Discriminating Function Arg ~D" i))
- args)))
+ (nconc (let ((args nil))
+ (dotimes (i number-required-arguments)
+ (push (intern (format nil "Discriminating Function Arg ~D" i))
+ args))
+ (nreverse args))
(when restp
`(&rest ,(intern "Discriminating Function &rest Arg")))))
\f
(defun error-need-at-least-n-args (function n)
- (error "~@<The function ~2I~_~S ~I~_requires at least ~D argument~:P.~:>"
+ (error "~@<The function ~2I~_~S ~I~_requires at least ~W argument~:P.~:>"
function
n))
(if function-p
function
(make-fast-method-call
- :function (set-function-name function
- `(sdfun-method ,name))
+ :function (set-fun-name function `(sdfun-method ,name))
:arg-info fmc-arg-info))))))))))
(defvar *show-make-unordered-methods-emf-calls* nil)
;;; argument <gf1>, and returns a result <df1>, that result must not be
;;; passed to apply or funcall directly. Rather, <df1> must be stored as
;;; the funcallable instance function of the same generic function <gf1>
-;;; (using set-funcallable-instance-function). Then the generic function
+;;; (using set-funcallable-instance-fun). Then the generic function
;;; can be passed to funcall or apply.
;;;
;;; An important exception is that methods on this generic function are
;;; #'(lambda (arg)
;;; (cond (<some condition>
;;; <store some info in the generic function>
-;;; (set-funcallable-instance-function
+;;; (set-funcallable-instance-fun
;;; gf
;;; (compute-discriminating-function gf))
;;; (funcall gf arg))
;;; (defmethod compute-discriminating-function ((gf my-generic-function))
;;; #'(lambda (arg)
;;; (cond (<some condition>
-;;; (set-funcallable-instance-function
+;;; (set-funcallable-instance-fun
;;; gf
;;; #'(lambda (a) ..))
;;; (funcall gf arg))