Tue Sep  1 13:44:21 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * Fix overload resolution using types and test caching the overload resolution.
diff -rN -u old-smoke/src/overload-resolution.lisp new-smoke/src/overload-resolution.lisp
--- old-smoke/src/overload-resolution.lisp	2014-10-30 08:10:42.000000000 +0100
+++ new-smoke/src/overload-resolution.lisp	2014-10-30 08:10:42.000000000 +0100
@@ -140,7 +140,7 @@
                  make-number-conversion make-pointer-conversion
                  make-boolean-conversion make-user-conversion))
 (defstruct conversion
-  (function-name nil :type (or symbol function) :read-only t)
+  (function-name nil :type (or symbol list function) :read-only t)
   (rank -1 :type fixnum :read-only t))
 
 (defstruct (exact-match (:include conversion (rank 0))))
@@ -208,12 +208,11 @@
              ,name
              (fdefinition ,name)))))
 
-(defmacro make-match (type &optional (name ''identity)
-                      (argument nil)
+(defmacro make-match (type &optional (name ''identity) (argument nil)
                       &rest args)
   `(,(symbolicate  'make- (eval type))
-                  :function-name ,(conversion-function name argument)
-                  ,@args))
+     :function-name ,(conversion-function name argument)
+     ,@args))
       
 (defun+using-type get-conversion-sequence object (object type &optional user)
   "Retrains a conversion sequence to convert a instance of type CLASS
@@ -499,7 +498,8 @@
                                               (condition-method condition)
                                               (condition-class condition)
                                               (condition-arguments condition)))))
-  
+
+
 (defun call-using-args (object-or-class name arguments)
   "Calls the method NAME of OBJECT-OR-CLASS with ARGUMENTS."
   (declare (optimize (speed 3)))
diff -rN -u old-smoke/src/sb-optimize.lisp new-smoke/src/sb-optimize.lisp
--- old-smoke/src/sb-optimize.lisp	2014-10-30 08:10:42.000000000 +0100
+++ new-smoke/src/sb-optimize.lisp	2014-10-30 08:10:42.000000000 +0100
@@ -90,3 +90,52 @@
                                                               (get-class method)))))))
                             (list ,@(sequence-form
                                      sequence argument-names)))))))))))
+
+
+;;; 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))
diff -rN -u old-smoke/src/using-type.lisp new-smoke/src/using-type.lisp
--- old-smoke/src/using-type.lisp	2014-10-30 08:10:42.000000000 +0100
+++ new-smoke/src/using-type.lisp	2014-10-30 08:10:42.000000000 +0100
@@ -13,7 +13,7 @@
                 `(,function-name ,@args))
               (call-using-type (function-name &rest args)
                 `(,function-name ,@args)))
-       ,@body))
+     ,@body))
 
 (defun typep-using-type (object-type type)
   "Returns true when OBJECT-TYPE is a subtype of TYPE,