repos / smoke / annotate_shade
summary | shortlog | log | tree | commit | commitdiff | headdiff | annotate | filehistory
normal | plain | shade | zebra
Speedup overload resolution and some other stuff for faster C++ method calling.
Annotate for file src/method.lisp
2009-04-05 tobias 1 (in-package :smoke)
15:36:29 ' 2
2009-06-11 tobias 3 (defun constant-definition (package method smoke)
2009-04-05 tobias 4 "Returns an expression that defines a constant for the enum METHOD.
15:36:29 ' 5 The second return value is the expression to export the constant."
' 6 (let ((symbol
2009-09-09 tobias 7 (if (string= (name (get-class method))
13:22:32 ' 8 "Qt")
2009-04-05 tobias 9 (lispify (concatenate 'string "+" (name method)
2009-06-11 tobias 10 "+")
2009-08-30 tobias 11 package)
2009-04-05 tobias 12 (lispify (concatenate 'string
15:36:29 ' 13 (name (get-class method))
' 14 ".+"
2009-06-11 tobias 15 (name method) "+")
2009-08-30 tobias 16 package))))
2009-04-05 tobias 17 (values
2009-08-30 tobias 18 `(define-constant ,symbol
13:51:40 ' 19 (make-instance 'enum
' 20 :value ,(enum-call method)
' 21 :type (make-instance 'smoke-type
' 22 :id ,(id (return-type method))
' 23 :smoke ,smoke))
' 24 :test #'enum=)
2009-05-14 tobias 25 symbol)))
2009-04-05 tobias 26
2009-06-11 tobias 27 (defun static-method-symbol (package method)
2009-04-05 tobias 28 "Returns the lisp symbol for the static method METHOD."
15:36:29 ' 29 (let ((class (get-class method)))
' 30 (lispify (concatenate 'string
' 31 (if (string= (name class)
' 32 "QGlobalSpace")
' 33 nil
' 34 (concatenate 'string
' 35 (name class)
' 36 "."))
2009-06-11 tobias 37 (name method))
14:35:40 ' 38 package)))
2009-04-05 tobias 39
2009-06-11 tobias 40 (defun static-method-definition (package method &optional (argument-count -1))
2009-04-05 tobias 41 "Returns an expression to define a function for the static METHOD.
15:36:29 ' 42 The second return value is the expression to export the function."
' 43 (let* ((class (get-class method))
' 44 (method-name (name method))
2009-06-11 tobias 45 (name (static-method-symbol package method)))
2009-04-05 tobias 46 (values
2009-05-11 tobias 47 `(defun ,name ,(if (< argument-count 0)
20:18:23 ' 48 '(&rest args)
' 49 (make-lambda argument-count))
2010-01-10 tobias 50 (call-using-args (find-class (quote ,(lispify (name class) package)))
08:49:36 ' 51 ,method-name
' 52 ,(if (< argument-count 0)
' 53 'args
' 54 `(list ,@(make-lambda argument-count)))))
2009-05-14 tobias 55 name)))
2009-04-05 tobias 56
2009-05-19 tobias 57 (defun ensure-generic-methods (symbols-names)
11:09:12 ' 58 "Ensures the generic functions for SYMBOLS-NAMES."
' 59 (declare (list symbols-names)
' 60 (optimize (speed 3)))
' 61 (dolist (symbol-name symbols-names)
' 62 (ensure-generic-function (first symbol-name)
' 63 :cxx-name (rest symbol-name)
2009-04-12 tobias 64 :generic-function-class 'smoke-gf
14:43:33 ' 65 :lambda-list '(object &rest args))
2009-05-19 tobias 66 (export (first symbol-name) :cxx)))
11:09:12 ' 67
2009-05-11 tobias 68 (defun setf-method-definition (method)
17:55:42 ' 69 `(defun (setf ,(lispify (subseq (name method) 3) :cxx)) (new-value object)
' 70 (,(lispify (name method) :cxx) object new-value)
' 71 new-value))
' 72
2009-06-22 tobias 73 (defmacro sizes= ((smoke)&rest arrays)
12:18:08 ' 74 `(and ,@(loop for array in arrays collect
' 75 `(= (smoke-array-length (,array ,smoke))
' 76 ,(smoke-array-length (funcall (fdefinition array)
' 77 (eval smoke)))))))
' 78
2009-04-05 tobias 79 (defmacro check-recompile (smoke)
2010-01-10 tobias 80 "Raises an error when the fasl of the DEFINE-METHOS was not compiled against
17:30:48 ' 81 the current smoke module."
' 82 `(eval-when (:load-toplevel :execute)
' 83 (unless (sizes= (,smoke)
' 84 smoke-module-methods
' 85 smoke-module-method-names
' 86 smoke-module-method-maps
' 87 smoke-module-classes
' 88 smoke-module-types)
' 89 (error "The smoke module ~A changed, you need to recompile the lisp file."
' 90 (smoke-get-module-name (smoke-module-pointer ,smoke))))))
2009-04-05 tobias 91
2009-06-11 tobias 92 (defmacro define-classes-and-gfs (package smoke)
2009-04-05 tobias 93 "Process the C++ methods of the Smoke module SMOKE.
15:36:29 ' 94 Expands to DEFUNs for static methods, DEFINE-CONSTANTs for enum methods
' 95 and a function do define the generic methods a load-time."
' 96 ;;; symbol - id pairs are stored in the hash-tables to prevent the
2009-07-01 tobias 97 ;;; multiple definition of a function with the same name.
2009-04-05 tobias 98 (let ((generics (make-hash-table))
15:36:29 ' 99 (constants)
' 100 (functions)
' 101 (function-symbols (make-hash-table))
2009-05-11 tobias 102 (setf-function-symbols (make-hash-table))
2009-04-05 tobias 103 (exports))
15:36:29 ' 104 (map-methods
' 105 #'(lambda (method)
2009-08-27 tobias 106 (when (and (enum-p method)
11:43:13 ' 107 ;; FIXME workaround for
' 108 ;; http://lists.kde.org/?l=kde-bindings&m=123464781307375
' 109 (not (string= (name (get-class method))
' 110 "KGlobalSettings")))
2009-06-11 tobias 111 (multiple-value-bind (def export) (constant-definition package method smoke)
2009-04-05 tobias 112 (push def
15:36:29 ' 113 constants)
' 114 (push export exports)))
' 115 (when (and (not (destructor-p method))
' 116 (not (constructor-p method))
' 117 (not (enum-p method))
' 118 (not (eql nil (name method)))
2009-07-01 tobias 119 (string/= (name method) "tr")) ;; we have a custom qt:tr function
2009-05-11 tobias 120 (let ((name (name method)))
17:55:42 ' 121 (when (and (starts-with-subseq "set" name)
' 122 (> (length name) 3)
' 123 (upper-case-p (char name 3))
' 124 (= 1 (get-arguments-length method)))
' 125 (unless (nth-value 1 (gethash (lispify name :cxx) setf-function-symbols))
' 126 (setf (gethash (lispify name :cxx) setf-function-symbols) t)
' 127 (push (setf-method-definition method) functions)))
2010-04-03 tobias 128 (setf (gethash (lispify name "CXX") generics)
12:03:07 ' 129 name))
2009-04-05 tobias 130 (when (static-p method)
2009-06-11 tobias 131 (let* ((function-symbol (static-method-symbol package method))
2009-05-11 tobias 132 (methods (gethash function-symbol function-symbols)))
2010-01-10 tobias 133 (setf (gethash function-symbol function-symbols)
08:49:36 ' 134 (if methods (- (id method)) (id method)))))))
2009-04-05 tobias 135 (eval smoke))
2009-05-11 tobias 136 (loop for id being the hash-values of function-symbols do
2009-06-22 tobias 137 (let ((method (make-smoke-method
12:18:08 ' 138 :smoke (eval smoke)
' 139 :id (abs id))))
2009-05-11 tobias 140 (multiple-value-bind (definition export)
20:18:23 ' 141 (static-method-definition
2009-06-11 tobias 142 package
2009-05-11 tobias 143 method
20:18:23 ' 144 (if (< 0 id)
' 145 (get-arguments-length method)
' 146 -1))
' 147 (push definition functions)
' 148 (push export exports))))
2009-04-05 tobias 149 `(progn (check-recompile ,smoke)
15:36:29 ' 150 ,@functions
2009-07-08 tobias 151 (eval-startup (:load-toplevel :execute)
20:41:19 ' 152 ;; eval on startup for class map.
' 153 (make-smoke-classes ,package ,smoke))
' 154 (eval-when (:load-toplevel :execute)
2009-05-19 tobias 155 (ensure-generic-methods ',(hash-table-alist generics)))
2009-04-05 tobias 156 ,@constants
2009-05-19 tobias 157 (eval-when (:load-toplevel :execute)
2009-06-11 tobias 158 (export (quote ,exports) ,package)))))
2009-04-05 tobias 159
Crece desde el pueblo el futuro / crece desde el pie