Wed Jul 8 22:41:19 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Speedup overload resolution and some other stuff for faster C++ method calling.

--- old-smoke/src/overload-resolution.lisp 2014-10-30 08:13:04.000000000 +0100

+++ new-smoke/src/overload-resolution.lisp 2014-10-30 08:13:04.000000000 +0100

@@ -76,6 +76,8 @@

(cstring-cmp (smoke-method-name method)

name))))

+;;; INLINE OPTIMIZE

+(declaim (inline first-unabigious-index))

(defun first-unabigious-index (smoke index)

(declare (type smoke-index index)

(optimize (speed 3)))

@@ -94,7 +96,8 @@

(class-id (id class))

(smoke (smoke class))

(end (1+ (smoke-array-length (smoke-module-method-maps smoke)))))

- (declare (type (smoke-index 0) start end))

+ (declare (type (smoke-index 0) start end)

+ (dynamic-extent start))

(loop until (> start end) do

(let* ((index (the smoke-index (floor (+ end start) 2)))

(method (make-smoke-method

@@ -111,7 +114,7 @@

'method)))))

(cmp (the (integer -1 1) (method-cmp method class-id name))))

(declare (type (integer -1 1) cmp)

- (dynamic-extent method index cmp))

+ (dynamic-extent method))

(ecase cmp

(-1 (setf start (1+ index)))

(0 (return-from find-method-for-class index))

@@ -190,50 +193,26 @@

(defconstant +promotion+ 1)

(defconstant +conversion+ 2))

-(defclass std-conversion ()

- ((function-name :accessor conversion-function-name

- :initarg :conversion-function-name))

- (:documentation "A conversion"))

-

-(defclass exact-match (std-conversion)

- ((rank :reader rank

- :allocation :class

- :type fixnum

- :initform +exact-match+)))

-

-(defclass promotion (std-conversion)

- ((rank :reader rank

- :allocation :class

- :type fixnum

- :initform +promotion+)))

-

-(defclass number-conversion (std-conversion)

- ((rank :reader rank

- :allocation :class

- :type fixnum

- :initform +conversion+)))

-

-(defclass pointer-conversion (std-conversion)

- ((rank :reader rank

- :allocation :class

- :type fixnum

- :initform (1+ +conversion+))

- (from :reader from

- :initarg :from)

- (to :reader to

- :initarg :to)))

-

-(defclass boolean-conversion (std-conversion)

- ((rank :reader rank

- :allocation :class

- :type fixnum

- :initform (+ 2 +conversion+))))

-

-(defclass user-conversion (std-conversion)

- ((rank :reader rank

- :allocation :class

- :type fixnum

- :initform (+ 3 +conversion+))))

+(declaim (inline make-conversion make-exact-match make-promotion

+ make-number-conversion make-pointer-conversion

+ make-boolean-conversion make-user-conversion))

+(defstruct conversion

+ (function-name nil :type (or symbol function) :read-only t)

+ (rank -1 :type fixnum :read-only t))

+

+(defstruct (exact-match (:include conversion (rank +exact-match+))))

+

+(defstruct (promotion (:include conversion (rank +promotion+))))

+

+(defstruct (number-conversion (:include conversion (rank +conversion+))))

+

+(defstruct (pointer-conversion (:include conversion (rank (1+ +conversion+))))

+ (from (find-class t) :type class :read-only t)

+ (to (find-class t) :type class :read-only t))

+

+(defstruct (boolean-conversion (:include conversion (rank (+ 2 +conversion+)))))

+

+(defstruct (user-conversion (:include conversion (rank (+ 3 +conversion+)))))

(defgeneric conversion< (conversion1 conversion2)

(:documentation

@@ -243,16 +222,20 @@

(:method (conversion1 conversion2)

(declare (optimize (speed 3)))

(or (null conversion2)

- (< (the fixnum (rank conversion1))

- (the fixnum (rank conversion2)))))

+ (< (the fixnum (conversion-rank conversion1))

+ (the fixnum (conversion-rank conversion2)))))

(:method ((conversion1 pointer-conversion) (conversion2 pointer-conversion))

(declare (optimize (speed 3)))

- (if (eq (from conversion1) (from conversion2))

+ (if (eq (pointer-conversion-from conversion1)

+ (pointer-conversion-from conversion2))

;; A->B < A->C <=> B subclass of C

- (subtypep (to conversion1) (to conversion2))

- (if (eq (to conversion1) (to conversion2))

+ (subtypep (pointer-conversion-to conversion1)

+ (pointer-conversion-to conversion2))

+ (if (eq (pointer-conversion-to conversion1)

+ (pointer-conversion-to conversion2))

;; B->A < C->A <=> B subclass of C

- (subtypep (from conversion1) (from conversion2))

+ (subtypep (pointer-conversion-from conversion1)

+ (pointer-conversion-from conversion2))

nil))))

(defgeneric conversion= (conversion1 conversion2)

@@ -260,7 +243,7 @@

"Returns true when the standard conversion sequence CONVERSION1

is indistinguishable from CONVERSION2.")

(:method (conversion1 conversion2)

- (= (rank conversion1) (rank conversion2)))

+ (= (conversion-rank conversion1) (conversion-rank conversion2)))

(:method ((conversion1 (eql nil)) (conversion2 (eql nil)))

t)

(:method ((conversion1 pointer-conversion) (conversion2 pointer-conversion))

@@ -291,9 +274,8 @@

(defmacro make-match (type &optional (name ''identity)

(argument nil)

&rest args)

- `(make-instance ,type

- :conversion-function-name ,(conversion-function name argument)

-

+ `(,(symbolicate 'make- (eval type))

+ :function-name ,(conversion-function name argument)

,@args))

(defun+using-type get-conversion-sequence object (object type &optional user)