Make &rest lambda list for static methods only when necessary.
Mon May 11 22:18:23 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Make &rest lambda list for static methods only when necessary.
hunk ./src/method.lisp 2
+(declaim (optimize (debug 3)))
hunk ./src/method.lisp 38
-(defun static-method-definition (method)
+(defun static-method-definition (method &optional (argument-count -1))
hunk ./src/method.lisp 45
- `(defun ,name (&rest args)
+ `(defun ,name ,(if (< argument-count 0)
+ '(&rest args)
+ (make-lambda argument-count))
hunk ./src/method.lisp 49
- ,method-name args))
+ ,method-name
+ ,(if (< argument-count 0)
+ 'args
+ `(list ,@(make-lambda argument-count)))))
hunk ./src/method.lisp 125
- (let ((function-symbol (static-method-symbol method)))
- (unless (nth-value 1 (gethash function-symbol function-symbols))
- (setf (gethash function-symbol function-symbols) t)
- (multiple-value-bind (def export) (static-method-definition method)
- (push def functions)
- (push export exports)))))))
+ (let* ((function-symbol (static-method-symbol method))
+ (methods (gethash function-symbol function-symbols)))
+ (setf (gethash function-symbol function-symbols)
+ (if methods (- (id method)) (id method)))))))
hunk ./src/method.lisp 130
+ (loop for id being the hash-values of function-symbols do
+ (let ((method (make-instance 'smoke-method
+ :id (abs id)
+ :smoke (eval smoke))))
+ (multiple-value-bind (definition export)
+ (static-method-definition
+ method
+ (if (< 0 id)
+ (get-arguments-length method)
+ -1))
+ (push definition functions)
+ (push export exports))))
hunk ./src/overload-resolution.lisp 83
-(defun candidate-functions (name argument-count class2)
+
+(defun viable-functions (name argument-count class2)
hunk ./src/overload-resolution.lisp 86
- (let (methods)
+ ;; 13.3.2
+ (let ((methods))
hunk ./src/overload-resolution.lisp 112
- [_$_]
-
hunk ./src/overload-resolution.lisp 258
- (let ((candidate-functions (candidate-functions name (length objects)
+ (let ((viable-functions (viable-functions name (length objects)
hunk ./src/overload-resolution.lisp 263
- (loop for method in candidate-functions do
+ (loop for method in viable-functions do
hunk ./src/overload-resolution.lisp 462
- (candidate-functions name
- (length arguments)
- (smoke-class-of object-or-class)))))
+ (viable-functions name
+ (length arguments)
+ (smoke-class-of object-or-class)))))