(compile-or-load-defgeneric ',fun-name))
(load-defgeneric ',fun-name ',lambda-list ,@initargs)
,@(mapcar #'expand-method-definition methods)
- #',fun-name))))
+ (fdefinition ',fun-name)))))
(defun compile-or-load-defgeneric (fun-name)
(proclaim-as-fun-name fun-name)
(mname `(,(if (eq (cadr initargs-form) :function)
'method 'fast-method)
,name ,@qualifiers ,specls))
- (mname-sym (intern (let ((*print-pretty* nil)
- ;; (We bind *PACKAGE* to
- ;; KEYWORD here as a way to
- ;; force symbols to be printed
- ;; with explicit package
- ;; prefixes.)
- (*package* *keyword-package*))
- (format nil "~S" mname)))))
+ (mname-sym (let ((*print-pretty* nil)
+ ;; (We bind *PACKAGE* to KEYWORD here
+ ;; as a way to force symbols to be
+ ;; printed with explicit package
+ ;; prefixes.)
+ (target *package*)
+ (*package* *keyword-package*))
+ (format-symbol target "~S" mname))))
`(progn
(defun ,mname-sym ,(cadr fn-lambda)
,@(cddr fn-lambda))
`(list ,@(mapcar (lambda (specializer)
(if (consp specializer)
``(,',(car specializer)
- ,,(cadr specializer))
+ ,,(cadr specializer))
`',specializer))
specializers))
unspecialized-lambda-list
(setq next-method-p-p t)
form)
((eq (car form) 'setq)
+ ;; FIXME: this is possibly a little strong as
+ ;; conditions go. Ideally we would want to detect
+ ;; which, if any, of the method parameters are
+ ;; being set, and communicate that information to
+ ;; e.g. SPLIT-DECLARATIONS. However, the brute
+ ;; force method doesn't really cost much; a little
+ ;; loss of discrimination over IGNORED variables
+ ;; should be all. -- CSR, 2004-07-01
(setq setq-p t)
form)
((and (eq (car form) 'function)
;; failing that, to use a special
;; symbol prefix denoting privateness.
;; -- WHN 19991201
- (intern (format nil "FAST-~A"
- (car method-spec))
- *pcl-package*)))
- ,@(cdr method-spec))))
+ (format-symbol *pcl-package*
+ "FAST-~A"
+ (car method-spec))))
+ ,@(cdr method-spec))))
(set-fun-name mff name)
(unless mf
(set-mf-property :name name)))))
(let ((method-class (getf ,all-keys :method-class '.shes-not-there.)))
(unless (eq method-class '.shes-not-there.)
(setf (getf ,all-keys :method-class)
- (find-class method-class t ,env))))))
+ (find-class method-class t ,env))))))
(defun real-ensure-gf-using-class--generic-function
(existing