Tue Sep 1 13:44:21 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Fix overload resolution using types and test caching the overload resolution.
hunk ./src/overload-resolution.lisp 143
- (function-name nil :type (or symbol function) :read-only t)
+ (function-name nil :type (or symbol list function) :read-only t)
hunk ./src/overload-resolution.lisp 211
-(defmacro make-match (type &optional (name ''identity)
- (argument nil)
+(defmacro make-match (type &optional (name ''identity) (argument nil)
hunk ./src/overload-resolution.lisp 214
- :function-name ,(conversion-function name argument)
- ,@args))
+ :function-name ,(conversion-function name argument)
+ ,@args))
hunk ./src/overload-resolution.lisp 501
- [_$_]
+
+
hunk ./src/sb-optimize.lisp 94
+
+;;; cache ==================================================================
+;;;
+;;; we could replace the call to #'find-best-viable-function in
+;;; #'call-using-args with a call to
+;;; #'find-best-viable-function-cached, but it is only doubles speed.
+
+(sb-int:defun-cached (find-best-viable-function-using-types-cached
+ :hash-function (lambda (name arguments
+ class const-p)
+ (declare (string name)
+ (list arguments)
+ (class class)
+ (boolean const-p))
+ (logand [_$_]
+ (logxor
+ (sxhash name)
+ (sxhash arguments)
+ (sxhash class)
+ (sxhash const-p))
+ #x1FF))
+ :hash-bits 9)
+ ((name equal) (arguments equal) (class eq) (const-p eq))
+ (declare (optimize (speed 3))
+ (inline find-best-viable-function-using-types))
+ (multiple-value-bind (method conversion-sequence)
+ (find-best-viable-function-using-types name arguments class const-p)
+ (list method (mapcar #'(lambda (s)
+ (if (symbolp s)
+ (fdefinition s)
+ #'(lambda (x)
+ (funcall (fdefinition (first s))
+ x
+ (second s)))))
+ conversion-sequence))))
+ [_$_]
+(declaim (inline find-best-viable-function-cached))
+(defun find-best-viable-function-cached (name arguments class const-p)
+ (declare (optimize (speed 3)))
+ (catch 'unspecific-type
+ (return-from find-best-viable-function-cached
+ (values-list
+ (find-best-viable-function-using-types-cached
+ name
+ (mapcar #'(lambda (o) (class-of o)) arguments)
+ class
+ const-p))))
+ (find-best-viable-function name arguments class const-p))
+
hunk ./src/using-type.lisp 16
- ,@body))
+ ,@body))