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