repos
/
smoke
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Support the new smokegenerator (r1015073).
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 (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 (enum-p method)
2009-06-11 tobias
107
(multiple-value-bind (def export) (constant-definition package method smoke)
2009-04-05 tobias
108
(push def
15:36:29 '
109
constants)
'
110
(push export exports)))
'
111
(when (and (not (destructor-p method))
'
112
(not (constructor-p method))
'
113
(not (enum-p method))
'
114
(not (eql nil (name method)))
2009-07-01 tobias
115
(string/= (name method) "tr")) ;; we have a custom qt:tr function
2009-05-11 tobias
116
(let ((name (name method)))
17:55:42 '
117
(when (and (starts-with-subseq "set" name)
'
118
(> (length name) 3)
'
119
(upper-case-p (char name 3))
'
120
(= 1 (get-arguments-length method)))
'
121
(unless (nth-value 1 (gethash (lispify name :cxx) setf-function-symbols))
'
122
(setf (gethash (lispify name :cxx) setf-function-symbols) t)
'
123
(push (setf-method-definition method) functions)))
2010-04-03 tobias
124
(setf (gethash (lispify name "CXX") generics)
12:03:07 '
125
name))
2009-04-05 tobias
126
(when (static-p method)
2009-06-11 tobias
127
(let* ((function-symbol (static-method-symbol package method))
2009-05-11 tobias
128
(methods (gethash function-symbol function-symbols)))
2010-01-10 tobias
129
(setf (gethash function-symbol function-symbols)
08:49:36 '
130
(if methods (- (id method)) (id method)))))))
2009-04-05 tobias
131
(eval smoke))
2009-05-11 tobias
132
(loop for id being the hash-values of function-symbols do
2009-06-22 tobias
133
(let ((method (make-smoke-method
12:18:08 '
134
:smoke (eval smoke)
'
135
:id (abs id))))
2009-05-11 tobias
136
(multiple-value-bind (definition export)
20:18:23 '
137
(static-method-definition
2009-06-11 tobias
138
package
2009-05-11 tobias
139
method
20:18:23 '
140
(if (< 0 id)
'
141
(get-arguments-length method)
'
142
-1))
'
143
(push definition functions)
'
144
(push export exports))))
2009-04-05 tobias
145
`(progn (check-recompile ,smoke)
15:36:29 '
146
,@functions
2010-01-10 tobias
147
(eval-startup (:load-toplevel :execute)
08:49:36 '
148
;; eval on startup for class map.
'
149
(make-smoke-classes ,package ,smoke))
2009-07-08 tobias
150
(eval-when (:load-toplevel :execute)
2009-05-19 tobias
151
(ensure-generic-methods ',(hash-table-alist generics)))
2009-04-05 tobias
152
,@constants
2009-05-19 tobias
153
(eval-when (:load-toplevel :execute)
2009-06-11 tobias
154
(export (quote ,exports) ,package)))))
2009-04-05 tobias
155