(let ((name (car fns))
(early-name (cadr fns)))
(setf (gdefinition name)
- (set-function-name
+ (set-fun-name
(lambda (&rest args)
(apply (fdefinition early-name) args))
name))))
(standard-generic-function t t)
real-get-method))
(ensure-generic-function-using-class
- ((generic-function function-name
+ ((generic-function fun-name
&key generic-function-class environment
&allow-other-keys)
(generic-function t)
real-ensure-gf-using-class--generic-function)
- ((generic-function function-name
+ ((generic-function fun-name
&key generic-function-class environment
&allow-other-keys)
(null t)
(generic-function standard-method-combination t)
standard-compute-effective-method))))
\f
-(defmacro defgeneric (function-name lambda-list &body options)
+(defmacro defgeneric (fun-name lambda-list &body options)
(let ((initargs ())
(methods ()))
(flet ((duplicate-option (name)
(arglist (elt qab arglist-pos))
(qualifiers (subseq qab 0 arglist-pos))
(body (nthcdr (1+ arglist-pos) qab)))
- `(defmethod ,function-name ,@qualifiers ,arglist ,@body))))
+ `(defmethod ,fun-name ,@qualifiers ,arglist ,@body))))
(macrolet ((initarg (key) `(getf initargs ,key)))
(dolist (option options)
(let ((car-option (car option)))
`',(initarg :declarations))))
`(progn
(eval-when (:compile-toplevel :load-toplevel :execute)
- (compile-or-load-defgeneric ',function-name))
- (load-defgeneric ',function-name ',lambda-list ,@initargs)
+ (compile-or-load-defgeneric ',fun-name))
+ (load-defgeneric ',fun-name ',lambda-list ,@initargs)
,@(mapcar #'expand-method-definition methods)
- `,(function ,function-name)))))
-
-(defun compile-or-load-defgeneric (function-name)
- (sb-kernel:proclaim-as-function-name function-name)
- (sb-kernel:note-name-defined function-name :function)
- (unless (eq (info :function :where-from function-name) :declared)
- (setf (info :function :where-from function-name) :defined)
- (setf (info :function :type function-name)
+ `,(function ,fun-name)))))
+
+(defun compile-or-load-defgeneric (fun-name)
+ (sb-kernel:proclaim-as-fun-name fun-name)
+ (sb-kernel:note-name-defined fun-name :function)
+ (unless (eq (info :function :where-from fun-name) :declared)
+ (setf (info :function :where-from fun-name) :defined)
+ (setf (info :function :type fun-name)
(sb-kernel:specifier-type 'function))))
-(defun load-defgeneric (function-name lambda-list &rest initargs)
- (when (fboundp function-name)
- (sb-kernel::style-warn "redefining ~S in DEFGENERIC" function-name))
+(defun load-defgeneric (fun-name lambda-list &rest initargs)
+ (when (fboundp fun-name)
+ (sb-kernel::style-warn "redefining ~S in DEFGENERIC" fun-name))
(apply #'ensure-generic-function
- function-name
+ fun-name
:lambda-list lambda-list
- :definition-source `((defgeneric ,function-name)
- ,*load-truename*)
+ :definition-source `((defgeneric ,fun-name) ,*load-truename*)
initargs))
\f
(defmacro defmethod (&rest args &environment env)
initargs-form &optional pv-table-symbol)
(let (fn
fn-lambda)
- (if (and (interned-symbol-p (function-name-block-name name))
+ (if (and (interned-symbol-p (fun-name-block-name name))
(every #'interned-symbol-p qualifiers)
(every #'(lambda (s)
(if (consp s)
;; These declarations seem to be used by PCL to pass
;; information to itself; when I tried to delete 'em
;; ca. 0.6.10 it didn't work. I'm not sure how
- ;; they work, but note the (VARIABLE-DECLARATION '%CLASS ..)
+ ;; they work, but note the (VAR-DECLARATION '%CLASS ..)
;; expression in CAN-OPTIMIZE-ACCESS1. -- WHN 2000-12-30
,@(remove nil
(mapcar (lambda (a s) (and (symbolp s)
(declare (ignorable ,@required-parameters))
,class-declarations
,@declarations
- (block ,(function-name-block-name
- generic-function-name)
+ (block ,(fun-name-block-name generic-function-name)
,@real-body)))
(constant-value-p (and (null (cdr real-body))
(constantp (car real-body))))
((and (memq (car form)
'(slot-value set-slot-value slot-boundp))
(constantp (caddr form)))
- (let ((parameter
- (can-optimize-access form required-parameters env)))
+ (let ((parameter (can-optimize-access form
+ required-parameters
+ env)))
(let ((fun (ecase (car form)
(slot-value #'optimize-slot-value)
(set-slot-value #'optimize-set-slot-value)
next-method-p-p)))))
(defun generic-function-name-p (name)
- (and (legal-function-name-p name)
+ (and (legal-fun-name-p name)
(gboundp name)
(if (eq *boot-state* 'complete)
(standard-generic-function-p (gdefinition name))
(setf (method-function-get mff p) v))))
(when method-spec
(when mf
- (setq mf (set-function-name mf method-spec)))
+ (setq mf (set-fun-name mf method-spec)))
(when mff
(let ((name `(,(or (get (car method-spec) 'fast-sym)
(setf (get (car method-spec) 'fast-sym)
(car method-spec))
*pcl-package*)))
,@(cdr method-spec))))
- (set-function-name mff name)
+ (set-fun-name mff name)
(unless mf
(set-mf-property :name name)))))
(when plist
(defun defgeneric-declaration (spec lambda-list)
(when (consp spec)
- (setq spec (get-setf-function-name (cadr spec))))
+ (setq spec (get-setf-fun-name (cadr spec))))
`(ftype ,(ftype-declaration-from-lambda-list lambda-list spec) ,spec))
\f
;;;; early generic function support
(defvar *!early-generic-functions* ())
-(defun ensure-generic-function (function-name
+(defun ensure-generic-function (fun-name
&rest all-keys
&key environment
&allow-other-keys)
(declare (ignore environment))
- (let ((existing (and (gboundp function-name)
- (gdefinition function-name))))
+ (let ((existing (and (gboundp fun-name)
+ (gdefinition fun-name))))
(if (and existing
(eq *boot-state* 'complete)
(null (generic-function-p existing)))
- (generic-clobbers-function function-name)
+ (generic-clobbers-function fun-name)
(apply #'ensure-generic-function-using-class
- existing function-name all-keys))))
+ existing fun-name all-keys))))
-(defun generic-clobbers-function (function-name)
+(defun generic-clobbers-function (fun-name)
(error 'simple-program-error
:format-control "~S already names an ordinary function or a macro."
- :format-arguments (list function-name)))
+ :format-arguments (list fun-name)))
(defvar *sgf-wrapper*
(boot-make-wrapper (early-class-size 'standard-generic-function)
(defun make-early-gf (spec &optional lambda-list lambda-list-p function)
(let ((fin (allocate-funcallable-instance *sgf-wrapper* *sgf-slots-init*)))
- (set-funcallable-instance-function
+ (set-funcallable-instance-fun
fin
(or function
(if (eq spec 'print-object)
fin
'source
*load-truename*)
- (set-function-name fin spec)
+ (set-fun-name fin spec)
(let ((arg-info (make-arg-info)))
(setf (early-gf-arg-info fin) arg-info)
(when lambda-list-p
(defun real-ensure-gf-using-class--generic-function
(existing
- function-name
+ fun-name
&rest all-keys
&key environment (lambda-list nil lambda-list-p)
(generic-function-class 'standard-generic-function gf-class-p)
(prog1
(apply #'reinitialize-instance existing all-keys)
(when lambda-list-p
- (proclaim (defgeneric-declaration function-name lambda-list)))))
+ (proclaim (defgeneric-declaration fun-name lambda-list)))))
(defun real-ensure-gf-using-class--null
(existing
- function-name
+ fun-name
&rest all-keys
&key environment (lambda-list nil lambda-list-p)
(generic-function-class 'standard-generic-function)
(declare (ignore existing))
(real-ensure-gf-internal generic-function-class all-keys environment)
(prog1
- (setf (gdefinition function-name)
+ (setf (gdefinition fun-name)
(apply #'make-instance generic-function-class
- :name function-name all-keys))
+ :name fun-name all-keys))
(when lambda-list-p
- (proclaim (defgeneric-declaration function-name lambda-list)))))
+ (proclaim (defgeneric-declaration fun-name lambda-list)))))
\f
(defun get-generic-function-info (gf)
;; values nreq applyp metatypes nkeys arg-info
(fn (fdefinition fn-name))
(initargs
(list :function
- (set-function-name
+ (set-fun-name
#'(lambda (args next-methods)
(declare (ignore
next-methods))
gf (method-generic-function method)
temp (and gf (generic-function-name gf))
name (if temp
- (intern-function-name
+ (intern-fun-name
(make-method-spec temp
(method-qualifiers method)
(unparse-specializers
(and
(setq method (get-method gf quals specls errorp))
(setq name
- (intern-function-name (make-method-spec gf-spec
- quals
- specls))))))))
+ (intern-fun-name (make-method-spec gf-spec
+ quals
+ specls))))))))
(values gf method name)))
\f
(defun extract-parameters (specialized-lambda-list)
`((declare (%variable-rebinding ,in ,instance)))))
,in
(symbol-macrolet ,(mapcar #'(lambda (slot-entry)
- (let ((variable-name
+ (let ((var-name
(if (symbolp slot-entry)
slot-entry
(car slot-entry)))
(if (symbolp slot-entry)
slot-entry
(cadr slot-entry))))
- `(,variable-name
+ `(,var-name
(slot-value ,in ',slot-name))))
slots)
,@body))))
`((declare (%variable-rebinding ,in ,instance)))))
,in
(symbol-macrolet ,(mapcar #'(lambda (slot-entry)
- (let ((variable-name (car slot-entry))
+ (let ((var-name (car slot-entry))
(accessor-name (cadr slot-entry)))
- `(,variable-name
- (,accessor-name ,in))))
+ `(,var-name (,accessor-name ,in))))
slots)
,@body))))