« back to all changes in this revision
Viewing changes to Source/Modules/allegrocl.cxx
- browse files at revision 10
- compare with another revision
- download diff
- download tarball
- view history from revision 10
- Committer: Bazaar Package Importer
- Author(s): Michael Vogt
- Date: 2006-12-20 14:43:24 UTC
- mfrom: (1.2.5 upstream)
- Revision ID: james.westby@ubuntu.com-20061220144324-bps3kb06xp5oy9w1
Tags: 1.3.31-1ubuntu1
* Merge from debian unstable, remaining changes:
- drop support for pike
- use php5 instead of php4
- clean Runtime/ as well
- force a few environment variables
- drop support for pike
- use php5 instead of php4
- clean Runtime/ as well
- force a few environment variables
- files added:
- .project
- Examples/csharp/callback
- Examples/csharp/extend
- Examples/lua/funcptr3
- Examples/lua/functor
- Examples/r
- Examples/r/class
- Examples/r/simple
- Examples/test-suite/r
- Lib/r
- files removed:
- Examples/test-suite/chicken/integers_runme.ss
- files modified:
- ANNOUNCE
added
removed
Source/Modules/allegrocl.cxx
7
7
* ALLEGROCL language module for SWIG.
8
8
* ----------------------------------------------------------------------------- */
9
9
10
char cvsroot_allegrocl_cxx[] = "$Header: /cvsroot/swig/SWIG/Source/Modules/allegrocl.cxx,v 1.30 2006/03/21 07:15:38 mutandiz Exp $";
10
char cvsroot_allegrocl_cxx[] = "$Header: /cvsroot/swig/SWIG/Source/Modules/allegrocl.cxx,v 1.37 2006/11/07 19:34:18 mutandiz Exp $";
11
11
12
12
#include "swigmod.h"
13
13
#include "cparse.h"
18
18
// #define ALLEGROCL_TYPE_DEBUG
19
19
// #define ALLEGROCL_CLASS_DEBUG
20
20
21
static File *f_cl=0;
21
static File *f_cl = 0;
22
22
String *f_clhead = NewString("");
23
23
String *f_clwrap = NewString("(swig-in-package ())\n\n");
24
24
static File *f_cxx;
25
static File *f_cxx_header=0;
26
static File *f_cxx_wrapper=0;
27
28
static String *module_name=0;
29
const char *identifier_converter="identifier-convert-null";
30
31
static bool CWrap = true; // generate wrapper file for C code by default. most correct.
25
static File *f_cxx_header = 0;
26
static File *f_cxx_wrapper = 0;
27
28
static String *module_name = 0;
29
static String *swig_package = 0;
30
31
const char *identifier_converter = "identifier-convert-null";
32
33
static bool CWrap = true; // generate wrapper file for C code by default. most correct.
32
34
static bool Generate_Wrapper = false;
35
static bool unique_swig_package = false;
33
36
34
static String *current_namespace=NewString("");
35
static String *current_package=NewString("");
36
static Hash *defined_namespace_packages=NewHash();
37
static String *current_namespace = NewString("");
38
static String *current_package = NewString("");
39
static Hash *defined_namespace_packages = NewHash();
37
40
static Node *in_class = 0;
38
41
39
static Node *first_linked_type=0;
40
static Hash *defined_foreign_types=NewHash();
41
static Hash *defined_foreign_ltypes=NewHash();
42
static Node *first_linked_type = 0;
43
static Hash *defined_foreign_types = NewHash();
44
static Hash *defined_foreign_ltypes = NewHash();
42
45
43
static String *anon_type_name=NewString("anontype");
44
static int anon_type_count=0;
46
static String *anon_type_name = NewString("anontype");
47
static int anon_type_count = 0;
45
48
46
49
// stub
47
String * convert_literal(String *num_param, String *type, bool try_to_split = true);
50
String *convert_literal(String *num_param, String *type, bool try_to_split = true);
48
51
49
class ALLEGROCL : public Language {
52
class ALLEGROCL:public Language {
50
53
public:
51
54
virtual void main(int argc, char *argv[]);
52
55
virtual int top(Node *n);
53
virtual int functionWrapper(Node *n);
56
virtual int functionWrapper(Node *n);
54
57
virtual int namespaceDeclaration(Node *n);
55
58
virtual int constructorHandler(Node *n);
56
59
virtual int destructorHandler(Node *n);
68
71
virtual int templateDeclaration(Node *n);
69
72
virtual int validIdentifier(String *s);
70
73
private:
71
int emit_defun(Node *n, File* f_cl);
74
int emit_defun(Node *n, File *f_cl);
72
75
int emit_dispatch_defun(Node *n);
73
76
int emit_buffered_defuns(Node *n);
74
77
int cClassHandler(Node *n);
75
78
int cppClassHandler(Node *n);
76
79
};
77
static ALLEGROCL* allegrocl = 0;
80
static ALLEGROCL *allegrocl = 0;
78
81
79
82
static String *trim(String *str) {
80
83
char *c = Char(str);
81
while (*c != '\0' && isspace((int)*c))
84
while (*c != '\0' && isspace((int) *c))
82
85
++c;
83
86
String *result = NewString(c);
84
87
Chop(result);
87
90
88
91
int is_integer(String *s) {
89
92
char *c = Char(s);
90
if(c[0] == '#' && (c[1] == 'x' || c[1] == 'o')) c+= 2;
93
if (c[0] == '#' && (c[1] == 'x' || c[1] == 'o'))
94
c += 2;
91
95
92
while(*c) {
93
if(!isdigit(*c)) return 0;
96
while (*c) {
97
if (!isdigit(*c))
98
return 0;
94
99
c++;
95
100
}
96
101
return 1;
98
103
99
104
String *class_from_class_or_class_ref(String *type) {
100
105
SwigType *stripped = SwigType_strip_qualifiers(type);
101
if(SwigType_isclass(stripped)) return stripped;
106
if (SwigType_isclass(stripped))
107
return stripped;
102
108
103
if(SwigType_ispointer(stripped) || SwigType_isreference(stripped)) {
109
if (SwigType_ispointer(stripped) || SwigType_isreference(stripped)) {
104
110
// Printf(stderr,"It is a pointer/reference. Is it a class?\n");
105
111
SwigType_pop(stripped);
106
if(SwigType_isclass(stripped)) {
112
if (SwigType_isclass(stripped)) {
107
113
return stripped;
108
114
}
109
115
}
113
119
String *lookup_defined_foreign_type(String *k) {
114
120
115
121
#ifdef ALLEGROCL_TYPE_DEBUG
116
Printf(stderr, "Looking up defined type '%s'.\n Found: '%s'\n",
117
k, Getattr(defined_foreign_types, k));
122
Printf(stderr, "Looking up defined type '%s'.\n Found: '%s'\n", k, Getattr(defined_foreign_types, k));
118
123
#endif
119
124
120
125
return Getattr(defined_foreign_types, k);
121
126
}
122
127
123
String *listify_namespace(String *namespaze)
124
{
128
String *listify_namespace(String *namespaze) {
125
129
if (Len(namespaze) == 0)
126
130
return NewString("()");
127
131
String *result = NewStringf("(\"%s\")", namespaze);
131
135
132
136
String *namespaced_name(Node *n, String *ns = current_namespace) {
133
137
134
return NewStringf("%s%s%s",
135
ns, (Len(ns) != 0) ? "::" : "",
136
Getattr(n,"sym:name"));
138
return NewStringf("%s%s%s", ns, (Len(ns) != 0) ? "::" : "", Getattr(n, "sym:name"));
137
139
}
138
140
139
141
// "Namespace::Nested::Class2::Baz" -> "Baz"
140
static String *strip_namespaces(String *str)
141
{
142
static String *strip_namespaces(String *str) {
142
143
char *result = Char(str);
143
144
String *stripped_one;
144
145
while ((stripped_one = Strstr(result, "::")))
145
result = Char(stripped_one)+2;
146
result = Char(stripped_one) + 2;
146
147
return NewString(result);
147
148
}
148
149
153
154
String *stripped_one;
154
155
155
156
while ((stripped_one = Strstr(p, "::"))) {
156
p = Char(stripped_one)+2;
157
p = Char(stripped_one) + 2;
157
158
}
158
if(p > start) {
159
if (p > start) {
159
160
int len = p - start - 1;
160
result = (char *)malloc(len);
161
strncpy(result, start, len-1);
162
result[len-1] = 0;
161
result = (char *) malloc(len);
162
strncpy(result, start, len - 1);
163
result[len - 1] = 0;
163
164
}
164
165
return Char(result);
165
166
}
166
167
167
168
void add_linked_type(Node *n) {
168
169
#ifdef ALLEGROCL_CLASS_DEBUG
169
Printf(stderr,"Adding linked node of type: %s(%s) %s(%x)\n\n", nodeType(n),
170
Getattr(n,"storage"), Getattr(n,"name"),n);
170
Printf(stderr, "Adding linked node of type: %s(%s) %s(%x)\n\n", nodeType(n), Getattr(n, "storage"), Getattr(n, "name"), n);
171
171
#endif
172
if(!first_linked_type) {
172
if (!first_linked_type) {
173
173
first_linked_type = n;
174
Setattr(n,"allegrocl:last_linked_type",n);
174
Setattr(n, "allegrocl:last_linked_type", n);
175
175
} else {
176
Node *t = Getattr(first_linked_type,"allegrocl:last_linked_type");
177
Setattr(t,"allegrocl:next_linked_type",n);
178
Setattr(first_linked_type,"allegrocl:last_linked_type",n);
176
Node *t = Getattr(first_linked_type, "allegrocl:last_linked_type");
177
Setattr(t, "allegrocl:next_linked_type", n);
178
Setattr(first_linked_type, "allegrocl:last_linked_type", n);
179
179
}
180
180
}
181
181
182
182
void replace_linked_type(Node *old, Node *new_node) {
183
Node *prev = Getattr(old,"allegrocl:prev_linked_type");
184
185
Setattr(new_node,"allegrocl:next_linked_type",
186
Getattr(old,"allegrocl:next_linked_type"));
187
if(prev) Setattr(prev,"allegrocl:next_linked_type",new_node);
188
Delattr(old,"allegrocl:next_linked_type");
189
Delattr(old,"allegrocl:prev_linked_type");
183
Node *prev = Getattr(old, "allegrocl:prev_linked_type");
184
185
Setattr(new_node, "allegrocl:next_linked_type", Getattr(old, "allegrocl:next_linked_type"));
186
if (prev)
187
Setattr(prev, "allegrocl:next_linked_type", new_node);
188
Delattr(old, "allegrocl:next_linked_type");
189
Delattr(old, "allegrocl:prev_linked_type");
190
190
191
191
// check if we're replacing the first link.
192
if(first_linked_type == old) {
192
if (first_linked_type == old) {
193
193
first_linked_type = new_node;
194
Setattr(first_linked_type,"allegrocl:last_linked_type",
195
Getattr(old,"allegrocl:last_linked_type"));
194
Setattr(first_linked_type, "allegrocl:last_linked_type", Getattr(old, "allegrocl:last_linked_type"));
196
195
}
197
198
196
// check if we're replacing the last link.
199
if(Getattr(first_linked_type,"allegrocl:last_linked_type") == old)
200
Setattr(first_linked_type,"allegrocl:last_linked_type",new_node);
197
if (Getattr(first_linked_type, "allegrocl:last_linked_type") == old)
198
Setattr(first_linked_type, "allegrocl:last_linked_type", new_node);
201
199
}
202
200
203
201
void insert_linked_type_at(Node *old, Node *new_node, int before = 1) {
204
202
Node *p = 0;
205
203
206
if(!first_linked_type) {
204
if (!first_linked_type) {
207
205
add_linked_type(new_node);
208
206
return;
209
207
}
210
208
211
if(!before) {
212
Setattr(new_node,"allegrocl:next_linked_type",
213
Getattr(old,"allegrocl:next_linked_type"));
214
Setattr(old,"allegrocl:next_linked_type",new_node);
215
if(Getattr(first_linked_type,"allegrocl:last_linked_type") == old)
216
Setattr(first_linked_type,"allegrocl:last_linked_type",new_node);
209
if (!before) {
210
Setattr(new_node, "allegrocl:next_linked_type", Getattr(old, "allegrocl:next_linked_type"));
211
Setattr(old, "allegrocl:next_linked_type", new_node);
212
if (Getattr(first_linked_type, "allegrocl:last_linked_type") == old)
213
Setattr(first_linked_type, "allegrocl:last_linked_type", new_node);
217
214
} else {
218
215
Node *c = first_linked_type;
219
while(c) {
220
if(c == old) {
216
while (c) {
217
if (c == old) {
221
218
break;
222
219
} else {
223
220
p = c;
224
c = Getattr(c,"allegrocl:next_linked_type");
221
c = Getattr(c, "allegrocl:next_linked_type");
225
222
}
226
223
}
227
if(c == old) {
228
Setattr(new_node,"allegrocl:next_linked_type",c);
229
if(first_linked_type == c) {
224
if (c == old) {
225
Setattr(new_node, "allegrocl:next_linked_type", c);
226
if (first_linked_type == c) {
230
227
first_linked_type = new_node;
231
Setattr(first_linked_type,"allegrocl:last_linked_type",
232
Getattr(c,"allegrocl:last_linked_type"));
233
Delattr(c,"allegrocl:last_linked_type");
228
Setattr(first_linked_type, "allegrocl:last_linked_type", Getattr(c, "allegrocl:last_linked_type"));
229
Delattr(c, "allegrocl:last_linked_type");
234
230
}
235
if(p) Setattr(p,"allegrocl:next_linked_type",new_node);
231
if (p)
232
Setattr(p, "allegrocl:next_linked_type", new_node);
236
233
}
237
234
}
238
235
}
242
239
Node *c = first_linked_type;
243
240
244
241
// Printf(stderr,"in find_linked_type_by_name '%s'...", name);
245
while(c) {
246
String *key = Getattr(c,"name");
247
if(!Strcmp(key,name)) {
242
while (c) {
243
String *key = Getattr(c, "name");
244
if (!Strcmp(key, name)) {
248
245
break;
249
246
} else {
250
247
p = c;
251
c = Getattr(c,"allegrocl:next_linked_type");
248
c = Getattr(c, "allegrocl:next_linked_type");
252
249
}
253
250
}
254
251
// Printf(stderr,"exit find_linked_type_by_name.\n");
255
252
256
if(p && c) Setattr(c,"allegrocl:prev_linked_type",p);
253
if (p && c)
254
Setattr(c, "allegrocl:prev_linked_type", p);
257
255
// Printf(stderr,"find_linked_type_by_name: DONE\n");
258
256
return c;
259
257
}
260
258
261
259
Node *get_primary_synonym_of(Node *n) {
262
Node *p = Getattr(n,"allegrocl:synonym-of");
260
Node *p = Getattr(n, "allegrocl:synonym-of");
263
261
Node *prim = n;
264
262
265
263
// Printf(stderr, "getting primary synonym of %x\n", n);
266
while(p) {
264
while (p) {
267
265
// Printf(stderr, " found one! %x\n", p);
268
266
prim = p;
269
p = Getattr(p,"allegrocl:synonym-of");
267
p = Getattr(p, "allegrocl:synonym-of");
270
268
}
271
269
// Printf(stderr,"get_primary_syn: DONE. returning %s(%x)\n", Getattr(prim,"name"),prim);
272
270
return prim;
273
271
}
274
272
275
void add_forward_referenced_type(Node *n, int overwrite = 0)
276
{
277
String *k = Getattr(n,"name");
273
void add_forward_referenced_type(Node *n, int overwrite = 0) {
274
String *k = Getattr(n, "name");
278
275
String *name = Getattr(n, "sym:name");
279
276
String *ns = listify_namespace(current_namespace);
280
277
281
278
String *val = Getattr(defined_foreign_types, k);
282
279
283
if(!val || overwrite) {
280
if (!val || overwrite) {
284
281
#ifdef ALLEGROCL_TYPE_DEBUG
285
Printf(stderr,"Adding forward reference for %s (overwrite=%d)\n",
286
k, overwrite);
287
#endif
288
Setattr(defined_foreign_types,Copy(k),NewString("forward-reference"));
289
290
String *mangled_lname_gen =
291
NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", name, ns);
292
293
Setattr(defined_foreign_ltypes,Copy(k),mangled_lname_gen);
282
Printf(stderr, "Adding forward reference for %s (overwrite=%d)\n", k, overwrite);
283
#endif
284
Setattr(defined_foreign_types, Copy(k), NewString("forward-reference"));
285
286
String *mangled_lname_gen = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", name, ns);
287
288
Setattr(defined_foreign_ltypes, Copy(k), mangled_lname_gen);
294
289
// Printf(f_cl, ";; forward reference stub\n"
295
290
// "(swig-def-foreign-class \"%s\" (ff:foreign-pointer) (:class ))\n\n"
296
// , name);
291
// , name);
297
292
298
293
#ifdef ALLEGROCL_CLASS_DEBUG
299
294
Printf(stderr, "Linking forward reference type = %s(%x)\n", k, n);
302
297
}
303
298
}
304
299
305
void add_defined_foreign_type(Node *n,
306
int overwrite=0,
307
String *k=0,
308
String *name=0,
309
String *ns=current_namespace) {
300
void add_defined_foreign_type(Node *n, int overwrite = 0, String *k = 0, String *name = 0, String *ns = current_namespace) {
310
301
311
302
String *val;
312
303
String *ns_list = listify_namespace(ns);
313
String *templated = n ? Getattr(n,"template") : 0;
314
String *cDeclName = n ? Getattr(n,"classDeclaration:name") : 0;
304
String *templated = n ? Getattr(n, "template") : 0;
305
String *cDeclName = n ? Getattr(n, "classDeclaration:name") : 0;
315
306
316
#ifdef ALLEGROCL_TYPE_DEBUG
317
Printf(stderr,"IN A-D-F-T. (n=%x, ow=%d, k=%s, name=%s, ns=%s\n",
318
n, overwrite, k, name, ns);
319
Printf(stderr," templated = '%x', classDecl = '%x'\n", templated, cDeclName);
307
#ifdef ALLEGROCL_CLASS_DEBUG
308
Printf(stderr, "IN A-D-F-T. (n=%x, ow=%d, k=%s, name=%s, ns=%s\n", n, overwrite, k, name, ns);
309
Printf(stderr, " templated = '%x', classDecl = '%x'\n", templated, cDeclName);
320
310
#endif
321
if(n) {
322
name=Getattr(n,"sym:name");
323
if(!name) name = Getattr(n,"name");
324
if(templated) {
311
if (n) {
312
if (!name)
313
name = Getattr(n, "sym:name");
314
if (!name)
315
name = Getattr(n, "name");
316
if (templated) {
325
317
k = namespaced_name(n);
326
318
} else {
327
String *kind_of_type = Getattr(n,"kind");
319
String *kind_of_type = Getattr(n, "kind");
328
320
329
321
/*
330
For typedefs of the form:
331
332
typedef __xxx { ... } xxx;
333
334
add_defined_foreign_type will be called once via classHandler
335
to define the type for 'struct __xxx', and once via typedefHandler
336
to associate xxx with 'struct __xxx'.
337
338
We create the following type to identifier mappings:
339
340
struct __xxx -> (swig-insert-id "xxx") via classHand
341
xxx -> (swig-insert-id "xxx") via typedefHand
342
343
and all references to this typedef'd struct will appear in
344
generated code as 'xxx'. For non-typedef'd structs, the
345
classHand mapping will be
346
347
struct __xxx -> (swig-insert-id "__xxx")
348
*/
322
For typedefs of the form:
323
324
typedef __xxx { ... } xxx;
325
326
add_defined_foreign_type will be called once via classHandler
327
to define the type for 'struct __xxx', and once via typedefHandler
328
to associate xxx with 'struct __xxx'.
329
330
We create the following type to identifier mappings:
331
332
struct __xxx -> (swig-insert-id "xxx") via classHand
333
xxx -> (swig-insert-id "xxx") via typedefHand
334
335
and all references to this typedef'd struct will appear in
336
generated code as 'xxx'. For non-typedef'd structs, the
337
classHand mapping will be
338
339
struct __xxx -> (swig-insert-id "__xxx")
340
*/
349
341
// Swig_print_node(n);
350
String *unnamed = Getattr(n,"unnamed");
351
if(kind_of_type && (!Strcmp(kind_of_type,"struct")
352
|| !Strcmp(kind_of_type,"union")) && cDeclName
353
&& !unnamed) {
342
String *unnamed = Getattr(n, "unnamed");
343
if (kind_of_type && (!Strcmp(kind_of_type, "struct")
344
|| !Strcmp(kind_of_type, "union")) && cDeclName && !unnamed) {
354
345
k = NewStringf("%s %s", kind_of_type, cDeclName);
355
346
} else {
356
if (!Strcmp(nodeType(n),"enum") && unnamed) {
347
if (!Strcmp(nodeType(n), "enum") && unnamed) {
357
348
name = NewStringf("%s%d", anon_type_name, anon_type_count++);
358
349
k = NewStringf("enum %s", name);
359
Setattr(n,"allegrocl:name",name);
350
Setattr(n, "allegrocl:name", name);
360
351
361
352
} else {
362
k = k ? k : Getattr(n,"name");
353
k = k ? k : Getattr(n, "name");
363
354
}
364
355
}
365
356
}
366
357
// Swig_print_node(n);
367
358
}
368
359
369
if(SwigType_istemplate(name)) {
360
if (SwigType_istemplate(name)) {
370
361
String *temp = strip_namespaces(SwigType_templateprefix(name));
371
362
name = NewStringf("%s%s%s", temp, SwigType_templateargs(name), SwigType_templatesuffix(name));
372
363
}
373
364
374
365
val = lookup_defined_foreign_type(k);
375
366
376
367
int is_fwd_ref = 0;
377
if(val) is_fwd_ref = !Strcmp(val,"forward-reference");
368
if (val)
369
is_fwd_ref = !Strcmp(val, "forward-reference");
378
370
379
if(!val || overwrite || is_fwd_ref) {
380
#ifdef ALLEGROCL_TYPE_DEBUG
381
Printf(stderr, "Adding defined type '%s' = '%s' '%s' (overwrite=%d)\n",
382
k, ns, name, overwrite);
371
if (!val || overwrite || is_fwd_ref) {
372
#ifdef ALLEGROCL_CLASS_DEBUG
373
Printf(stderr, "Adding defined type '%s' = '%s' '%s' (overwrite=%d, in-class=%d)\n", k, ns, name, overwrite, in_class);
383
374
#endif
384
String *mangled_name_gen =
385
NewStringf("#.(swig-insert-id \"%s\" %s)", name, ns_list);
386
String *mangled_lname_gen =
387
NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", name, ns_list);
388
389
Setattr(defined_foreign_types,Copy(k),Copy(mangled_name_gen));
390
Setattr(defined_foreign_ltypes,Copy(k),Copy(mangled_lname_gen));
391
392
if(CPlusPlus) {
375
String *mangled_name_gen = NewStringf("#.(swig-insert-id \"%s\" %s :type :type)", name, ns_list);
376
String *mangled_lname_gen = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", name, ns_list);
377
378
Setattr(defined_foreign_types, Copy(k), Copy(mangled_name_gen));
379
Setattr(defined_foreign_ltypes, Copy(k), Copy(mangled_lname_gen));
380
381
if (CPlusPlus) {
393
382
bool cpp_struct = Strstr(k, "struct ") ? true : false;
394
bool cpp_union = Strstr(k, "union ") ? true : false;
383
bool cpp_union = Strstr(k, "union ") ? true : false;
395
384
396
385
String *cpp_type = 0;
397
if(cpp_struct) {
386
if (cpp_struct) {
398
387
cpp_type = Copy(k);
399
388
Replaceall(cpp_type, "struct ", "");
400
389
} else if (cpp_union) {
402
391
Replaceall(cpp_type, "union ", "");
403
392
}
404
393
405
if(cpp_struct || cpp_union) {
406
#ifdef ALLEGROCL_TYPE_DEBUG
407
Printf(stderr, " Also adding defined type '%s' = '%s' '%s' (overwrite=%d)\n",
408
cpp_type, ns, name, overwrite);
394
if (cpp_struct || cpp_union) {
395
#ifdef ALLEGROCL_CLASS_DEBUG
396
Printf(stderr, " Also adding defined type '%s' = '%s' '%s' (overwrite=%d)\n", cpp_type, ns, name, overwrite);
409
397
#endif
410
Setattr(defined_foreign_types,Copy(cpp_type),Copy(mangled_name_gen));
411
Setattr(defined_foreign_ltypes,Copy(cpp_type),Copy(mangled_lname_gen));
398
Setattr(defined_foreign_types, Copy(cpp_type), Copy(mangled_name_gen));
399
Setattr(defined_foreign_ltypes, Copy(cpp_type), Copy(mangled_lname_gen));
412
400
}
413
401
}
414
#ifdef ALLEGROCL_TYPE_DEBUG
415
Printf(stderr,"looking to add %s/%s(%x) to linked_type_list...\n", k, name, n);
416
#endif
417
if(is_fwd_ref) {
418
// Printf(stderr,"*** 1\n");
419
add_linked_type(n);
420
} else {
421
// Printf(stderr,"*** 1-a\n");
422
if(SwigType_istemplate(k)) {
423
SwigType *resolved = SwigType_typedef_resolve_all(k);
424
// Printf(stderr,"*** 1-b\n");
425
Node *match = find_linked_type_by_name(resolved);
426
Node *new_node = 0;
427
// Printf(stderr, "*** temp-1\n");
428
if (n) {
429
new_node = n;
430
} else {
431
#ifdef ALLEGROCL_CLASS_DEBUG
432
Printf(stderr,"Creating a new templateInst:\n");
433
Printf(stderr," name = %s\n", resolved);
434
Printf(stderr," sym:name = %s\n", name);
435
Printf(stderr," real-name = %s\n", k);
436
Printf(stderr," type = %s\n", resolved);
437
Printf(stderr," ns = %s\n\n", ns);
438
#endif
439
new_node = NewHash();
440
Setattr(new_node,"nodeType","templateInst");
441
Setattr(new_node,"name",Copy(resolved));
442
Setattr(new_node,"sym:name",Copy(name));
443
Setattr(new_node,"real-name",Copy(k));
444
Setattr(new_node,"type",Copy(resolved));
445
Setattr(new_node,"allegrocl:namespace",ns);
446
Setattr(new_node,"allegrocl:package",ns);
447
}
402
#ifdef ALLEGROCL_CLASS_DEBUG
403
Printf(stderr, "looking to add %s/%s(%x) to linked_type_list...\n", k, name, n);
404
#endif
405
if (is_fwd_ref) {
406
// Printf(stderr,"*** 1\n");
407
add_linked_type(n);
408
} else {
409
// Printf(stderr,"*** 1-a\n");
410
if (SwigType_istemplate(k)) {
411
SwigType *resolved = SwigType_typedef_resolve_all(k);
412
// Printf(stderr,"*** 1-b\n");
413
Node *match = find_linked_type_by_name(resolved);
414
Node *new_node = 0;
415
// Printf(stderr, "*** temp-1\n");
416
if (n) {
417
new_node = n;
418
} else {
419
#ifdef ALLEGROCL_CLASS_DEBUG
420
Printf(stderr, "Creating a new templateInst:\n");
421
Printf(stderr, " name = %s\n", resolved);
422
Printf(stderr, " sym:name = %s\n", name);
423
Printf(stderr, " real-name = %s\n", k);
424
Printf(stderr, " type = %s\n", resolved);
425
Printf(stderr, " ns = %s\n\n", ns);
426
#endif
427
new_node = NewHash();
428
Setattr(new_node, "nodeType", "templateInst");
429
Setattr(new_node, "name", Copy(resolved));
430
Setattr(new_node, "sym:name", Copy(name));
431
Setattr(new_node, "real-name", Copy(k));
432
Setattr(new_node, "type", Copy(resolved));
433
Setattr(new_node, "allegrocl:namespace", ns);
434
Setattr(new_node, "allegrocl:package", ns);
435
}
448
436
449
if(!match) {
450
if(!Strcmp(nodeType(new_node),"templateInst") && in_class) {
451
/* this is an implicit template instantiation found while
452
walking a class. need to insert this into the
453
linked_type list before the current class definition */
454
#ifdef ALLEGROCL_CLASS_DEBUG
455
Printf(stderr,"trying to insert a templateInst before a class\n");
456
#endif
457
insert_linked_type_at(in_class,new_node);
458
#ifdef ALLEGROCL_CLASS_DEBUG
459
Printf(stderr,"DID IT!\n");
460
#endif
461
} else {
462
// Printf(stderr,"*** 3\n");
463
add_linked_type(new_node);
464
}
465
Setattr(new_node,"allegrocl:synonym:is-primary","1");
437
if (!match) {
438
if (!Strcmp(nodeType(new_node), "templateInst") && in_class) {
439
/* this is an implicit template instantiation found while
440
walking a class. need to insert this into the
441
linked_type list before the current class definition */
442
#ifdef ALLEGROCL_CLASS_DEBUG
443
Printf(stderr, "trying to insert a templateInst before a class\n");
444
#endif
445
insert_linked_type_at(in_class, new_node);
446
#ifdef ALLEGROCL_CLASS_DEBUG
447
Printf(stderr, "DID IT!\n");
448
#endif
466
449
} else {
467
// a synonym type was found (held in variable 'match')
468
// Printf(stderr, "setting primary synonym of %x to %x\n", new_node, match);
469
if(new_node == match) Printf(stderr,"Hey-4 * - '%s' is a synonym of iteself!\n", Getattr(new_node,"name"));
470
Setattr(new_node,"allegrocl:synonym-of",match);
471
// Printf(stderr,"*** 4\n");
450
// Printf(stderr,"*** 3\n");
472
451
add_linked_type(new_node);
473
452
}
453
Setattr(new_node, "allegrocl:synonym:is-primary", "1");
474
454
} else {
475
Node *match;
476
477
if(!Strcmp(nodeType(n),"cdecl") &&
478
!Strcmp(Getattr(n,"storage"),"typedef")) {
479
SwigType *type = SwigType_strip_qualifiers(Getattr(n,"type"));
480
#ifdef ALLEGROCL_TYPE_DEBUG
481
Printf(stderr,"Examining typedef '%s' for class references.\n", type);
482
// Printf(stderr, "type = %s, d-f-t=0x%x\n", type, Getattr(defined_foreign_types,type));
483
// bool a = Strstr(type,"struct ") && !Strcmp(Getattr(defined_foreign_types,type),Getattr(defined_foreign_types,k));
484
// bool b = !a;
485
// Printf(stderr,", and'd=%d, not-and'd=%d\n", a, b);
486
#endif
487
if(SwigType_isclass(type)) {
488
#ifdef ALLEGROCL_CLASS_DEBUG
489
Printf(stderr,"Found typedef of a class '%s'\n", type);
490
#endif
491
/*
492
For the following parsed expression:
493
494
typedef struct __xxx { ... } xxx;
495
496
if n is of kind "class" (defining the class 'struct __xxx'
497
then we add n to the linked type list.
498
499
if n is "cdecl" node of storage "typedef" (to note
500
that xxx is equivalent to 'struct __xxx' then we don't
501
want to add this node to the linked type list.
502
*/
503
String *defined_type = lookup_defined_foreign_type(type);
504
String *defined_key_type = lookup_defined_foreign_type(k);
505
506
if(Strstr(type,"struct ") && defined_type &&
507
!Strcmp(defined_type,defined_key_type)) {
508
// mark as a synonym but don't add to linked_type list
509
Setattr(n,"allegrocl:synonym","1");
455
// a synonym type was found (held in variable 'match')
456
// Printf(stderr, "setting primary synonym of %x to %x\n", new_node, match);
457
if (new_node == match)
458
Printf(stderr, "Hey-4 * - '%s' is a synonym of iteself!\n", Getattr(new_node, "name"));
459
Setattr(new_node, "allegrocl:synonym-of", match);
460
// Printf(stderr,"*** 4\n");
461
add_linked_type(new_node);
462
}
463
} else {
464
Node *match;
465
466
if (!Strcmp(nodeType(n), "cdecl") && !Strcmp(Getattr(n, "storage"), "typedef")) {
467
SwigType *type = SwigType_strip_qualifiers(Getattr(n, "type"));
468
#ifdef ALLEGROCL_CLASS_DEBUG
469
Printf(stderr, "Examining typedef '%s' for class references.\n", type);
470
#endif
471
if (SwigType_isclass(type)) {
472
#ifdef ALLEGROCL_CLASS_DEBUG
473
Printf(stderr, "Found typedef of a class '%s'\n", type);
474
#endif
475
/*
476
For the following parsed expression:
477
478
typedef struct __xxx { ... } xxx;
479
480
if n is of kind "class" (defining the class 'struct __xxx'
481
then we add n to the linked type list.
482
483
if n is "cdecl" node of storage "typedef" (to note
484
that xxx is equivalent to 'struct __xxx' then we don't
485
want to add this node to the linked type list.
486
*/
487
String *defined_type = lookup_defined_foreign_type(type);
488
String *defined_key_type = lookup_defined_foreign_type(k);
489
490
if ((Strstr(type, "struct ") || Strstr(type, "union "))
491
&& defined_type && !Strcmp(defined_type, defined_key_type)) {
492
// mark as a synonym but don't add to linked_type list
493
// Printf(stderr,"*** 4.8\n");
494
Setattr(n, "allegrocl:synonym", "1");
495
} else {
496
SwigType *lookup_type = SwigType_istemplate(type) ? SwigType_typedef_resolve_all(type) : Copy(type);
497
match = find_linked_type_by_name(lookup_type);
498
if (match) {
499
Setattr(n, "allegrocl:synonym", "1");
500
Setattr(n, "allegrocl:synonym-of", match);
501
Setattr(n, "real-name", Copy(lookup_type));
502
503
// Printf(stderr, "*** pre-5: found match of '%s'(%x)\n", Getattr(match,"name"),match);
504
// if(n == match) Printf(stderr, "Hey-5 *** setting synonym of %x to %x\n", n, match);
505
// Printf(stderr,"*** 5\n");
506
add_linked_type(n);
510
507
} else {
511
SwigType *lookup_type = SwigType_istemplate(type) ?
512
SwigType_typedef_resolve_all(type) : Copy(type);
513
match = find_linked_type_by_name(lookup_type);
514
if(match) {
515
Setattr(n,"allegrocl:synonym","1");
516
Setattr(n,"allegrocl:synonym-of",match);
517
// if(n == match) Printf(stderr, "Hey-5 * setting synonym of %x to %x\n", n, match);
518
// Printf(stderr,"*** 5\n");
519
add_linked_type(n);
520
} else {
521
508
#ifdef ALLEGROCL_CLASS_DEBUG
522
Printf(stderr,"Creating classfoward node for struct stub in typedef.\n");
509
Printf(stderr, "Creating classfoward node for struct stub in typedef.\n");
523
510
#endif
524
Node *new_node = NewHash();
525
String *symname = Copy(type);
526
Replaceall(symname,"struct ","");
527
Setattr(new_node,"nodeType","classforward");
528
Setattr(new_node,"name",Copy(type));
529
Setattr(new_node,"sym:name",symname);
530
Setattr(new_node,"allegrocl:namespace",ns);
531
Setattr(new_node,"allegrocl:package",ns);
532
533
String *mangled_new_name =
534
NewStringf("#.(swig-insert-id \"%s\" %s)", symname, ns_list);
535
String *mangled_new_lname =
536
NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", symname, ns_list);
537
Setattr(defined_foreign_types,Copy(symname),Copy(mangled_new_name));
538
Setattr(defined_foreign_ltypes,Copy(symname),Copy(mangled_new_lname));
539
540
// Printf(stderr,"Weird! Can't find the type!\n");
541
add_forward_referenced_type(new_node);
542
add_linked_type(new_node);
543
544
Setattr(n,"allegrocl:synonym","1");
545
Setattr(n,"allegrocl:synonym-of",new_node);
546
547
add_linked_type(n);
548
}
549
Delete(lookup_type);
550
}
551
} else {
552
// check if it's a pointer or reference to a class.
553
// Printf(stderr,"Checking if '%s' is a p. or r. to a class\n", type);
554
String *class_ref = class_from_class_or_class_ref(type);
555
if(class_ref) {
556
match = find_linked_type_by_name(class_ref);
557
Setattr(n,"allegrocl:synonym","1");
558
Setattr(n,"allegrocl:synonym-of",match);
511
Node *new_node = NewHash();
512
String *symname = Copy(type);
513
Replaceall(symname, "struct ", "");
514
Setattr(new_node, "nodeType", "classforward");
515
Setattr(new_node, "name", Copy(type));
516
Setattr(new_node, "sym:name", symname);
517
Setattr(new_node, "allegrocl:namespace", ns);
518
Setattr(new_node, "allegrocl:package", ns);
519
520
String *mangled_new_name = NewStringf("#.(swig-insert-id \"%s\" %s)", symname, ns_list);
521
String *mangled_new_lname = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", symname, ns_list);
522
Setattr(defined_foreign_types, Copy(symname), Copy(mangled_new_name));
523
Setattr(defined_foreign_ltypes, Copy(symname), Copy(mangled_new_lname));
524
525
// Printf(stderr,"Weird! Can't find the type!\n");
526
add_forward_referenced_type(new_node);
527
add_linked_type(new_node);
528
529
Setattr(n, "allegrocl:synonym", "1");
530
Setattr(n, "allegrocl:synonym-of", new_node);
531
559
532
add_linked_type(n);
560
533
}
561
}
562
Delete(type);
563
// synonym types have already been added.
564
// Printf(stderr,"*** 10\n");
565
if(!Getattr(n,"allegrocl:synonym")) add_linked_type(n);
566
} else if(Getattr(n,"template")) {
567
// Printf(stderr, "this is a class template node(%s)\n", nodeType(n));
568
String *resolved = SwigType_typedef_resolve_all(Getattr(n,"name"));
569
570
#ifdef ALLEGROCL_CLASS_DEBUG
571
Printf(stderr, " looking up %s for linked type match with %s...\n", Getattr(n,"sym:name"), resolved);
572
#endif
573
match = find_linked_type_by_name(resolved);
574
if (!match) {
575
#ifdef ALLEGROCL_CLASS_DEBUG
576
Printf(stderr, "found no implicit instantiation of %%template node %s(%x)\n", Getattr(n,"name"),n);
577
#endif
578
add_linked_type(n);
579
} else {
580
Node *primary = get_primary_synonym_of(match);
581
582
Setattr(n,"allegrocl:synonym:is-primary","1");
583
Delattr(primary,"allegrocl:synonym:is-primary");
584
if(n == match) Printf(stderr, "Hey-7 * setting synonym of %x to %x\n (match = %x)", primary, n, match);
585
Setattr(primary,"allegrocl:synonym-of",n);
586
// Printf(stderr,"*** 7\n");
587
add_linked_type(n);
588
}
589
} else {
590
#ifdef ALLEGROCL_CLASS_DEBUG
591
Printf(stderr, "linking type %s(%x)\n", k, n);
592
#endif
593
// Printf(stderr,"*** 8\n");
594
add_linked_type(n);
595
}
534
Delete(lookup_type);
535
}
536
} else {
537
// check if it's a pointer or reference to a class.
538
// Printf(stderr,"Checking if '%s' is a p. or r. to a class\n", type);
539
String *class_ref = class_from_class_or_class_ref(type);
540
if (class_ref) {
541
match = find_linked_type_by_name(class_ref);
542
Setattr(n, "allegrocl:synonym", "1");
543
Setattr(n, "allegrocl:synonym-of", match);
544
add_linked_type(n);
545
}
546
}
547
Delete(type);
548
// synonym types have already been added.
549
// Printf(stderr,"*** 10\n");
550
if (!Getattr(n, "allegrocl:synonym"))
551
add_linked_type(n);
552
} else if (Getattr(n, "template")) {
553
// Printf(stderr, "this is a class template node(%s)\n", nodeType(n));
554
String *resolved = SwigType_typedef_resolve_all(Getattr(n, "name"));
555
556
#ifdef ALLEGROCL_CLASS_DEBUG
557
Printf(stderr, " looking up %s for linked type match with %s...\n", Getattr(n, "sym:name"), resolved);
558
#endif
559
match = find_linked_type_by_name(resolved);
560
if (!match) {
561
#ifdef ALLEGROCL_CLASS_DEBUG
562
Printf(stderr, "found no implicit instantiation of %%template node %s(%x)\n", Getattr(n, "name"), n);
563
#endif
564
add_linked_type(n);
565
} else {
566
Node *primary = get_primary_synonym_of(match);
567
568
Setattr(n, "allegrocl:synonym:is-primary", "1");
569
Delattr(primary, "allegrocl:synonym:is-primary");
570
if (n == match)
571
Printf(stderr, "Hey-7 * setting synonym of %x to %x\n (match = %x)", primary, n, match);
572
Setattr(primary, "allegrocl:synonym-of", n);
573
// Printf(stderr,"*** 7\n");
574
add_linked_type(n);
575
}
576
} else {
577
#ifdef ALLEGROCL_CLASS_DEBUG
578
Printf(stderr, "linking type '%s'(%x)\n", k, n);
579
#endif
580
// Printf(stderr,"*** 8\n");
581
add_linked_type(n);
596
582
}
597
583
}
598
Delete(mangled_name_gen);
599
Delete(mangled_lname_gen);
584
}
585
Delete(mangled_name_gen);
586
Delete(mangled_lname_gen);
600
587
} else {
601
Swig_warning(WARN_TYPE_REDEFINED, Getfile(n), Getline(n),
602
"Attempting to store a foreign type that exists: %s\n", k);
588
Swig_warning(WARN_TYPE_REDEFINED, Getfile(n), Getline(n), "Attempting to store a foreign type that exists: %s (%s)\n", k, val);
603
589
}
604
590
605
591
Delete(ns_list);
606
592
607
#ifdef ALLEGROCL_TYPE_DEBUG
608
Printf(stderr,"OUT A-D-F-T\n");
593
#ifdef ALLEGROCL_CLASS_DEBUG
594
Printf(stderr, "OUT A-D-F-T\n");
609
595
#endif
610
596
}
611
597
613
599
// the namespace of the implicit instantiation is not necessarily
614
600
// current_namespace. Attempt to cull this from the type.
615
601
#ifdef ALLEGROCL_CLASS_DEBUG
616
Printf(stderr,"culling namespace of '%s' from '%s'\n", t, SwigType_templateprefix(t));
602
Printf(stderr, "culling namespace of '%s' from '%s'\n", t, SwigType_templateprefix(t));
617
603
#endif
618
604
String *implicit_ns = namespace_of(SwigType_templateprefix(t));
619
605
add_defined_foreign_type(0, 0, t, t, implicit_ns ? implicit_ns : current_namespace);
623
609
/* lookup defined foreign type.
624
610
if it exists, it will return a form suitable for placing
625
611
into lisp code to generate the def-foreign-type name */
626
612
627
613
#ifdef ALLEGROCL_TYPE_DEBUG
628
614
Printf(stderr, "inside g_f_t: looking up '%s' '%s'\n", ty, name);
629
615
#endif
634
620
#ifdef ALLEGROCL_TYPE_DEBUG
635
621
Printf(stderr, "found_type '%s'\n", found_type);
636
622
#endif
637
return (Strcmp(found_type,"forward-reference") ?
638
Copy(found_type) : NewString(":void"));
623
return (Strcmp(found_type, "forward-reference") ? Copy(found_type) : NewString(":void"));
639
624
} else {
640
625
Hash *typemap = Swig_typemap_search("ffitype", ty, name, 0);
641
626
643
628
String *typespec = Getattr(typemap, "code");
644
629
645
630
#ifdef ALLEGROCL_TYPE_DEBUG
646
Printf(stderr, "found typemap '%s'\n", typespec);
631
Printf(stderr, "found typemap '%s'\n", typespec);
647
632
#endif
648
633
return NewString(typespec);
649
}
634
}
650
635
651
if(SwigType_istemplate(ty)) {
636
if (SwigType_istemplate(ty)) {
652
637
note_implicit_template_instantiation(ty);
653
638
return Copy(lookup_defined_foreign_type(ty));
654
639
}
659
644
String *lookup_defined_foreign_ltype(String *l) {
660
645
661
646
#ifdef ALLEGROCL_TYPE_DEBUG
662
Printf(stderr, "Looking up defined ltype '%s'.\n Found: '%s'\n",
663
l, Getattr(defined_foreign_ltypes, l));
647
Printf(stderr, "Looking up defined ltype '%s'.\n Found: '%s'\n", l, Getattr(defined_foreign_ltypes, l));
664
648
#endif
665
649
return Getattr(defined_foreign_ltypes, l);
666
650
}
673
657
String *ffiType = NewString("");
674
658
675
659
// for a function type, need to walk the parm list.
676
while(Len(ty) != 0) {
660
while (Len(ty) != 0) {
677
661
tok = SwigType_pop(ty);
678
662
679
if(SwigType_isfunction(tok)) {
663
if (SwigType_isfunction(tok)) {
680
664
// Generate Function wrapper
681
665
Printf(ffiType, "(:function ");
682
666
// walk parm list
683
667
List *pl = SwigType_parmlist(tok);
684
668
685
Printf(ffiType, "("); // start parm list
686
for (Iterator i=First(pl); i.item; i = Next(i)) {
687
SwigType *f_arg = SwigType_strip_qualifiers(i.item);
688
Printf(ffiType, "%s ", internal_compose_foreign_type(f_arg));
689
Delete(f_arg);
669
Printf(ffiType, "("); // start parm list
670
for (Iterator i = First(pl); i.item; i = Next(i)) {
671
SwigType *f_arg = SwigType_strip_qualifiers(i.item);
672
Printf(ffiType, "%s ", internal_compose_foreign_type(f_arg));
673
Delete(f_arg);
690
674
}
691
Printf(ffiType, ")"); // end parm list.
675
Printf(ffiType, ")"); // end parm list.
692
676
693
677
// do function return type.
694
678
Printf(ffiType, " %s)", internal_compose_foreign_type(ty));
698
682
} else if (SwigType_isarray(tok)) {
699
683
Printf(ffiType, "(:array %s", internal_compose_foreign_type(ty));
700
684
String *atype = NewString("int");
701
String *dim = convert_literal(SwigType_array_getdim(tok, 0),atype);
685
String *dim = convert_literal(SwigType_array_getdim(tok, 0), atype);
702
686
Delete(atype);
703
if(is_integer(dim)) {
687
if (is_integer(dim)) {
704
688
Printf(ffiType, " %s)", dim);
705
} else {
706
Printf(ffiType, " #| %s |#)", SwigType_array_getdim(tok,0));
707
}
689
} else {
690
Printf(ffiType, " #| %s |#)", SwigType_array_getdim(tok, 0));
691
}
708
692
} else if (SwigType_ismemberpointer(tok)) {
709
693
// temp
710
694
Printf(ffiType, "(* %s)", internal_compose_foreign_type(ty));
711
695
} else {
712
696
String *res = get_ffi_type(tok, "");
713
697
if (res) {
714
Printf(ffiType, "%s", res);
698
Printf(ffiType, "%s", res);
715
699
} else {
716
SwigType *resolved_type = SwigType_typedef_resolve(tok);
717
if(resolved_type) {
700
SwigType *resolved_type = SwigType_typedef_resolve(tok);
701
if (resolved_type) {
718
702
res = get_ffi_type(resolved_type, "");
719
if(res) {
703
if (res) {
720
704
} else {
721
705
res = internal_compose_foreign_type(resolved_type);
722
706
}
723
if(res) Printf(ffiType, "%s", res);
707
if (res)
708
Printf(ffiType, "%s", res);
724
709
}
725
726
710
// while(resolved_type) {
727
// // the resolved_type may expand into something like p.NS1::NS2::SomeType
728
// // for which get_ffi_type will not find any match (due to the p.).
729
// // Printf(stderr, "\n in resolved type loop on '%s'\n", resolved_type);
711
// // the resolved_type may expand into something like p.NS1::NS2::SomeType
712
// // for which get_ffi_type will not find any match (due to the p.).
713
// // Printf(stderr, "\n in resolved type loop on '%s'\n", resolved_type);
730
714
// res = get_ffi_type(resolved_type, "");
731
715
// if (res) {
732
716
// Printf(ffiType, "%s", res);
733
717
// break;
734
718
// } else {
735
// resolved_type = SwigType_typedef_resolve(resolved_type);
719
// resolved_type = SwigType_typedef_resolve(resolved_type);
736
720
// }
737
721
// }
738
if(!res) {
739
if (Strstr(tok,"struct ")) {
740
Swig_warning(WARN_TYPE_UNDEFINED_CLASS,Getfile(tok), Getline(tok),
741
"Unable to find definition of '%s', assuming forward reference.\n", tok);
722
if (!res) {
723
if (Strstr(tok, "struct ")) {
724
Swig_warning(WARN_TYPE_UNDEFINED_CLASS, Getfile(tok), Getline(tok), "Unable to find definition of '%s', assuming forward reference.\n", tok);
742
725
} else {
743
Printf(stderr,"Unable to compose foreign type of: '%s'\n", tok);
726
Printf(stderr, "Unable to compose foreign type of: '%s'\n", tok);
744
727
}
745
Printf(ffiType, "(* :void)");
746
}
728
Printf(ffiType, "(* :void)");
729
}
747
730
}
748
731
}
749
732
}
753
736
String *compose_foreign_type(SwigType *ty) {
754
737
755
738
#ifdef ALLEGROCL_TYPE_DEBUG
756
Printf(stderr,"compose_foreign_type: ENTER (%s)...\n ", ty);
739
Printf(stderr, "compose_foreign_type: ENTER (%s)...\n ", ty);
757
740
#endif
758
741
/* should we allow named lookups in the typemap here? */
759
742
SwigType *temp = SwigType_strip_qualifiers(ty);
761
744
Delete(temp);
762
745
763
746
#ifdef ALLEGROCL_TYPE_DEBUG
764
Printf(stderr,"compose_foreign_type: EXIT (%s)\n ", res);
747
Printf(stderr, "compose_foreign_type: EXIT (%s)\n ", res);
765
748
#endif
766
749
767
750
return res;
771
754
#ifdef ALLEGROCL_DEBUG
772
755
Printf(stderr, "update_package: ENTER... \n");
773
756
Printf(stderr, " current_package = '%s'\n", current_package);
774
Printf(stderr, " node_package = '%s'\n", Getattr(n,"allegrocl:package"));
775
Printf(stderr, " node(%x) = '%s'\n", n, Getattr(n,"name"));
757
Printf(stderr, " node_package = '%s'\n", Getattr(n, "allegrocl:package"));
758
Printf(stderr, " node(%x) = '%s'\n", n, Getattr(n, "name"));
776
759
#endif
777
String *node_package = Getattr(n,"allegrocl:package");
778
if(Strcmp(current_package,node_package)) {
760
String *node_package = Getattr(n, "allegrocl:package");
761
if (Strcmp(current_package, node_package)) {
779
762
String *lispy_package = listify_namespace(node_package);
780
763
781
764
Delete(current_package);
782
765
current_package = Copy(node_package);
783
Printf(f,"\n(swig-in-package %s)\n", lispy_package);
766
Printf(f, "\n(swig-in-package %s)\n", lispy_package);
784
767
Delete(lispy_package);
785
768
}
786
769
#ifdef ALLEGROCL_DEBUG
787
Printf(stderr,"update_package: EXIT.\n");
770
Printf(stderr, "update_package: EXIT.\n");
788
771
#endif
789
772
}
790
773
791
static String *mangle_name(Node *n, char const *prefix = "ACL",
792
String *ns = current_namespace)
793
{
794
String* suffix = Getattr(n, "sym:overname");
795
String *pre_mangled_name =
796
NewStringf("%s_%s__%s%s", prefix, ns, Getattr(n, "sym:name"), suffix);
774
static String *mangle_name(Node *n, char const *prefix = "ACL", String *ns = current_namespace) {
775
String *suffix = Getattr(n, "sym:overname");
776
String *pre_mangled_name = NewStringf("%s_%s__%s%s", prefix, ns, Getattr(n, "sym:name"), suffix);
797
777
String *mangled_name = Swig_name_mangle(pre_mangled_name);
798
778
Delete(pre_mangled_name);
799
779
return mangled_name;
807
787
Replaceall(string, ")", "");
808
788
return string;
809
789
/*
810
char *s=Char(string), *p;
811
int len=Len(string);
812
String *res;
813
814
if (len==0 || s[0] != '(' || s[len-1] != ')') {
815
return NewString(string);
816
}
817
818
p=(char *)malloc(len-2+1);
819
if (!p) {
820
Printf(stderr, "Malloc failed\n");
821
SWIG_exit(EXIT_FAILURE);
822
}
823
824
strncpy(p, s+1, len-1);
825
p[len-2]=0; // null terminate
826
827
res=NewString(p);
828
free(p);
829
830
return res;
831
*/
790
char *s=Char(string), *p;
791
int len=Len(string);
792
String *res;
793
794
if (len==0 || s[0] != '(' || s[len-1] != ')') {
795
return NewString(string);
796
}
797
798
p=(char *)malloc(len-2+1);
799
if (!p) {
800
Printf(stderr, "Malloc failed\n");
801
SWIG_exit(EXIT_FAILURE);
802
}
803
804
strncpy(p, s+1, len-1);
805
p[len-2]=0; // null terminate
806
807
res=NewString(p);
808
free(p);
809
810
return res;
811
*/
832
812
}
833
813
834
int ALLEGROCL :: validIdentifier(String *s) {
814
int ALLEGROCL::validIdentifier(String *s) {
835
815
char *c = Char(s);
836
816
837
817
bool got_dot = false;
849
829
} else {
850
830
only_dots = false;
851
831
}
852
if (!isgraph(*c)) return 0;
832
if (!isgraph(*c))
833
return 0;
853
834
c++;
854
835
}
855
836
860
841
List *ored = Split(val, split_op, -1);
861
842
862
843
// some float hackery
863
if ( ((split_op == '+') || (split_op == '-')) && Len(ored) == 2 &&
864
(SwigType_type(type) == T_FLOAT || SwigType_type(type) == T_DOUBLE ||
865
SwigType_type(type) == T_LONGDOUBLE) ) {
844
if (((split_op == '+') || (split_op == '-')) && Len(ored) == 2 &&
845
(SwigType_type(type) == T_FLOAT || SwigType_type(type) == T_DOUBLE || SwigType_type(type) == T_LONGDOUBLE)) {
866
846
// check that we're not splitting a float
867
847
String *possible_result = convert_literal(val, type, false);
868
if (possible_result) return possible_result;
869
848
if (possible_result)
849
return possible_result;
850
870
851
}
871
872
852
// try parsing the split results. if any part fails, kick out.
873
853
bool part_failed = false;
874
854
if (Len(ored) > 1) {
875
855
String *result = NewStringf("(%s", op);
876
856
for (Iterator i = First(ored); i.item; i = Next(i)) {
877
857
String *converted = convert_literal(i.item, type);
878
if(converted) {
858
if (converted) {
879
859
Printf(result, " %s", converted);
880
860
Delete(converted);
881
861
} else {
886
866
Printf(result, ")");
887
867
Delete(ored);
888
868
return part_failed ? 0 : result;
889
}
890
else {
869
} else {
891
870
Delete(ored);
892
871
}
893
872
return 0;
899
878
900
879
try_to_split defaults to true (see stub above).
901
880
*/
902
String * convert_literal(String *literal, String *type, bool try_to_split) {
881
String *convert_literal(String *literal, String *type, bool try_to_split) {
903
882
String *num_param = Copy(literal);
904
883
String *trimmed = trim(num_param);
905
String *num=strip_parens(trimmed), *res=0;
906
char *s=Char(num);
884
String *num = strip_parens(trimmed), *res = 0;
885
char *s = Char(num);
907
886
908
887
String *ns = listify_namespace(current_namespace);
909
888
910
889
// very basic parsing of infix expressions.
911
if(try_to_split) {
912
if( (res = infix_to_prefix(num, '|', "logior", type)) ) return res;
913
if( (res = infix_to_prefix(num, '&', "logand", type)) ) return res;
914
if( (res = infix_to_prefix(num, '^', "logxor", type)) ) return res;
915
if( (res = infix_to_prefix(num, '*', "*", type)) ) return res;
916
if( (res = infix_to_prefix(num, '/', "/", type)) ) return res;
917
if( (res = infix_to_prefix(num, '+', "+", type)) ) return res;
918
if( (res = infix_to_prefix(num, '-', "-", type)) ) return res;
890
if (try_to_split) {
891
if ((res = infix_to_prefix(num, '|', "logior", type)))
892
return res;
893
if ((res = infix_to_prefix(num, '&', "logand", type)))
894
return res;
895
if ((res = infix_to_prefix(num, '^', "logxor", type)))
896
return res;
897
if ((res = infix_to_prefix(num, '*', "*", type)))
898
return res;
899
if ((res = infix_to_prefix(num, '/', "/", type)))
900
return res;
901
if ((res = infix_to_prefix(num, '+', "+", type)))
902
return res;
903
if ((res = infix_to_prefix(num, '-', "-", type)))
904
return res;
919
905
// if( (res = infix_to_prefix(num, '<<', "ash", type)) ) return res;
920
906
}
921
907
922
if (SwigType_type(type) == T_FLOAT ||
923
SwigType_type(type) == T_DOUBLE ||
924
SwigType_type(type) == T_LONGDOUBLE) {
908
if (SwigType_type(type) == T_FLOAT || SwigType_type(type) == T_DOUBLE || SwigType_type(type) == T_LONGDOUBLE) {
925
909
// Use CL syntax for float literals
926
910
String *oldnum = Copy(num);
927
911
928
912
// careful. may be a float identifier or float constant.
929
913
char *num_start = Char(num);
930
char *num_end = num_start + strlen(num_start) -1;
914
char *num_end = num_start + strlen(num_start) - 1;
931
915
932
916
bool is_literal = isdigit(*num_start) || (*num_start == '.');
933
917
934
918
String *lisp_exp = 0;
935
if(is_literal) {
919
if (is_literal) {
936
920
if (*num_end == 'f' || *num_end == 'F') {
937
921
lisp_exp = NewString("f");
938
922
} else {
944
928
num_end--;
945
929
}
946
930
947
int exponents = Replaceall(num, "e", lisp_exp) +
948
Replaceall(num, "E", lisp_exp);
931
int exponents = Replaceall(num, "e", lisp_exp) + Replaceall(num, "E", lisp_exp);
949
932
950
933
if (!exponents)
951
934
Printf(num, "%s0", lisp_exp);
952
935
953
if (exponents > 1 || (exponents + Replaceall(num,".",".") == 0)) {
936
if (exponents > 1 || (exponents + Replaceall(num, ".", ".") == 0)) {
954
937
// Printf(stderr, "Can't parse '%s' as type '%s'.\n", oldnum, type);
955
938
Delete(num);
956
939
num = 0;
962
945
num = id;
963
946
}
964
947
965
Delete(oldnum); Delete(trimmed); Delete(ns);
948
Delete(oldnum);
949
Delete(trimmed);
950
Delete(ns);
966
951
return num;
967
}
968
else if (SwigType_type(type) == T_CHAR) {
952
} else if (SwigType_type(type) == T_CHAR) {
969
953
/* Use CL syntax for character literals */
970
Delete(num); Delete(trimmed);
954
Delete(num);
955
Delete(trimmed);
971
956
return NewStringf("#\\%s", num_param);
972
}
973
else if (SwigType_type(type) == T_STRING) {
957
} else if (SwigType_type(type) == T_STRING) {
974
958
/* Use CL syntax for string literals */
975
Delete(num); Delete(trimmed);
959
Delete(num);
960
Delete(trimmed);
976
961
return NewStringf("\"%s\"", num_param);
977
}
978
else if (allegrocl->validIdentifier(num)) {
979
/* convert C/C++ identifiers to CL symbols */
980
res = NewStringf("#.(swig-insert-id \"%s\" %s :type :constant)", num, ns);
981
Delete(num); Delete(trimmed); Delete(ns);
982
return res;
983
}
984
else if (Len(num) >= 1 && isdigit(s[0])) {
962
} else if (Len(num) >= 1 && (isdigit(s[0]) || s[0] == '+' || s[0] == '-')) {
985
963
/* use CL syntax for numbers */
986
964
String *oldnum = Copy(num);
987
965
int usuffixes = Replaceall(num, "u", "") + Replaceall(num, "U", "");
993
971
s = Char(num);
994
972
if (s[0] == '0' && Len(num) >= 2) {
995
973
/*octal or hex */
996
res=NewStringf("#%c%s",
997
tolower(s[1]) == 'x' ? 'x' : 'o',
998
s+2);
974
res = NewStringf("#%c%s", tolower(s[1]) == 'x' ? 'x' : 'o', s + 2);
999
975
Delete(num);
1000
}
1001
else
1002
{
1003
res=num;
1004
}
1005
Delete(oldnum); Delete(trimmed);
976
} else {
977
res = num;
978
}
979
Delete(oldnum);
980
Delete(trimmed);
981
return res;
982
} else if (allegrocl->validIdentifier(num)) {
983
/* convert C/C++ identifiers to CL symbols */
984
res = NewStringf("#.(swig-insert-id \"%s\" %s :type :constant)", num, ns);
985
Delete(num);
986
Delete(trimmed);
987
Delete(ns);
1006
988
return res;
1007
989
} else {
1008
990
Delete(trimmed);
1014
996
void emit_stub_class(Node *n) {
1015
997
1016
998
#ifdef ALLEGROCL_WRAP_DEBUG
1017
Printf(stderr,"emit_stub_class: ENTER... '%s'(%x)\n", Getattr(n,"sym:name"),n);
999
Printf(stderr, "emit_stub_class: ENTER... '%s'(%x)\n", Getattr(n, "sym:name"), n);
1018
1000
#endif
1019
1001
1020
1002
1021
String *name = Getattr(n,"sym:name");
1022
1023
if(Getattr(n,"allegrocl:synonym:already-been-stubbed")) return;
1024
1025
if(SwigType_istemplate(name)) {
1003
String *name = Getattr(n, "sym:name");
1004
1005
if (Getattr(n, "allegrocl:synonym:already-been-stubbed"))
1006
return;
1007
1008
if (SwigType_istemplate(name)) {
1026
1009
String *temp = strip_namespaces(SwigType_templateprefix(name));
1027
name = NewStringf("%s%s%s", temp,
1028
SwigType_templateargs(name),
1029
SwigType_templatesuffix(name));
1010
name = NewStringf("%s%s%s", temp, SwigType_templateargs(name), SwigType_templatesuffix(name));
1030
1011
1031
1012
Delete(temp);
1032
1013
} else {
1034
1015
}
1035
1016
1036
1017
// Printf(f_clhead, ";; from emit-stub-class\n");
1037
update_package_if_needed(n,f_clhead);
1018
update_package_if_needed(n, f_clhead);
1038
1019
Printf(f_clhead, ";; class template stub.\n");
1039
Printf(f_clhead,"(swig-def-foreign-stub \"%s\")\n", name);
1020
Printf(f_clhead, "(swig-def-foreign-stub \"%s\")\n", name);
1040
1021
1041
Setattr(n,"allegrocl:synonym:already-been-stubbed","1");
1022
Setattr(n, "allegrocl:synonym:already-been-stubbed", "1");
1042
1023
1043
1024
#ifdef ALLEGROCL_WRAP_DEBUG
1044
Printf(stderr,"emit_stub_class: EXIT\n");
1025
Printf(stderr, "emit_stub_class: EXIT\n");
1045
1026
#endif
1046
1027
}
1047
1028
1048
1029
void emit_synonym(Node *synonym) {
1049
1030
1050
1031
#ifdef ALLEGROCL_WRAP_DEBUG
1051
Printf(stderr,"emit_synonym: ENTER... \n");
1032
Printf(stderr, "emit_synonym: ENTER... \n");
1052
1033
#endif
1053
1034
1054
1035
// Printf(stderr,"in emit_synonym for %s(%x)\n", Getattr(synonym,"name"),synonym);
1055
int is_tempInst = !Strcmp(nodeType(synonym),"templateInst");
1036
int is_tempInst = !Strcmp(nodeType(synonym), "templateInst");
1056
1037
String *synonym_type;
1057
1038
1058
1039
Node *of = get_primary_synonym_of(synonym);
1059
1060
if(is_tempInst) {
1061
synonym_type = Getattr(synonym,"real-name");
1040
1041
if (is_tempInst) {
1042
// Printf(stderr, "*** using real-name '%s'\n", Getattr(synonym,"real-name"));
1043
synonym_type = Getattr(synonym, "real-name");
1062
1044
} else {
1063
synonym_type = Getattr(synonym,"name");
1045
// Printf(stderr, "*** using name '%s'\n", Getattr(synonym,"name"));
1046
synonym_type = Getattr(synonym, "name");
1064
1047
}
1065
1048
1066
String *synonym_ns = listify_namespace(Getattr(synonym,"allegrocl:namespace"));
1049
String *synonym_ns = listify_namespace(Getattr(synonym, "allegrocl:namespace"));
1050
String *syn_ltype, *syn_type, *of_ltype;
1067
1051
// String *of_cdeclname = Getattr(of,"allegrocl:classDeclarationName");
1068
String *of_ns = Getattr(of,"allegrocl:namespace");
1052
String *of_ns = Getattr(of, "allegrocl:namespace");
1069
1053
String *of_ns_list = listify_namespace(of_ns);
1070
1054
// String *of_name = of_cdeclname ? NewStringf("struct %s", Getattr(of,"name")) : NewStringf("%s::%s", of_ns, Getattr(of,"sym:name"));
1071
1055
// String *of_name = NewStringf("%s::%s", of_ns, Getattr(of,"sym:name"));
1072
1056
String *of_name = namespaced_name(of, of_ns);
1073
String *syn_ltype = lookup_defined_foreign_ltype(synonym_type);
1074
String *syn_type = lookup_defined_foreign_type(synonym_type);
1075
String *of_ltype = lookup_defined_foreign_ltype(of_name);
1057
1058
if (CPlusPlus && !Strcmp(nodeType(synonym), "cdecl")) {
1059
syn_ltype = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", Getattr(synonym, "real-name"), synonym_ns);
1060
syn_type = NewStringf("#.(swig-insert-id \"%s\" %s :type :type)", Getattr(synonym, "real-name"), synonym_ns);
1061
} else {
1062
syn_ltype = lookup_defined_foreign_ltype(synonym_type);
1063
syn_type = lookup_defined_foreign_type(synonym_type);
1064
}
1065
1066
of_ltype = lookup_defined_foreign_ltype(of_name);
1076
1067
1077
1068
// Printf(f_clhead,";; from emit-synonym\n");
1078
Printf(f_clhead,"(swig-def-synonym-type %s\n %s\n %s)\n", syn_ltype, of_ltype, syn_type);
1069
Printf(f_clhead, "(swig-def-synonym-type %s\n %s\n %s)\n", syn_ltype, of_ltype, syn_type);
1079
1070
1080
1071
Delete(synonym_ns);
1081
1072
Delete(of_ns_list);
1082
1073
Delete(of_name);
1083
1074
1084
1075
#ifdef ALLEGROCL_WRAP_DEBUG
1085
Printf(stderr,"emit_synonym: EXIT\n");
1076
Printf(stderr, "emit_synonym: EXIT\n");
1086
1077
#endif
1087
1078
}
1088
1079
1089
1080
void emit_full_class(Node *n) {
1090
1081
1091
1082
#ifdef ALLEGROCL_WRAP_DEBUG
1092
Printf(stderr,"emit_full_class: ENTER... \n");
1083
Printf(stderr, "emit_full_class: ENTER... \n");
1093
1084
#endif
1094
1085
1095
String *name=Getattr(n, "sym:name");
1096
String *kind = Getattr(n,"kind");
1086
String *name = Getattr(n, "sym:name");
1087
String *kind = Getattr(n, "kind");
1097
1088
1098
1089
// Printf(stderr,"in emit_full_class: '%s'(%x).", Getattr(n,"name"),n);
1099
if(Getattr(n,"allegrocl:synonym-of")) {
1090
if (Getattr(n, "allegrocl:synonym-of")) {
1100
1091
// Printf(stderr,"but it's a synonym of something.\n");
1101
update_package_if_needed(n,f_clhead);
1092
update_package_if_needed(n, f_clhead);
1102
1093
emit_synonym(n);
1103
1094
return;
1104
1095
}
1105
1106
1096
// collect superclasses
1107
String *bases = Getattr(n,"bases");
1097
String *bases = Getattr(n, "bases");
1108
1098
String *supers = NewString("(");
1109
if(bases) {
1110
int first=1;
1111
for (Iterator i=First(bases); i.item; i = Next(i)) {
1112
if (!first) Printf(supers," ");
1113
String *s = lookup_defined_foreign_ltype(Getattr(i.item,"name"));
1099
if (bases) {
1100
int first = 1;
1101
for (Iterator i = First(bases); i.item; i = Next(i)) {
1102
if (!first)
1103
Printf(supers, " ");
1104
String *s = lookup_defined_foreign_ltype(Getattr(i.item, "name"));
1114
1105
// String *name = Getattr(i.item,"name");
1115
if(s) {
1116
Printf(supers,"%s",s);
1106
if (s) {
1107
Printf(supers, "%s", s);
1117
1108
} else {
1118
1109
#ifdef ALLEGROCL_TYPE_DEBUG
1119
Printf(stderr,"emit_templ_inst: did not find ltype for base class %s (%s)", Getattr(i.item,"name"), Getattr(n,"allegrocl:namespace"));
1110
Printf(stderr, "emit_templ_inst: did not find ltype for base class %s (%s)", Getattr(i.item, "name"), Getattr(n, "allegrocl:namespace"));
1120
1111
#endif
1121
1112
}
1122
1113
}
1123
1114
} else {
1124
Printf(supers,"ff:foreign-pointer");
1115
Printf(supers, "ff:foreign-pointer");
1125
1116
}
1126
1117
1127
Printf(supers,")");
1118
Printf(supers, ")");
1128
1119
1129
1120
// Walk children to generate type definition.
1130
1121
String *slotdefs = NewString(" ");
1134
1125
#endif
1135
1126
1136
1127
Node *c;
1137
for (c=firstChild(n); c; c=nextSibling(c)) {
1138
String *storage_type = Getattr(c,"storage");
1139
if((!Strcmp(nodeType(c),"cdecl") &&
1140
(!storage_type || Strcmp(storage_type,"typedef")))) {
1141
String *access = Getattr(c,"access");
1128
for (c = firstChild(n); c; c = nextSibling(c)) {
1129
String *storage_type = Getattr(c, "storage");
1130
if ((!Strcmp(nodeType(c), "cdecl") && (!storage_type || Strcmp(storage_type, "typedef")))) {
1131
String *access = Getattr(c, "access");
1142
1132
1143
1133
// hack. why would decl have a value of "variableHandler" and now "0"?
1144
String *childDecl = Getattr(c,"decl");
1134
String *childDecl = Getattr(c, "decl");
1145
1135
// Printf(stderr,"childDecl = '%s' (%s)\n", childDecl, Getattr(c,"view"));
1146
if(!Strcmp(childDecl,"0"))
1136
if (!Strcmp(childDecl, "0"))
1147
1137
childDecl = NewString("");
1148
1138
1149
SwigType *childType=NewStringf("%s%s", childDecl,
1150
Getattr(c,"type"));
1151
String *cname = (access && Strcmp(access,"public")) ?
1152
NewString("nil") : Copy(Getattr(c,"name"));
1139
SwigType *childType = NewStringf("%s%s", childDecl,
1140
Getattr(c, "type"));
1141
String *cname = (access && Strcmp(access, "public")) ? NewString("nil") : Copy(Getattr(c, "name"));
1153
1142
1154
if(!SwigType_isfunction(childType)) {
1155
// Printf(slotdefs, ";;; member functions don't appear as slots.\n ");
1156
// Printf(slotdefs, ";; ");
1157
String *ns = listify_namespace(Getattr(n, "allegrocl:package"));
1143
if (!SwigType_isfunction(childType)) {
1144
// Printf(slotdefs, ";;; member functions don't appear as slots.\n ");
1145
// Printf(slotdefs, ";; ");
1146
String *ns = listify_namespace(Getattr(n, "allegrocl:package"));
1158
1147
1159
1148
#ifdef ALLEGROCL_WRAP_DEBUG
1160
Printf(stderr, "slot name = '%s' ns = '%s' class-of '%s' and type = '%s'\n",
1161
cname, ns, name, childType);
1149
Printf(stderr, "slot name = '%s' ns = '%s' class-of '%s' and type = '%s'\n", cname, ns, name, childType);
1162
1150
#endif
1163
Printf(slotdefs, "(#.(swig-insert-id \"%s\" %s :type :slot :class \"%s\") %s)",
1164
cname, ns, name, compose_foreign_type(childType));
1165
Delete(ns);
1166
if(access && Strcmp(access,"public"))
1167
Printf(slotdefs, " ;; %s member", access);
1151
Printf(slotdefs, "(#.(swig-insert-id \"%s\" %s :type :slot :class \"%s\") %s)", cname, ns, name, compose_foreign_type(childType));
1152
Delete(ns);
1153
if (access && Strcmp(access, "public"))
1154
Printf(slotdefs, " ;; %s member", access);
1168
1155
1169
Printf(slotdefs, "\n ");
1156
Printf(slotdefs, "\n ");
1170
1157
}
1171
1158
Delete(childType);
1172
1159
Delete(cname);
1173
1160
}
1174
1161
}
1175
1162
1176
String *ns_list = listify_namespace(Getattr(n,"allegrocl:namespace"));
1177
update_package_if_needed(n,f_clhead);
1178
Printf(f_clhead,
1179
"(swig-def-foreign-class \"%s\"\n %s\n (:%s\n%s))\n\n",
1180
name, supers, kind, slotdefs);
1163
String *ns_list = listify_namespace(Getattr(n, "allegrocl:namespace"));
1164
update_package_if_needed(n, f_clhead);
1165
Printf(f_clhead, "(swig-def-foreign-class \"%s\"\n %s\n (:%s\n%s))\n\n", name, supers, kind, slotdefs);
1181
1166
1182
1167
Delete(supers);
1183
1168
Delete(ns_list);
1184
1169
1185
Setattr(n,"allegrocl:synonym:already-been-stubbed","1");
1170
Setattr(n, "allegrocl:synonym:already-been-stubbed", "1");
1186
1171
#ifdef ALLEGROCL_WRAP_DEBUG
1187
Printf(stderr,"emit_full_class: EXIT\n");
1172
Printf(stderr, "emit_full_class: EXIT\n");
1188
1173
#endif
1189
1174
1190
1175
}
1192
1177
void emit_class(Node *n) {
1193
1178
1194
1179
#ifdef ALLEGROCL_WRAP_DEBUG
1195
Printf(stderr,"emit_class: ENTER... '%s'(%x)\n", Getattr(n,"sym:name"), n);
1180
Printf(stderr, "emit_class: ENTER... '%s'(%x)\n", Getattr(n, "sym:name"), n);
1196
1181
#endif
1197
1182
1198
int is_tempInst = !Strcmp(nodeType(n),"templateInst");
1199
1200
String *ns_list = listify_namespace(Getattr(n,"allegrocl:namespace"));
1201
String *name = Getattr(n,is_tempInst ? "real-name" : "name");
1202
1203
if(SwigType_istemplate(name)) {
1183
int is_tempInst = !Strcmp(nodeType(n), "templateInst");
1184
1185
String *ns_list = listify_namespace(Getattr(n, "allegrocl:namespace"));
1186
String *name = Getattr(n, is_tempInst ? "real-name" : "name");
1187
1188
if (SwigType_istemplate(name)) {
1204
1189
String *temp = strip_namespaces(SwigType_templateprefix(name));
1205
name = NewStringf("%s%s%s", temp,
1206
SwigType_templateargs(name),
1207
SwigType_templatesuffix(name));
1190
name = NewStringf("%s%s%s", temp, SwigType_templateargs(name), SwigType_templatesuffix(name));
1208
1191
1209
1192
Delete(temp);
1210
1193
} else {
1211
1194
name = strip_namespaces(name);
1212
1195
}
1213
1196
1214
if(Getattr(n,"allegrocl:synonym:is-primary")) {
1197
if (Getattr(n, "allegrocl:synonym:is-primary")) {
1215
1198
// Printf(stderr," is primary... ");
1216
if(is_tempInst) {
1199
if (is_tempInst) {
1217
1200
emit_stub_class(n);
1218
1201
} else {
1219
1202
emit_full_class(n);
1221
1204
} else {
1222
1205
// Node *primary = Getattr(n,"allegrocl:synonym-of");
1223
1206
Node *primary = get_primary_synonym_of(n);
1224
if(primary && (primary != n)) {
1207
if (primary && (primary != n)) {
1225
1208
// Printf(stderr," emitting synonym... ");
1226
1209
emit_stub_class(primary);
1227
update_package_if_needed(n,f_clhead);
1210
update_package_if_needed(n, f_clhead);
1228
1211
emit_synonym(n);
1229
1212
} else {
1230
1213
emit_full_class(n);
1235
1218
Delete(ns_list);
1236
1219
1237
1220
#ifdef ALLEGROCL_WRAP_DEBUG
1238
Printf(stderr,"emit_class: EXIT\n");
1221
Printf(stderr, "emit_class: EXIT\n");
1239
1222
#endif
1240
1223
}
1241
1224
1242
1225
void emit_typedef(Node *n) {
1243
1226
1244
1227
#ifdef ALLEGROCL_WRAP_DEBUG
1245
Printf(stderr,"emit_typedef: ENTER... \n");
1228
Printf(stderr, "emit_typedef: ENTER... \n");
1246
1229
#endif
1247
1230
1248
1231
String *name;
1249
String *sym_name = Getattr(n,"sym:name");
1250
String *type = NewStringf("%s%s", Getattr(n,"decl"), Getattr(n,"type"));
1232
String *sym_name = Getattr(n, "sym:name");
1233
String *type = NewStringf("%s%s", Getattr(n, "decl"), Getattr(n, "type"));
1251
1234
String *lisp_type = compose_foreign_type(type);
1252
1235
Delete(type);
1253
Node *in_class = Getattr(n,"allegrocl:typedef:in-class");
1236
Node *in_class = Getattr(n, "allegrocl:typedef:in-class");
1254
1237
1255
1238
// Printf(stderr,"in emit_typedef: '%s'(%x).",Getattr(n,"name"),n);
1256
if(Getattr(n,"allegrocl:synonym-of")) {
1239
if (Getattr(n, "allegrocl:synonym-of")) {
1257
1240
// Printf(stderr," but it's a synonym of something.\n");
1258
1241
emit_synonym(n);
1259
1242
return;
1260
1243
}
1261
1244
1262
if(in_class) {
1263
String *class_name = Getattr(in_class,"name");
1264
if(SwigType_istemplate(class_name)) {
1245
if (in_class) {
1246
String *class_name = Getattr(in_class, "name");
1247
if (SwigType_istemplate(class_name)) {
1265
1248
String *temp = strip_namespaces(SwigType_templateprefix(class_name));
1266
class_name = NewStringf("%s%s%s", temp,
1267
SwigType_templateargs(class_name),
1268
SwigType_templatesuffix(class_name));
1249
class_name = NewStringf("%s%s%s", temp, SwigType_templateargs(class_name), SwigType_templatesuffix(class_name));
1269
1250
Delete(temp);
1270
1251
}
1271
1252
1272
name = NewStringf("%s__%s",class_name,sym_name);
1273
Setattr(n,"allegrocl:in-class",in_class);
1253
name = NewStringf("%s__%s", class_name, sym_name);
1254
Setattr(n, "allegrocl:in-class", in_class);
1274
1255
} else {
1275
name = sym_name ? Copy(sym_name) : Copy(Getattr(n,"name"));
1256
name = sym_name ? Copy(sym_name) : Copy(Getattr(n, "name"));
1276
1257
}
1277
1258
1278
1259
// leave these in for now. might want to change these to def-foreign-class at some point.
1283
1264
Delete(name);
1284
1265
1285
1266
#ifdef ALLEGROCL_WRAP_DEBUG
1286
Printf(stderr,"emit_typedef: EXIT\n");
1267
Printf(stderr, "emit_typedef: EXIT\n");
1287
1268
#endif
1288
1269
}
1289
1270
1290
1271
void emit_enum_type_no_wrap(Node *n) {
1291
1272
1292
1273
#ifdef ALLEGROCL_WRAP_DEBUG
1293
Printf(stderr,"emit_enum_type_no_wrap: ENTER... \n");
1274
Printf(stderr, "emit_enum_type_no_wrap: ENTER... \n");
1294
1275
#endif
1295
1276
1296
String *unnamed = Getattr(n,"unnamed");
1277
String *unnamed = Getattr(n, "unnamed");
1297
1278
String *name;
1298
1279
// SwigType *enumtype;
1299
1280
1300
name = unnamed ? Getattr(n,"allegrocl:name") : Getattr(n,"sym:name");
1281
name = unnamed ? Getattr(n, "allegrocl:name") : Getattr(n, "sym:name");
1301
1282
SwigType *tmp = NewStringf("enum %s", unnamed ? unnamed : name);
1302
1283
1303
1284
Hash *typemap = Swig_typemap_search("ffitype", tmp, 0, 0);
1305
1286
// enumtype = compose_foreign_type(tmp);
1306
1287
Delete(tmp);
1307
1288
1308
if(name) {
1289
if (name) {
1309
1290
String *ns = listify_namespace(current_namespace);
1310
1291
1311
Printf(f_clhead,"(swig-def-foreign-type \"%s\" %s)\n", name, enumtype);
1292
Printf(f_clhead, "(swig-def-foreign-type \"%s\" %s)\n", name, enumtype);
1312
1293
Delete(ns);
1313
1294
1314
1295
// walk children.
1315
1296
Node *c;
1316
for(c = firstChild(n); c; c=nextSibling(c)) {
1317
if(!Getattr(c,"error")) {
1318
String *val = Getattr(c,"enumvalue");
1319
if(!val) val = Getattr(c,"enumvalueex");
1320
String *converted_val = convert_literal(val,Getattr(c,"type"));
1321
String *valname = Getattr(c,"sym:name");
1297
for (c = firstChild(n); c; c = nextSibling(c)) {
1298
if (!Getattr(c, "error")) {
1299
String *val = Getattr(c, "enumvalue");
1300
if (!val)
1301
val = Getattr(c, "enumvalueex");
1302
String *converted_val = convert_literal(val, Getattr(c, "type"));
1303
String *valname = Getattr(c, "sym:name");
1322
1304
1323
if(converted_val) {
1324
Printf(f_clhead,"(swig-defconstant \"%s\" %s)\n", valname, converted_val);
1305
if (converted_val) {
1306
Printf(f_clhead, "(swig-defconstant \"%s\" %s)\n", valname, converted_val);
1325
1307
Delete(converted_val);
1326
1308
} else {
1327
Swig_warning(WARN_LANG_DISCARD_CONST, Getfile(n), Getline(n),
1328
"Unable to parse enum value '%s'. Setting to NIL\n", val);
1329
Printf(f_clhead,"(swig-defconstant \"%s\" nil #| %s |#)\n", valname, val);
1309
Swig_warning(WARN_LANG_DISCARD_CONST, Getfile(n), Getline(n), "Unable to parse enum value '%s'. Setting to NIL\n", val);
1310
Printf(f_clhead, "(swig-defconstant \"%s\" nil #| %s |#)\n", valname, val);
1330
1311
}
1331
1312
}
1332
1313
}
1333
1314
}
1334
Printf(f_clhead,"\n");
1315
Printf(f_clhead, "\n");
1335
1316
1336
1317
#ifdef ALLEGROCL_WRAP_DEBUG
1337
Printf(stderr,"emit_enum_type_no_wrap: EXIT\n");
1318
Printf(stderr, "emit_enum_type_no_wrap: EXIT\n");
1338
1319
#endif
1339
1320
1340
1321
}
1342
1323
void emit_enum_type(Node *n) {
1343
1324
1344
1325
#ifdef ALLEGROCL_WRAP_DEBUG
1345
Printf(stderr,"emit_enum_type: ENTER... \n");
1326
Printf(stderr, "emit_enum_type: ENTER... \n");
1346
1327
#endif
1347
1328
1348
if(!Generate_Wrapper) {
1329
if (!Generate_Wrapper) {
1349
1330
emit_enum_type_no_wrap(n);
1350
1331
return;
1351
1332
}
1352
1333
1353
String *unnamed = Getattr(n,"unnamed");
1334
String *unnamed = Getattr(n, "unnamed");
1354
1335
String *name;
1355
1336
// SwigType *enumtype;
1356
1337
1357
name = unnamed ? Getattr(n,"allegrocl:name") : Getattr(n,"sym:name");
1338
name = unnamed ? Getattr(n, "allegrocl:name") : Getattr(n, "sym:name");
1358
1339
SwigType *tmp = NewStringf("enum %s", unnamed ? unnamed : name);
1359
1340
// SwigType *tmp = NewStringf("enum ACL_SWIG_ENUM_NAME");
1360
1341
1364
1345
// enumtype = compose_foreign_type(tmp);
1365
1346
Delete(tmp);
1366
1347
1367
if(name) {
1348
if (name) {
1368
1349
String *ns = listify_namespace(current_namespace);
1369
1350
1370
Printf(f_clhead,"(swig-def-foreign-type \"%s\" %s)\n", name, enumtype);
1351
Printf(f_clhead, "(swig-def-foreign-type \"%s\" %s)\n", name, enumtype);
1371
1352
Delete(ns);
1372
1353
1373
1354
// walk children.
1374
1355
Node *c;
1375
1356
for(c = firstChild(n); c; c=nextSibling(c)) {
1376
1357
String *mangled_name = mangle_name(c, "ACL_ENUM", Getattr(c,"allegrocl:package"));
1377
Printf(f_clhead, "(swig-defvar \"%s\" \"%s\" :type :constant)\n",
1378
Getattr(c, "sym:name"), mangled_name);
1358
Printf(f_clhead, "(swig-defvar \"%s\" \"%s\" :type :constant :ftype :signed-long)\n", Getattr(c, "sym:name"), mangled_name);
1379
1359
Delete(mangled_name);
1380
1360
}
1381
1361
}
1382
1383
1362
#ifdef ALLEGROCL_WRAP_DEBUG
1384
Printf(stderr,"emit_enum_type: EXIT\n");
1363
Printf(stderr, "emit_enum_type: EXIT\n");
1385
1364
#endif
1386
1365
1387
1366
}
1389
1368
void emit_default_linked_type(Node *n) {
1390
1369
1391
1370
#ifdef ALLEGROCL_WRAP_DEBUG
1392
Printf(stderr,"emit_default_linked_type: ENTER... \n");
1371
Printf(stderr, "emit_default_linked_type: ENTER... \n");
1393
1372
#endif
1394
1373
1395
1374
// catchall for non class types.
1396
if(!Strcmp(nodeType(n),"classforward")) {
1397
Printf(f_clhead,";; forward referenced stub.\n");
1398
Printf(f_clhead,"(swig-def-foreign-type \"%s\" (:class ))\n\n",
1399
Getattr(n,"sym:name"));
1400
} else if(!Strcmp(nodeType(n),"enum")) {
1375
if (!Strcmp(nodeType(n), "classforward")) {
1376
Printf(f_clhead, ";; forward referenced stub.\n");
1377
Printf(f_clhead, "(swig-def-foreign-class \"%s\" (ff:foreign-pointer) (:class ))\n\n", Getattr(n, "sym:name"));
1378
} else if (!Strcmp(nodeType(n), "enum")) {
1401
1379
emit_enum_type(n);
1402
1380
} else {
1403
Printf(stderr,"Don't know how to emit node type '%s' named '%s'\n",
1404
nodeType(n), Getattr(n,"name"));
1381
Printf(stderr, "Don't know how to emit node type '%s' named '%s'\n", nodeType(n), Getattr(n, "name"));
1405
1382
}
1406
1383
1407
1384
#ifdef ALLEGROCL_WRAP_DEBUG
1408
Printf(stderr,"emit_default_linked_type: EXIT\n");
1385
Printf(stderr, "emit_default_linked_type: EXIT\n");
1409
1386
#endif
1410
1387
1411
1388
}
1413
1390
void dump_linked_types(File *f) {
1414
1391
Node *n = first_linked_type;
1415
1392
int i = 0;
1416
while(n) {
1417
Printf(f,"%d: (%x) node '%s' name '%s'\n", i++, n, nodeType(n), Getattr(n,"sym:name"));
1393
while (n) {
1394
Printf(f, "%d: (%x) node '%s' name '%s'\n", i++, n, nodeType(n), Getattr(n, "sym:name"));
1418
1395
1419
Node *t = Getattr(n,"allegrocl:synonym-of");
1420
if(t)
1421
Printf(f," synonym-of %s(%x)\n",Getattr(t,"name"),t);
1422
n = Getattr(n,"allegrocl:next_linked_type");
1396
Node *t = Getattr(n, "allegrocl:synonym-of");
1397
if (t)
1398
Printf(f, " synonym-of %s(%x)\n", Getattr(t, "name"), t);
1399
n = Getattr(n, "allegrocl:next_linked_type");
1423
1400
}
1424
1401
}
1425
1402
1426
1403
void emit_linked_types() {
1427
1404
1428
1405
#ifdef ALLEGROCL_WRAP_DEBUG
1429
Printf(stderr,"emit_linked_types: ENTER... ");
1406
Printf(stderr, "emit_linked_types: ENTER... ");
1430
1407
#endif
1431
1408
1432
1409
Node *n = first_linked_type;
1433
1410
1434
while(n) {
1411
while (n) {
1435
1412
String *node_type = nodeType(n);
1436
1413
1437
1414
// Printf(stderr,"emitting node %s(%x) of type %s.", Getattr(n,"name"),n, nodeType(n));
1438
if(!Strcmp(node_type,"class") || !Strcmp(node_type,"templateInst")) {
1415
if (!Strcmp(node_type, "class") || !Strcmp(node_type, "templateInst")) {
1439
1416
// may need to emit a stub, so it will update the package itself.
1440
1417
// Printf(stderr," Passing to emit_class.");
1441
1418
emit_class(n);
1442
} else if(!Strcmp(nodeType(n),"cdecl")) {
1419
} else if (!Strcmp(nodeType(n), "cdecl")) {
1443
1420
// Printf(stderr," Passing to emit_typedef.");
1444
update_package_if_needed(n,f_clhead);
1421
update_package_if_needed(n, f_clhead);
1445
1422
emit_typedef(n);
1446
1423
} else {
1447
1424
// Printf(stderr," Passing to default_emitter.");
1448
update_package_if_needed(n,f_clhead);
1425
update_package_if_needed(n, f_clhead);
1449
1426
emit_default_linked_type(n);
1450
1427
}
1451
1428
1452
n = Getattr(n,"allegrocl:next_linked_type");
1429
n = Getattr(n, "allegrocl:next_linked_type");
1453
1430
// Printf(stderr,"returned.\n");
1454
1431
}
1455
1432
1456
1433
#ifdef ALLEGROCL_WRAP_DEBUG
1457
Printf(stderr,"emit_linked_types: EXIT\n");
1434
Printf(stderr, "emit_linked_types: EXIT\n");
1458
1435
#endif
1459
1436
}
1460
1437
1462
1439
return (allegrocl = new ALLEGROCL());
1463
1440
}
1464
1441
1465
void ALLEGROCL :: main(int argc, char *argv[]) {
1442
void ALLEGROCL::main(int argc, char *argv[]) {
1466
1443
int i;
1467
1444
1468
SWIG_library_directory("allegrocl");
1445
SWIG_library_directory("allegrocl");
1469
1446
SWIG_config_file("allegrocl.swg");
1470
1447
1471
for(i=1; i<argc; i++) {
1448
for (i = 1; i < argc; i++) {
1472
1449
if (!strcmp(argv[i], "-identifier-converter")) {
1473
char *conv=argv[i+1];
1474
1450
char *conv = argv[i + 1];
1451
1475
1452
if (!conv)
1476
Swig_arg_error();
1453
Swig_arg_error();
1477
1454
1478
1455
Swig_mark_arg(i);
1479
Swig_mark_arg(i+1);
1456
Swig_mark_arg(i + 1);
1480
1457
i++;
1481
1458
1482
1459
/* check for built-ins */
1483
1460
if (!strcmp(conv, "lispify")) {
1484
identifier_converter="identifier-convert-lispify";
1461
identifier_converter = "identifier-convert-lispify";
1485
1462
} else if (!strcmp(conv, "null")) {
1486
identifier_converter="identifier-convert-null";
1463
identifier_converter = "identifier-convert-null";
1487
1464
} else {
1488
/* Must be user defined */
1489
char *idconv = new char[strlen(conv)+1];
1490
strcpy(idconv, conv);
1491
identifier_converter=idconv;
1465
/* Must be user defined */
1466
char *idconv = new char[strlen(conv) + 1];
1467
strcpy(idconv, conv);
1468
identifier_converter = idconv;
1492
1469
}
1493
1470
} else if (!strcmp(argv[i], "-cwrap")) {
1494
1471
CWrap = true;
1496
1473
} else if (!strcmp(argv[i], "-nocwrap")) {
1497
1474
CWrap = false;
1498
1475
Swig_mark_arg(i);
1476
} else if (!strcmp(argv[i], "-isolate")) {
1477
unique_swig_package = true;
1478
Swig_mark_arg(i);
1499
1479
}
1500
1480
1501
1481
if (!strcmp(argv[i], "-help")) {
1502
1482
fprintf(stdout, "Allegro CL Options (available with -allegrocl)\n");
1503
fprintf(stdout,
1504
" -identifier-converter <type or funcname>\n"
1505
"\tSpecifies the type of conversion to do on C identifiers to convert\n"
1506
"\tthem to symbols. There are two built-in converters: 'null' and\n"
1507
"\t 'lispify'. The default is 'null'. If you supply a name other\n"
1508
"\tthan one of the built-ins, then a function by that name will be\n"
1509
"\tcalled to convert identifiers to symbols.\n"
1483
fprintf(stdout,
1484
" -identifier-converter <type or funcname>\n"
1485
"\tSpecifies the type of conversion to do on C identifiers to convert\n"
1486
"\tthem to symbols. There are two built-in converters: 'null' and\n"
1487
"\t 'lispify'. The default is 'null'. If you supply a name other\n"
1488
"\tthan one of the built-ins, then a function by that name will be\n"
1489
"\tcalled to convert identifiers to symbols.\n"
1510
1490
"\n"
1511
1491
" -[no]cwrap\n"
1512
"\tTurn on or turn off generation of an intermediate C file when\n"
1513
"\tcreating a C interface. By default this is only done for C++ code.\n");
1492
"\tTurn on or turn off generation of an intermediate C file when\n" "\tcreating a C interface. By default this is only done for C++ code.\n");
1514
1493
1515
1494
}
1516
1495
1517
1496
}
1518
1497
1519
1498
allow_overloading();
1520
1499
}
1521
1500
1522
int ALLEGROCL :: top(Node *n) {
1523
module_name=Getattr(n, "name");
1524
String *cxx_filename=Getattr(n, "outfile");
1525
String *cl_filename=NewString("");
1501
int ALLEGROCL::top(Node *n) {
1502
module_name = Getattr(n, "name");
1503
String *cxx_filename = Getattr(n, "outfile");
1504
String *cl_filename = NewString("");
1505
1506
swig_package = unique_swig_package ? NewStringf("swig.%s", module_name) : NewString("swig");
1526
1507
1527
1508
Printf(cl_filename, "%s%s.cl", SWIG_output_directory(), module_name);
1528
1509
1529
f_cl=NewFile(cl_filename, "w");
1510
f_cl = NewFile(cl_filename, "w");
1530
1511
if (!f_cl) {
1531
1512
Printf(stderr, "Unable to open %s for writing\n", cl_filename);
1532
1513
SWIG_exit(EXIT_FAILURE);
1534
1515
1535
1516
Generate_Wrapper = CPlusPlus || CWrap;
1536
1517
1537
if (Generate_Wrapper)
1538
{
1539
f_cxx=NewFile(cxx_filename, "w");
1518
if (Generate_Wrapper) {
1519
f_cxx = NewFile(cxx_filename, "w");
1540
1520
if (!f_cxx) {
1541
Close(f_cl); Delete(f_cl);
1521
Close(f_cl);
1522
Delete(f_cl);
1542
1523
Printf(stderr, "Unable to open %s for writing\n", cxx_filename);
1543
1524
SWIG_exit(EXIT_FAILURE);
1544
1525
}
1545
}
1546
else f_cxx=NewString("");
1526
} else
1527
f_cxx = NewString("");
1547
1528
1548
1529
f_cxx_header = f_cxx;
1549
f_cxx_wrapper=NewString("");
1550
1551
Swig_register_filebyname("header",f_cxx_header);
1552
Swig_register_filebyname("wrapper",f_cxx_wrapper);
1553
Swig_register_filebyname("runtime",f_cxx);
1530
f_cxx_wrapper = NewString("");
1531
1532
Swig_register_filebyname("header", f_cxx_header);
1533
Swig_register_filebyname("wrapper", f_cxx_wrapper);
1534
Swig_register_filebyname("runtime", f_cxx);
1554
1535
Swig_register_filebyname("lisp", f_clwrap);
1555
1536
Swig_register_filebyname("lisphead", f_cl);
1556
1537
1557
1538
Printf(f_cl, ";; This is an automatically generated file. Make changes in\n"
1558
";; the definition file, not here.\n\n"
1559
"(defpackage :swig\n"
1560
" (:use :common-lisp :ff :excl)\n"
1561
" (:export #:*swig-identifier-converter* #:*swig-module-name*\n"
1562
" #:*void*))\n"
1563
"(in-package :swig)\n\n"
1564
"(eval-when (compile load eval)\n"
1565
" (defparameter *swig-identifier-converter* '%s)\n"
1566
" (defparameter *swig-module-name* :%s))\n\n",
1567
identifier_converter, module_name);
1568
Printf(f_cl, "(defpackage :%s\n"
1569
" (:use :common-lisp :swig :ff :excl))\n\n",
1570
module_name);
1539
";; the definition file, not here.\n\n"
1540
"(defpackage :%s\n"
1541
" (:use :common-lisp :ff :excl)\n"
1542
" (:export #:*swig-identifier-converter* #:*swig-module-name*\n"
1543
" #:*void* #:*swig-expoert-list*))\n"
1544
"(in-package :%s)\n\n"
1545
"(eval-when (compile load eval)\n"
1546
" (defparameter *swig-identifier-converter* '%s)\n"
1547
" (defparameter *swig-module-name* :%s))\n\n", swig_package, swig_package, identifier_converter, module_name);
1548
Printf(f_cl, "(defpackage :%s\n" " (:use :common-lisp :%s :ff :excl))\n\n", module_name, swig_package);
1571
1549
1572
1550
Printf(f_clhead, "(in-package :%s)\n", module_name);
1573
1551
1583
1561
#endif
1584
1562
emit_linked_types();
1585
1563
1586
Printf(f_clwrap, "\n(in-package :swig)\n");
1564
Printf(f_clwrap, "\n(in-package :%s)\n", swig_package);
1587
1565
Printf(f_clwrap, "\n(macrolet ((swig-do-export ()\n");
1588
1566
Printf(f_clwrap, " `(dolist (s ',*swig-export-list*)\n");
1589
1567
Printf(f_clwrap, " (apply #'export s))))\n");
1596
1574
Printf(stderr, "All done now!\n");
1597
1575
1598
1576
Close(f_cl);
1599
Delete(f_cl); // Delete the handle, not the file
1577
Delete(f_cl); // Delete the handle, not the file
1600
1578
Delete(f_clhead);
1601
1579
Delete(f_clwrap);
1602
1580
1621
1599
// String *argc_template_string;
1622
1600
1623
1601
struct Overloaded {
1624
Node *n; /* Node */
1625
int argc; /* Argument count */
1626
ParmList *parms; /* Parameters used for overload check */
1627
int error; /* Ambiguity error */
1602
Node *n; /* Node */
1603
int argc; /* Argument count */
1604
ParmList *parms; /* Parameters used for overload check */
1605
int error; /* Ambiguity error */
1628
1606
};
1629
1607
1630
1608
/* -----------------------------------------------------------------------------
1644
1622
* languages ignore the first method parsed.
1645
1623
* ----------------------------------------------------------------------------- */
1646
1624
1647
static List *
1648
Swig_overload_rank(Node *n, bool script_lang_wrapping) {
1649
Overloaded nodes[MAX_OVERLOAD];
1650
int nnodes = 0;
1651
Node *o = Getattr(n,"sym:overloaded");
1625
static List *Swig_overload_rank(Node *n, bool script_lang_wrapping) {
1626
Overloaded nodes[MAX_OVERLOAD];
1627
int nnodes = 0;
1628
Node *o = Getattr(n, "sym:overloaded");
1652
1629
Node *c;
1653
1630
1654
if (!o) return 0;
1631
if (!o)
1632
return 0;
1655
1633
1656
1634
c = o;
1657
1635
while (c) {
1658
if (Getattr(c,"error")) {
1659
c = Getattr(c,"sym:nextSibling");
1636
if (Getattr(c, "error")) {
1637
c = Getattr(c, "sym:nextSibling");
1660
1638
continue;
1661
1639
}
1662
1640
/* if (SmartPointer && Getattr(c,"cplus:staticbase")) {
1663
c = Getattr(c,"sym:nextSibling");
1664
continue;
1665
} */
1641
c = Getattr(c,"sym:nextSibling");
1642
continue;
1643
} */
1666
1644
1667
1645
/* Make a list of all the declarations (methods) that are overloaded with
1668
1646
* this one particular method name */
1669
if (Getattr(c,"wrap:name")) {
1647
if (Getattr(c, "wrap:name")) {
1670
1648
nodes[nnodes].n = c;
1671
nodes[nnodes].parms = Getattr(c,"wrap:parms");
1649
nodes[nnodes].parms = Getattr(c, "wrap:parms");
1672
1650
nodes[nnodes].argc = emit_num_required(nodes[nnodes].parms);
1673
1651
nodes[nnodes].error = 0;
1674
1652
nnodes++;
1675
1653
}
1676
c = Getattr(c,"sym:nextSibling");
1654
c = Getattr(c, "sym:nextSibling");
1677
1655
}
1678
1656
1679
1657
/* Sort the declarations by required argument count */
1680
1658
{
1681
int i,j;
1659
int i, j;
1682
1660
for (i = 0; i < nnodes; i++) {
1683
for (j = i+1; j < nnodes; j++) {
1684
if (nodes[i].argc > nodes[j].argc) {
1685
Overloaded t = nodes[i];
1686
nodes[i] = nodes[j];
1687
nodes[j] = t;
1688
}
1661
for (j = i + 1; j < nnodes; j++) {
1662
if (nodes[i].argc > nodes[j].argc) {
1663
Overloaded t = nodes[i];
1664
nodes[i] = nodes[j];
1665
nodes[j] = t;
1666
}
1689
1667
}
1690
1668
}
1691
1669
}
1692
1670
1693
1671
/* Sort the declarations by argument types */
1694
1672
{
1695
int i,j;
1696
for (i = 0; i < nnodes-1; i++) {
1697
if (nodes[i].argc == nodes[i+1].argc) {
1698
for (j = i+1; (j < nnodes) && (nodes[j].argc == nodes[i].argc); j++) {
1699
Parm *p1 = nodes[i].parms;
1700
Parm *p2 = nodes[j].parms;
1701
int differ = 0;
1702
int num_checked = 0;
1703
while (p1 && p2 && (num_checked < nodes[i].argc)) {
1704
// Printf(stdout,"p1 = '%s', p2 = '%s'\n", Getattr(p1,"type"), Getattr(p2,"type"));
1705
if (checkAttribute(p1,"tmap:in:numinputs","0")) {
1706
p1 = Getattr(p1,"tmap:in:next");
1707
continue;
1708
}
1709
if (checkAttribute(p2,"tmap:in:numinputs","0")) {
1710
p2 = Getattr(p2,"tmap:in:next");
1711
continue;
1712
}
1713
String *t1 = Getattr(p1,"tmap:typecheck:precedence");
1714
String *t2 = Getattr(p2,"tmap:typecheck:precedence");
1715
if ((!t1) && (!nodes[i].error)) {
1716
Swig_warning(WARN_TYPEMAP_TYPECHECK, Getfile(nodes[i].n), Getline(nodes[i].n),
1717
"Overloaded %s(%s) not supported (no type checking rule for '%s').\n",
1718
Getattr(nodes[i].n,"name"),ParmList_str_defaultargs(Getattr(nodes[i].n,"parms")),
1719
SwigType_str(Getattr(p1,"type"),0));
1720
nodes[i].error = 1;
1721
} else if ((!t2) && (!nodes[j].error)) {
1722
Swig_warning(WARN_TYPEMAP_TYPECHECK, Getfile(nodes[j].n), Getline(nodes[j].n),
1723
"Overloaded %s(%s) not supported (no type checking rule for '%s').\n",
1724
Getattr(nodes[j].n,"name"),ParmList_str_defaultargs(Getattr(nodes[j].n,"parms")),
1725
SwigType_str(Getattr(p2,"type"),0));
1726
nodes[j].error = 1;
1727
}
1728
if (t1 && t2) {
1729
int t1v, t2v;
1730
t1v = atoi(Char(t1));
1731
t2v = atoi(Char(t2));
1732
differ = t1v-t2v;
1733
}
1734
else if (!t1 && t2) differ = 1;
1735
else if (t2 && !t1) differ = -1;
1736
else if (!t1 && !t2) differ = -1;
1737
num_checked++;
1738
if (differ > 0) {
1739
Overloaded t = nodes[i];
1740
nodes[i] = nodes[j];
1741
nodes[j] = t;
1742
break;
1743
} else if ((differ == 0) && (Strcmp(t1,"0") == 0)) {
1744
t1 = Getattr(p1,"ltype");
1745
if (!t1) {
1746
t1 = SwigType_ltype(Getattr(p1,"type"));
1747
if (Getattr(p1,"tmap:typecheck:SWIGTYPE")) {
1748
SwigType_add_pointer(t1);
1749
}
1750
Setattr(p1,"ltype",t1);
1751
}
1752
t2 = Getattr(p2,"ltype");
1753
if (!t2) {
1754
t2 = SwigType_ltype(Getattr(p2,"type"));
1755
if (Getattr(p2,"tmap:typecheck:SWIGTYPE")) {
1756
SwigType_add_pointer(t2);
1757
}
1758
Setattr(p2,"ltype",t2);
1759
}
1760
1761
/* Need subtype check here. If t2 is a subtype of t1, then we need to change the
1762
order */
1763
1764
if (SwigType_issubtype(t2,t1)) {
1765
Overloaded t = nodes[i];
1766
nodes[i] = nodes[j];
1767
nodes[j] = t;
1768
}
1769
1770
if (Strcmp(t1,t2) != 0) {
1771
differ = 1;
1772
break;
1773
}
1774
} else if (differ) {
1775
break;
1776
}
1777
if (Getattr(p1,"tmap:in:next")) {
1778
p1 = Getattr(p1,"tmap:in:next");
1779
} else {
1780
p1 = nextSibling(p1);
1781
}
1782
if (Getattr(p2,"tmap:in:next")) {
1783
p2 = Getattr(p2,"tmap:in:next");
1784
} else {
1785
p2 = nextSibling(p2);
1786
}
1787
}
1788
if (!differ) {
1789
/* See if declarations differ by const only */
1790
String *d1 = Getattr(nodes[i].n,"decl");
1791
String *d2 = Getattr(nodes[j].n,"decl");
1792
if (d1 && d2) {
1793
String *dq1 = Copy(d1);
1794
String *dq2 = Copy(d2);
1795
if (SwigType_isconst(d1)) {
1796
Delete(SwigType_pop(dq1));
1797
}
1798
if (SwigType_isconst(d2)) {
1799
Delete(SwigType_pop(dq2));
1800
}
1801
if (Strcmp(dq1,dq2) == 0) {
1802
1803
if (SwigType_isconst(d1) && !SwigType_isconst(d2)) {
1804
if (script_lang_wrapping) {
1805
// Swap nodes so that the const method gets ignored (shadowed by the non-const method)
1806
Overloaded t = nodes[i];
1807
nodes[i] = nodes[j];
1808
nodes[j] = t;
1809
}
1810
differ = 1;
1811
if (!nodes[j].error) {
1812
if (script_lang_wrapping) {
1813
Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[j].n), Getline(nodes[j].n),
1814
"Overloaded %s(%s) const ignored. Non-const method at %s:%d used.\n",
1815
Getattr(nodes[j].n,"name"), ParmList_protostr(nodes[j].parms),
1816
Getfile(nodes[i].n), Getline(nodes[i].n));
1817
} else {
1818
if (!Getattr(nodes[j].n, "overload:ignore"))
1819
Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
1820
"Overloaded method %s(%s) ignored. Method %s(%s) const at %s:%d used.\n",
1821
Getattr(nodes[j].n,"name"), ParmList_protostr(nodes[j].parms),
1822
Getattr(nodes[i].n,"name"), ParmList_protostr(nodes[i].parms),
1823
Getfile(nodes[i].n), Getline(nodes[i].n));
1824
}
1825
}
1826
nodes[j].error = 1;
1827
} else if (!SwigType_isconst(d1) && SwigType_isconst(d2)) {
1828
differ = 1;
1829
if (!nodes[j].error) {
1830
if (script_lang_wrapping) {
1831
Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[j].n), Getline(nodes[j].n),
1832
"Overloaded %s(%s) const ignored. Non-const method at %s:%d used.\n",
1833
Getattr(nodes[j].n,"name"), ParmList_protostr(nodes[j].parms),
1834
Getfile(nodes[i].n), Getline(nodes[i].n));
1835
} else {
1836
if (!Getattr(nodes[j].n, "overload:ignore"))
1837
Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
1838
"Overloaded method %s(%s) const ignored. Method %s(%s) at %s:%d used.\n",
1839
Getattr(nodes[j].n,"name"), ParmList_protostr(nodes[j].parms),
1840
Getattr(nodes[i].n,"name"), ParmList_protostr(nodes[i].parms),
1841
Getfile(nodes[i].n), Getline(nodes[i].n));
1842
}
1843
}
1844
nodes[j].error = 1;
1845
}
1846
}
1847
Delete(dq1);
1848
Delete(dq2);
1849
}
1850
}
1851
if (!differ) {
1852
if (!nodes[j].error) {
1853
if (script_lang_wrapping) {
1854
Swig_warning(WARN_LANG_OVERLOAD_SHADOW, Getfile(nodes[j].n), Getline(nodes[j].n),
1855
"Overloaded %s(%s)%s is shadowed by %s(%s)%s at %s:%d.\n",
1856
Getattr(nodes[j].n,"name"), ParmList_protostr(nodes[j].parms),
1857
SwigType_isconst(Getattr(nodes[j].n,"decl")) ? " const" : "",
1858
Getattr(nodes[i].n,"name"), ParmList_protostr(nodes[i].parms),
1859
SwigType_isconst(Getattr(nodes[i].n,"decl")) ? " const" : "",
1860
Getfile(nodes[i].n),Getline(nodes[i].n));
1861
} else {
1862
if (!Getattr(nodes[j].n, "overload:ignore"))
1863
Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
1864
"Overloaded method %s(%s)%s ignored. Method %s(%s)%s at %s:%d used.\n",
1865
Getattr(nodes[j].n,"name"), ParmList_protostr(nodes[j].parms),
1866
SwigType_isconst(Getattr(nodes[j].n,"decl")) ? " const" : "",
1867
Getattr(nodes[i].n,"name"), ParmList_protostr(nodes[i].parms),
1868
SwigType_isconst(Getattr(nodes[i].n,"decl")) ? " const" : "",
1869
Getfile(nodes[i].n),Getline(nodes[i].n));
1870
}
1871
nodes[j].error = 1;
1872
}
1873
}
1874
}
1673
int i, j;
1674
for (i = 0; i < nnodes - 1; i++) {
1675
if (nodes[i].argc == nodes[i + 1].argc) {
1676
for (j = i + 1; (j < nnodes) && (nodes[j].argc == nodes[i].argc); j++) {
1677
Parm *p1 = nodes[i].parms;
1678
Parm *p2 = nodes[j].parms;
1679
int differ = 0;
1680
int num_checked = 0;
1681
while (p1 && p2 && (num_checked < nodes[i].argc)) {
1682
// Printf(stdout,"p1 = '%s', p2 = '%s'\n", Getattr(p1,"type"), Getattr(p2,"type"));
1683
if (checkAttribute(p1, "tmap:in:numinputs", "0")) {
1684
p1 = Getattr(p1, "tmap:in:next");
1685
continue;
1686
}
1687
if (checkAttribute(p2, "tmap:in:numinputs", "0")) {
1688
p2 = Getattr(p2, "tmap:in:next");
1689
continue;
1690
}
1691
String *t1 = Getattr(p1, "tmap:typecheck:precedence");
1692
String *t2 = Getattr(p2, "tmap:typecheck:precedence");
1693
if ((!t1) && (!nodes[i].error)) {
1694
Swig_warning(WARN_TYPEMAP_TYPECHECK, Getfile(nodes[i].n), Getline(nodes[i].n),
1695
"Overloaded %s(%s) not supported (no type checking rule for '%s').\n",
1696
Getattr(nodes[i].n, "name"), ParmList_str_defaultargs(Getattr(nodes[i].n, "parms")), SwigType_str(Getattr(p1, "type"), 0));
1697
nodes[i].error = 1;
1698
} else if ((!t2) && (!nodes[j].error)) {
1699
Swig_warning(WARN_TYPEMAP_TYPECHECK, Getfile(nodes[j].n), Getline(nodes[j].n),
1700
"Overloaded %s(%s) not supported (no type checking rule for '%s').\n",
1701
Getattr(nodes[j].n, "name"), ParmList_str_defaultargs(Getattr(nodes[j].n, "parms")), SwigType_str(Getattr(p2, "type"), 0));
1702
nodes[j].error = 1;
1703
}
1704
if (t1 && t2) {
1705
int t1v, t2v;
1706
t1v = atoi(Char(t1));
1707
t2v = atoi(Char(t2));
1708
differ = t1v - t2v;
1709
} else if (!t1 && t2)
1710
differ = 1;
1711
else if (t2 && !t1)
1712
differ = -1;
1713
else if (!t1 && !t2)
1714
differ = -1;
1715
num_checked++;
1716
if (differ > 0) {
1717
Overloaded t = nodes[i];
1718
nodes[i] = nodes[j];
1719
nodes[j] = t;
1720
break;
1721
} else if ((differ == 0) && (Strcmp(t1, "0") == 0)) {
1722
t1 = Getattr(p1, "ltype");
1723
if (!t1) {
1724
t1 = SwigType_ltype(Getattr(p1, "type"));
1725
if (Getattr(p1, "tmap:typecheck:SWIGTYPE")) {
1726
SwigType_add_pointer(t1);
1727
}
1728
Setattr(p1, "ltype", t1);
1729
}
1730
t2 = Getattr(p2, "ltype");
1731
if (!t2) {
1732
t2 = SwigType_ltype(Getattr(p2, "type"));
1733
if (Getattr(p2, "tmap:typecheck:SWIGTYPE")) {
1734
SwigType_add_pointer(t2);
1735
}
1736
Setattr(p2, "ltype", t2);
1737
}
1738
1739
/* Need subtype check here. If t2 is a subtype of t1, then we need to change the
1740
order */
1741
1742
if (SwigType_issubtype(t2, t1)) {
1743
Overloaded t = nodes[i];
1744
nodes[i] = nodes[j];
1745
nodes[j] = t;
1746
}
1747
1748
if (Strcmp(t1, t2) != 0) {
1749
differ = 1;
1750
break;
1751
}
1752
} else if (differ) {
1753
break;
1754
}
1755
if (Getattr(p1, "tmap:in:next")) {
1756
p1 = Getattr(p1, "tmap:in:next");
1757
} else {
1758
p1 = nextSibling(p1);
1759
}
1760
if (Getattr(p2, "tmap:in:next")) {
1761
p2 = Getattr(p2, "tmap:in:next");
1762
} else {
1763
p2 = nextSibling(p2);
1764
}
1765
}
1766
if (!differ) {
1767
/* See if declarations differ by const only */
1768
String *d1 = Getattr(nodes[i].n, "decl");
1769
String *d2 = Getattr(nodes[j].n, "decl");
1770
if (d1 && d2) {
1771
String *dq1 = Copy(d1);
1772
String *dq2 = Copy(d2);
1773
if (SwigType_isconst(d1)) {
1774
Delete(SwigType_pop(dq1));
1775
}
1776
if (SwigType_isconst(d2)) {
1777
Delete(SwigType_pop(dq2));
1778
}
1779
if (Strcmp(dq1, dq2) == 0) {
1780
1781
if (SwigType_isconst(d1) && !SwigType_isconst(d2)) {
1782
if (script_lang_wrapping) {
1783
// Swap nodes so that the const method gets ignored (shadowed by the non-const method)
1784
Overloaded t = nodes[i];
1785
nodes[i] = nodes[j];
1786
nodes[j] = t;
1787
}
1788
differ = 1;
1789
if (!nodes[j].error) {
1790
if (script_lang_wrapping) {
1791
Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[j].n), Getline(nodes[j].n),
1792
"Overloaded %s(%s) const ignored. Non-const method at %s:%d used.\n",
1793
Getattr(nodes[j].n, "name"), ParmList_protostr(nodes[j].parms), Getfile(nodes[i].n), Getline(nodes[i].n));
1794
} else {
1795
if (!Getattr(nodes[j].n, "overload:ignore"))
1796
Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
1797
"Overloaded method %s(%s) ignored. Method %s(%s) const at %s:%d used.\n",
1798
Getattr(nodes[j].n, "name"), ParmList_protostr(nodes[j].parms),
1799
Getattr(nodes[i].n, "name"), ParmList_protostr(nodes[i].parms), Getfile(nodes[i].n), Getline(nodes[i].n));
1800
}
1801
}
1802
nodes[j].error = 1;
1803
} else if (!SwigType_isconst(d1) && SwigType_isconst(d2)) {
1804
differ = 1;
1805
if (!nodes[j].error) {
1806
if (script_lang_wrapping) {
1807
Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[j].n), Getline(nodes[j].n),
1808
"Overloaded %s(%s) const ignored. Non-const method at %s:%d used.\n",
1809
Getattr(nodes[j].n, "name"), ParmList_protostr(nodes[j].parms), Getfile(nodes[i].n), Getline(nodes[i].n));
1810
} else {
1811
if (!Getattr(nodes[j].n, "overload:ignore"))
1812
Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
1813
"Overloaded method %s(%s) const ignored. Method %s(%s) at %s:%d used.\n",
1814
Getattr(nodes[j].n, "name"), ParmList_protostr(nodes[j].parms),
1815
Getattr(nodes[i].n, "name"), ParmList_protostr(nodes[i].parms), Getfile(nodes[i].n), Getline(nodes[i].n));
1816
}
1817
}
1818
nodes[j].error = 1;
1819
}
1820
}
1821
Delete(dq1);
1822
Delete(dq2);
1823
}
1824
}
1825
if (!differ) {
1826
if (!nodes[j].error) {
1827
if (script_lang_wrapping) {
1828
Swig_warning(WARN_LANG_OVERLOAD_SHADOW, Getfile(nodes[j].n), Getline(nodes[j].n),
1829
"Overloaded %s(%s)%s is shadowed by %s(%s)%s at %s:%d.\n",
1830
Getattr(nodes[j].n, "name"), ParmList_protostr(nodes[j].parms),
1831
SwigType_isconst(Getattr(nodes[j].n, "decl")) ? " const" : "",
1832
Getattr(nodes[i].n, "name"), ParmList_protostr(nodes[i].parms),
1833
SwigType_isconst(Getattr(nodes[i].n, "decl")) ? " const" : "", Getfile(nodes[i].n), Getline(nodes[i].n));
1834
} else {
1835
if (!Getattr(nodes[j].n, "overload:ignore"))
1836
Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
1837
"Overloaded method %s(%s)%s ignored. Method %s(%s)%s at %s:%d used.\n",
1838
Getattr(nodes[j].n, "name"), ParmList_protostr(nodes[j].parms),
1839
SwigType_isconst(Getattr(nodes[j].n, "decl")) ? " const" : "",
1840
Getattr(nodes[i].n, "name"), ParmList_protostr(nodes[i].parms),
1841
SwigType_isconst(Getattr(nodes[i].n, "decl")) ? " const" : "", Getfile(nodes[i].n), Getline(nodes[i].n));
1842
}
1843
nodes[j].error = 1;
1844
}
1845
}
1846
}
1875
1847
}
1876
1848
}
1877
1849
}
1880
1852
int i;
1881
1853
for (i = 0; i < nnodes; i++) {
1882
1854
if (nodes[i].error)
1883
Setattr(nodes[i].n, "overload:ignore", "1");
1884
Append(result,nodes[i].n);
1855
Setattr(nodes[i].n, "overload:ignore", "1");
1856
Append(result, nodes[i].n);
1885
1857
// Printf(stdout,"[ %d ] %s\n", i, ParmList_protostr(nodes[i].parms));
1886
1858
// Swig_print_node(nodes[i].n);
1887
1859
}
1893
1865
1894
1866
int any_varargs(ParmList *pl) {
1895
1867
Parm *p;
1896
1897
for(p=pl; p; p=nextSibling(p)) {
1868
1869
for (p = pl; p; p = nextSibling(p)) {
1898
1870
if (SwigType_isvarargs(Getattr(p, "type")))
1899
1871
return 1;
1900
1872
}
1902
1874
return 0;
1903
1875
}
1904
1876
1905
String *get_lisp_type(SwigType *ty, const String_or_char *name)
1906
{
1877
String *get_lisp_type(SwigType *ty, const String_or_char *name) {
1907
1878
Hash *typemap = Swig_typemap_search("lisptype", ty, name, 0);
1908
1879
if (typemap) {
1909
1880
String *typespec = Getattr(typemap, "code");
1910
1881
return NewString(typespec);
1911
}
1912
else {
1882
} else {
1913
1883
return NewString("");
1914
1884
}
1915
1885
}
1916
1886
1917
Node *parent_node_skipping_extends(Node* n)
1918
{
1919
Node* result = n;
1887
Node *parent_node_skipping_extends(Node *n) {
1888
Node *result = n;
1920
1889
do {
1921
1890
result = parentNode(result);
1922
1891
}
1934
1903
1935
1904
int emit_num_lin_arguments(ParmList *parms) {
1936
1905
Parm *p = parms;
1937
int nargs = 0;
1906
int nargs = 0;
1938
1907
1939
1908
while (p) {
1940
1909
// Printf(stderr,"enla: '%s' lin='%x'\n", Getattr(p,"name"), Getattr(p,"tmap:lin"));
1941
if (Getattr(p,"tmap:lin")) {
1942
nargs += GetInt(p,"tmap:lin:numinputs");
1943
p = Getattr(p,"tmap:lin:next");
1910
if (Getattr(p, "tmap:lin")) {
1911
nargs += GetInt(p, "tmap:lin:numinputs");
1912
p = Getattr(p, "tmap:lin:next");
1944
1913
} else {
1945
1914
p = nextSibling(p);
1946
1915
}
1948
1917
1949
1918
/* DB 04/02/2003: Not sure this is necessary with tmap:in:numinputs */
1950
1919
/*
1951
if (parms && (p = Getattr(parms,"emit:varargs"))) {
1952
if (!nextSibling(p)) {
1953
nargs--;
1954
}
1955
}
1956
*/
1920
if (parms && (p = Getattr(parms,"emit:varargs"))) {
1921
if (!nextSibling(p)) {
1922
nargs--;
1923
}
1924
}
1925
*/
1957
1926
return nargs;
1958
1927
}
1959
1928
1960
String *id_converter_type(SwigType const *type)
1961
{
1929
String *id_converter_type(SwigType const *type) {
1962
1930
SwigType *t = Copy(type);
1963
1931
String *result = 0;
1964
1965
if (SwigType_ispointer(t))
1966
{
1932
1933
if (SwigType_ispointer(t)) {
1967
1934
SwigType_pop(t);
1968
1935
String *pointee = id_converter_type(t);
1969
1936
result = NewStringf("(:* %s)", pointee);
1970
1937
Delete(pointee);
1971
}
1972
else if (SwigType_ismemberpointer(t))
1973
{
1938
} else if (SwigType_ismemberpointer(t)) {
1974
1939
String *klass = SwigType_parm(t);
1975
1940
SwigType_pop(t);
1976
1941
String *member = id_converter_type(t);
1977
1942
result = NewStringf("(:member \"%s\" %s)", klass, member);
1978
1943
Delete(klass);
1979
1944
Delete(member);
1980
}
1981
else if (SwigType_isreference(t))
1982
{
1945
} else if (SwigType_isreference(t)) {
1983
1946
SwigType_pop(t);
1984
1947
String *referencee = id_converter_type(t);
1985
1948
result = NewStringf("(:& %s)", referencee);
1986
1949
Delete(referencee);
1987
}
1988
else if (SwigType_isarray(t))
1989
{
1950
} else if (SwigType_isarray(t)) {
1990
1951
String *size = SwigType_parm(t);
1991
1952
SwigType_pop(t);
1992
1953
String *element_type = id_converter_type(t);
1993
1954
result = NewStringf("(:array %s \"%s\")", element_type, size);
1994
1955
Delete(size);
1995
1956
Delete(element_type);
1996
}
1997
else if (SwigType_isfunction(t))
1998
{
1957
} else if (SwigType_isfunction(t)) {
1999
1958
result = NewString("(:function (");
2000
1959
String *parmlist_str = SwigType_parm(t);
2001
1960
List *parms = SwigType_parmlist(parmlist_str);
2002
2003
for (Iterator i = First(parms); i.item; )
2004
{
2005
String *parm = id_converter_type((SwigType *)i.item);
1961
1962
for (Iterator i = First(parms); i.item;) {
1963
String *parm = id_converter_type((SwigType *) i.item);
2006
1964
Printf(result, "%s", parm);
2007
1965
i = Next(i);
2008
if (i.item) Printf(result, " ");
1966
if (i.item)
1967
Printf(result, " ");
2009
1968
Delete(parm);
2010
1969
}
2011
1970
SwigType_pop(t);
2012
1971
String *ret = id_converter_type(t);
2013
1972
Printf(result, ") %s)", ret);
2014
1973
2015
1974
Delete(parmlist_str);
2016
1975
Delete(parms);
2017
1976
Delete(ret);
2018
}
2019
else if (SwigType_isqualifier(t))
2020
{
1977
} else if (SwigType_isqualifier(t)) {
2021
1978
result = NewString("(:qualified (");
2022
String *qualifiers_str = Copy(SwigType_parm(t)); // ?!
2023
// Replaceall below SEGVs if we don't put the Copy here...
1979
String *qualifiers_str = Copy(SwigType_parm(t)); // ?!
1980
// Replaceall below SEGVs if we don't put the Copy here...
2024
1981
SwigType_pop(t);
2025
1982
String *qualifiee = id_converter_type(t);
2026
1983
2027
1984
Replaceall(qualifiers_str, " ", " :");
2028
if (Len(qualifiers_str) > 0) Printf(result, ":");
1985
if (Len(qualifiers_str) > 0)
1986
Printf(result, ":");
2029
1987
Printf(result, "%s) %s)", qualifiers_str, qualifiee);
2030
1988
2031
1989
Delete(qualifiers_str);
2032
1990
Delete(qualifiee);
2033
}
2034
else if (SwigType_istemplate(t))
2035
{
1991
} else if (SwigType_istemplate(t)) {
2036
1992
result = NewStringf("(:template \"%s\")", t);
2037
}
2038
else /* if (SwigType_issimple(t)) */
2039
{
2040
if (Strstr(Char(t), "::"))
2041
{
1993
} else { /* if (SwigType_issimple(t)) */
1994
1995
if (Strstr(Char(t), "::")) {
2042
1996
result = listify_namespace(t);
2043
}
2044
else
2045
{
1997
} else {
2046
1998
result = NewStringf("\"%s\"", t);
2047
1999
}
2048
2000
}
2049
2001
2050
2002
Delete(t);
2051
2003
return result;
2052
2004
}
2053
2005
2054
static ParmList *parmlist_with_names(ParmList *pl)
2055
{
2056
ParmList* pl2 = CopyParmList(pl);
2057
for (Parm *p = pl, *p2 = pl2; p2;
2058
p=nextSibling(p), p2=nextSibling(p2))
2059
{
2006
static ParmList *parmlist_with_names(ParmList *pl) {
2007
ParmList *pl2 = CopyParmList(pl);
2008
for (Parm *p = pl, *p2 = pl2; p2; p = nextSibling(p), p2 = nextSibling(p2)) {
2060
2009
if (!Getattr(p2, "name"))
2061
2010
Setattr(p2, "name", Getattr(p2, "lname"));
2062
2011
Setattr(p2, "name", strip_namespaces(Getattr(p2, "name")));
2063
2012
Setattr(p2, "tmap:ctype", Getattr(p, "tmap:ctype"));
2064
2065
String *temp = Getattr(p,"tmap:lin");
2013
2014
String *temp = Getattr(p, "tmap:lin");
2066
2015
if (temp) {
2067
2016
Setattr(p2, "tmap:lin", temp);
2068
Setattr(p2, "tmap:lin:next", Getattr(p,"tmap:lin:next"));
2017
Setattr(p2, "tmap:lin:next", Getattr(p, "tmap:lin:next"));
2069
2018
}
2070
2019
}
2071
2020
return pl2;
2072
2021
}
2073
2022
2074
static String *parmlist_str_id_converter(ParmList *pl)
2075
{
2023
static String *parmlist_str_id_converter(ParmList *pl) {
2076
2024
String *result = NewString("");
2077
for (Parm *p = pl; p; )
2078
{
2079
String *lispy_type = id_converter_type(Getattr(p, "type"));
2025
for (Parm *p = pl; p;) {
2026
String *lispy_type = id_converter_type(Getattr(p, "type"));
2080
2027
Printf(result, "(\"%s\" %s)", Getattr(p, "name"), lispy_type);
2081
2028
Delete(lispy_type);
2082
if ((p=nextSibling(p))) Printf(result, " ");
2029
if ((p = nextSibling(p)))
2030
Printf(result, " ");
2083
2031
}
2084
2032
return result;
2085
2033
}
2086
2034
2087
2035
String *collect_others_args(Node *overload) {
2088
String *overloaded_from = Getattr(overload,"sym:overloaded");
2036
String *overloaded_from = Getattr(overload, "sym:overloaded");
2089
2037
String *others_args = NewString("");
2090
2038
int first_overload = 1;
2091
2092
for (Node *overload2 = overloaded_from;
2093
overload2;
2094
overload2 = Getattr(overload2,"sym:nextSibling"))
2095
{
2096
if (overload2 == overload ||
2097
GetInt(overload2, "overload:ignore"))
2098
continue;
2099
2100
ParmList *opl = parmlist_with_names(Getattr(overload2, "wrap:parms"));
2101
String *args = parmlist_str_id_converter(opl);
2102
if (!first_overload)
2103
Printf(others_args, "\n ");
2104
Printf(others_args, "(%s)", args);
2105
Delete(args);
2106
Delete(opl);
2107
first_overload = 0;
2108
}
2039
2040
for (Node *overload2 = overloaded_from; overload2; overload2 = Getattr(overload2, "sym:nextSibling")) {
2041
if (overload2 == overload || GetInt(overload2, "overload:ignore"))
2042
continue;
2043
2044
ParmList *opl = parmlist_with_names(Getattr(overload2, "wrap:parms"));
2045
String *args = parmlist_str_id_converter(opl);
2046
if (!first_overload)
2047
Printf(others_args, "\n ");
2048
Printf(others_args, "(%s)", args);
2049
Delete(args);
2050
Delete(opl);
2051
first_overload = 0;
2052
}
2109
2053
return others_args;
2110
2054
}
2111
2055
2112
2056
struct IDargs {
2113
String* name;
2114
String* type;
2115
String* klass;
2116
String* arity;
2117
2118
IDargs() : name(0), type(0), klass(0), arity(0) {}
2119
2120
String* full_quoted_str() {
2057
String *name;
2058
String *type;
2059
String *klass;
2060
String *arity;
2061
2062
IDargs():name(0), type(0), klass(0), arity(0) {
2063
} String *full_quoted_str() {
2121
2064
String *result = no_others_quoted_str();
2122
if (arity) Printf(result, " :arity %s", arity);
2065
if (arity)
2066
Printf(result, " :arity %s", arity);
2123
2067
return result;
2124
2068
}
2125
2069
2126
String* no_others_quoted_str() {
2070
String *no_others_quoted_str() {
2127
2071
String *result = NewString("");
2128
2072
Printf(result, "\"%s\" :type :%s", name, type);
2129
if (klass) Printf(result, " :class \"%s\"", klass);
2073
if (klass)
2074
Printf(result, " :class \"%s\"", klass);
2130
2075
return result;
2131
2076
}
2132
2077
2133
String* noname_str() {
2078
String *noname_str() {
2134
2079
String *result = NewString("");
2135
2080
Printf(result, " :type :%s", type);
2136
if (klass) Printf(result, " :class \"%s\"", klass);
2137
if (arity) Printf(result, " :arity %s", arity);
2081
if (klass)
2082
Printf(result, " :class \"%s\"", klass);
2083
if (arity)
2084
Printf(result, " :arity %s", arity);
2138
2085
return result;
2139
2086
}
2140
2087
};
2141
IDargs* id_converter_arguments(Node *n)
2142
{
2143
IDargs* result = (IDargs*)GetVoid(n, "allegrocl:id-converter-args");
2144
if (!result) result = new IDargs;
2088
IDargs *id_converter_arguments(Node *n) {
2089
IDargs *result = (IDargs *) GetVoid(n, "allegrocl:id-converter-args");
2090
if (!result)
2091
result = new IDargs;
2145
2092
2146
2093
// Base name
2147
2094
if (!result->name) {
2148
2095
result->name = Getattr(n, "allegrocl:old-sym:name");
2149
if (!result->name) result->name = Getattr(n, "sym:name");
2096
if (!result->name)
2097
result->name = Getattr(n, "sym:name");
2150
2098
result->name = Copy(result->name);
2151
2099
}
2152
2153
2100
// :type
2154
if (result->type) Delete(result->type);
2101
if (result->type)
2102
Delete(result->type);
2155
2103
if (!Getattr(n, "allegrocl:kind"))
2156
2104
Setattr(n, "allegrocl:kind", "function");
2157
2105
if (Strstr(Getattr(n, "name"), "operator "))
2158
2106
Replaceall(Getattr(n, "allegrocl:kind"), "function", "operator");
2159
if (Strstr(Getattr(n, "allegrocl:kind"), "variable"))
2160
{
2107
if (Strstr(Getattr(n, "allegrocl:kind"), "variable")) {
2161
2108
int name_end = Len(Getattr(n, "sym:name")) - 4;
2162
2109
char *str = Char(Getattr(n, "sym:name"));
2163
String *get_set = NewString(str+name_end+1);
2110
String *get_set = NewString(str + name_end + 1);
2164
2111
result->type = Copy(Getattr(n, "allegrocl:kind"));
2165
2112
Replaceall(result->type, "variable", "");
2166
2113
Printf(result->type, "%ster", get_set);
2167
2114
Delete(get_set);
2168
}
2169
else
2170
{
2115
} else {
2171
2116
result->type = Copy(Getattr(n, "allegrocl:kind"));
2172
2117
}
2173
2118
2174
2119
// :class
2175
if (Strstr(result->type, "member "))
2176
{
2120
if (Strstr(result->type, "member ")) {
2177
2121
Replaceall(result->type, "member ", "");
2178
2122
if (!result->klass)
2179
result->klass = Copy(Getattr(parent_node_skipping_extends(n),
2180
"sym:name"));
2123
result->klass = Copy(Getattr(parent_node_skipping_extends(n), "sym:name"));
2181
2124
}
2182
2183
2125
// :arity
2184
2126
if (Getattr(n, "sym:overloaded")) {
2185
if(result->arity) Delete(result->arity);
2127
if (result->arity)
2128
Delete(result->arity);
2186
2129
result->arity = NewStringf("%d",
2187
2130
// emit_num_arguments(Getattr(n, "wrap:parms")));
2188
2131
emit_num_lin_arguments(Getattr(n, "wrap:parms")));
2132
Printf(stderr, "got arity of '%s' node '%s' '%x'\n", result->arity, Getattr(n,"name"), Getattr(n,"wrap:parms"));
2189
2133
}
2190
2134
2191
2135
SetVoid(n, "allegrocl:id-converter-args", result);
2192
2136
return result;
2193
2137
}
2194
2138
2195
int ALLEGROCL :: emit_buffered_defuns(Node *n) {
2139
int ALLEGROCL::emit_buffered_defuns(Node *n) {
2196
2140
2197
Node *overloaded_from = Getattr(n,"sym:overloaded");
2141
Node *overloaded_from = Getattr(n, "sym:overloaded");
2198
2142
2199
2143
String *wrap;
2200
2144
2201
2145
if (!overloaded_from) {
2202
wrap = Getattr(n,"allegrocl:lisp-wrap");
2146
wrap = Getattr(n, "allegrocl:lisp-wrap");
2203
2147
2204
Printf(f_clwrap,"%s\n",wrap);
2205
Delattr(n,"allegrocl:lisp-wrap");
2148
Printf(f_clwrap, "%s\n", wrap);
2149
Delattr(n, "allegrocl:lisp-wrap");
2206
2150
Delete(wrap);
2207
2151
} else {
2208
for (Node *overload = overloaded_from;
2209
overload;
2210
overload = Getattr(overload,"sym:nextSibling"))
2211
{
2212
String *others_args = collect_others_args(overload);
2213
wrap = Getattr(overload, "allegrocl:lisp-wrap");
2152
for (Node *overload = overloaded_from; overload; overload = Getattr(overload, "sym:nextSibling")) {
2153
String *others_args = collect_others_args(overload);
2154
wrap = Getattr(overload, "allegrocl:lisp-wrap");
2214
2155
2215
Replaceall(wrap, "@@OTHERS-ARGS-GO-HERE@@", others_args);
2156
Replaceall(wrap, "@@OTHERS-ARGS-GO-HERE@@", others_args);
2216
2157
// IDargs* id_args = id_converter_arguments(overload);
2217
2158
// Replaceall(id_args->others_args, "@@OTHERS-ARGS-GO-HERE@@", others_args);
2218
2159
2219
if (!GetInt(overload, "overload:ignore"))
2220
Printf(f_clwrap, "%s", wrap);
2160
if (!GetInt(overload, "overload:ignore"))
2161
Printf(f_clwrap, "%s", wrap);
2221
2162
2222
Delattr(overload, "allegrocl:lisp-wrap");
2223
Delete(wrap);
2224
}
2163
Delattr(overload, "allegrocl:lisp-wrap");
2164
Delete(wrap);
2165
}
2225
2166
}
2226
2167
return SWIG_OK;
2227
2168
}
2228
2169
2229
String *dispatching_type(Parm* p) {
2170
String *dispatching_type(Parm *p) {
2230
2171
String *result = 0;
2231
2172
2232
String *parsed = Getattr(p, "type"); //Swig_cparse_type(Getattr(p,"tmap:ctype"));
2173
String *parsed = Getattr(p, "type"); //Swig_cparse_type(Getattr(p,"tmap:ctype"));
2233
2174
String *cl_t = SwigType_typedef_resolve_all(parsed);
2234
2175
2235
2176
Hash *typemap = Swig_typemap_search("lispclass", parsed, Getattr(p, "name"), 0);
2236
2177
// Printf(stderr,"inspecting type '%s' for class\n", parsed);
2237
2178
// Printf(stderr," cfcocr = '%s' res_all = '%s'\n",
2238
// class_from_class_or_class_ref(parsed), cl_t);
2179
// class_from_class_or_class_ref(parsed), cl_t);
2239
2180
if (typemap) {
2240
2181
result = Copy(Getattr(typemap, "code"));
2241
2182
} else {
2242
2183
String *lookup_type = class_from_class_or_class_ref(parsed);
2243
if(lookup_type) result = lookup_defined_foreign_ltype(lookup_type);
2184
if (lookup_type)
2185
result = lookup_defined_foreign_ltype(lookup_type);
2244
2186
}
2245
2187
2246
2188
// if (!result && SwigType_ispointer(cl_t)) {
2247
2189
// SwigType_pop(cl_t);
2248
2190
// result = lookup_defined_foreign_ltype(cl_t);
2256
2198
return result;
2257
2199
}
2258
2200
2259
String *defmethod_lambda_list(Node* overload) {
2201
String *defmethod_lambda_list(Node *overload) {
2260
2202
String *result = NewString("");
2261
2203
2262
2204
ParmList *parms = Getattr(overload, "wrap:parms");
2263
2205
Parm *p;
2264
2206
int a;
2265
2266
for (a=0, p=parms; p; p=nextSibling(p),++a) {
2267
if (a!=0) Printf(result, " ");
2207
2208
for (a = 0, p = parms; p; p = nextSibling(p), ++a) {
2209
if (a != 0)
2210
Printf(result, " ");
2268
2211
Printf(result, "(arg%d ", a);
2269
2212
Printf(result, "%s", dispatching_type(p));
2270
2213
Printf(result, ")");
2273
2216
return result;
2274
2217
}
2275
2218
2276
int ALLEGROCL :: emit_dispatch_defun(Node *n) {
2219
int ALLEGROCL::emit_dispatch_defun(Node *n) {
2277
2220
#ifdef ALLEGROCL_WRAP_DEBUG
2278
Printf(stderr,"emit_dispatch_defun: ENTER... ");
2221
Printf(stderr, "emit_dispatch_defun: ENTER... ");
2279
2222
#endif
2280
List *overloads = Swig_overload_rank(n,true);
2223
List *overloads = Swig_overload_rank(n, true);
2281
2224
2282
2225
String *id_args = id_converter_arguments(n)->no_others_quoted_str();
2283
2226
Printf(f_clwrap, "(swig-dispatcher (%s :arities (", id_args);
2285
2228
int last_arity = -1;
2286
2229
for (Iterator i = First(overloads); i.item; i = Next(i)) {
2287
2230
int arity = emit_num_lin_arguments(Getattr(i.item, "wrap:parms"));
2288
if (arity == last_arity) continue;
2231
if (arity == last_arity)
2232
continue;
2289
2233
2290
2234
Printf(f_clwrap, "%s%d", last_arity == -1 ? "" : " ", arity);
2291
2235
2292
2236
last_arity = arity;
2293
2237
}
2294
2238
Printf(f_clwrap, ")))\n");
2295
2239
2296
2240
Delete(id_args);
2297
2241
Delete(overloads);
2298
2242
2299
2243
#ifdef ALLEGROCL_WRAP_DEBUG
2300
Printf(stderr,"emit_dispatch_defun: EXIT\n");
2244
Printf(stderr, "emit_dispatch_defun: EXIT\n");
2301
2245
#endif
2302
2246
2303
2247
return SWIG_OK;
2304
2248
}
2305
2249
2306
int ALLEGROCL :: emit_defun(Node *n, File *f_cl) {
2250
int ALLEGROCL::emit_defun(Node *n, File *f_cl) {
2307
2251
#ifdef ALLEGROCL_WRAP_DEBUG
2308
Printf(stderr,"emit_defun: ENTER... ");
2252
Printf(stderr, "emit_defun: ENTER... ");
2309
2253
#endif
2310
2254
2311
2255
#ifdef ALLEGROCL_DEBUG
2312
2256
int auto_generated = Cmp(Getattr(n, "view"), "globalfunctionHandler");
2313
Printf(stderr, "%s%sfunction %s%s%s\n",
2314
auto_generated ? "> " : "", Getattr(n, "sym:overloaded")
2315
? "overloaded " : "", current_namespace,
2316
(current_namespace) > 0 ? "::" : "", Getattr(n, "sym:name"));
2257
Printf(stderr, "%s%sfunction %s%s%s\n", auto_generated ? "> " : "", Getattr(n, "sym:overloaded")
2258
? "overloaded " : "", current_namespace, (current_namespace) > 0 ? "::" : "", Getattr(n, "sym:name"));
2317
2259
Printf(stderr, " (view: %s)\n", Getattr(n, "view"));
2318
2260
#endif
2319
2261
2320
2262
String *funcname = Getattr(n, "allegrocl:old-sym:name");
2321
if (!funcname) funcname = Getattr(n, "sym:name");
2322
String *mangled_name = Getattr(n,"wrap:name");
2263
if (!funcname)
2264
funcname = Getattr(n, "sym:name");
2265
String *mangled_name = Getattr(n, "wrap:name");
2323
2266
ParmList *pl = parmlist_with_names(Getattr(n, "wrap:parms"));
2324
2267
2325
2268
// attach typemap info.
2326
2269
Wrapper *wrap = NewWrapper();
2327
2270
Swig_typemap_attach_parms("lin", pl, wrap);
2328
Swig_typemap_lookup_new("lout",n,"result",0);
2271
Swig_typemap_lookup_new("lout", n, "result", 0);
2329
2272
2330
SwigType *result_type = Swig_cparse_type(Getattr(n,"tmap:ctype"));
2273
SwigType *result_type = Swig_cparse_type(Getattr(n, "tmap:ctype"));
2331
2274
// prime the pump, with support for OUTPUT, INOUT typemaps.
2332
Printf(wrap->code,"(let ((ACL_ffresult swig:*void*)\n ACL_result)\n $body\n (if (eq ACL_ffresult swig:*void*)\n (values-list ACL_result)\n (values-list (cons ACL_ffresult ACL_result))))");
2275
Printf(wrap->code,
2276
"(cl::let ((ACL_ffresult %s:*void*)\n ACL_result)\n $body\n (cl::if (cl::eq ACL_ffresult %s:*void*)\n (cl::values-list ACL_result)\n (cl::values-list (cl::cons ACL_ffresult ACL_result))))",
2277
swig_package, swig_package);
2333
2278
2334
2279
Parm *p;
2335
int largnum = 0, argnum=0, first=1;
2280
int largnum = 0, argnum = 0, first = 1;
2336
2281
// int varargs=0;
2337
if (Generate_Wrapper)
2338
{
2282
if (Generate_Wrapper) {
2339
2283
String *extra_parms = id_converter_arguments(n)->noname_str();
2340
2284
if (Getattr(n, "sym:overloaded"))
2341
Printf(f_cl, "(swig-defmethod (\"%s\" \"%s\"%s)\n",
2342
funcname, mangled_name, extra_parms);
2285
Printf(f_cl, "(swig-defmethod (\"%s\" \"%s\"%s)\n", funcname, mangled_name, extra_parms);
2343
2286
else
2344
Printf(f_cl, "(swig-defun (\"%s\" \"%s\"%s)\n",
2345
funcname, mangled_name, extra_parms);
2287
Printf(f_cl, "(swig-defun (\"%s\" \"%s\"%s)\n", funcname, mangled_name, extra_parms);
2346
2288
Delete(extra_parms);
2347
2289
}
2348
2290
// Just C
2349
else
2350
{
2351
Printf(f_cl, "(swig-defun (\"%s\" \"%s\")\n", funcname,
2352
Generate_Wrapper ? mangled_name : funcname);
2291
else {
2292
Printf(f_cl, "(swig-defun (\"%s\" \"%s\")\n", funcname, Generate_Wrapper ? mangled_name : funcname);
2353
2293
}
2354
2294
2355
2295
//////////////////////////////////////
2358
2298
Printf(f_cl, " (");
2359
2299
2360
2300
/* Special cases */
2361
2301
2362
2302
if (ParmList_len(pl) == 0) {
2363
2303
Printf(f_cl, ":void");
2364
2304
/* } else if (any_varargs(pl)) {
2367
2307
} else {
2368
2308
String *largs = NewString("");
2369
2309
2370
for (p=pl; p; p=nextSibling(p), argnum++, largnum++) {
2310
for (p = pl; p; p = nextSibling(p), argnum++, largnum++) {
2371
2311
// SwigType *argtype=Getattr(p, "type");
2372
SwigType *argtype = Swig_cparse_type(Getattr(p,"tmap:ctype"));
2312
SwigType *argtype = Swig_cparse_type(Getattr(p, "tmap:ctype"));
2373
2313
2374
2314
if (!first) {
2375
2315
Printf(f_cl, "\n ");
2376
2316
}
2377
2317
2378
if(SwigType_isvarargs(argtype)) {
2379
Printf(stderr, "Function %s (line %d) contains varargs, which is not directly supported. Use %varargs instead.\n", Getattr(n,"name"), Getline(n));
2318
if (SwigType_isvarargs(argtype)) {
2319
Printf(stderr, "Function %s (line %d) contains varargs, which is not directly supported. Use %varargs instead.\n", Getattr(n, "name"), Getline(n));
2380
2320
} else {
2381
String *argname=NewStringf("PARM%d_%s", largnum, Getattr(p, "name"));
2321
String *argname = NewStringf("PARM%d_%s", largnum, Getattr(p, "name"));
2382
2322
2383
2323
String *ffitype = compose_foreign_type(argtype);
2384
2324
String *deref_ffitype;
2385
2325
String *temp = Copy(argtype);
2386
2326
2387
if(SwigType_ispointer(temp)) {
2327
if (SwigType_ispointer(temp)) {
2388
2328
SwigType_pop(temp);
2389
2329
deref_ffitype = compose_foreign_type(temp);
2390
2330
} else {
2394
2334
Delete(temp);
2395
2335
2396
2336
// String *lisptype=get_lisp_type(argtype, argname);
2397
String *lisptype=get_lisp_type(Getattr(p,"type"), Getattr(p,"name"));
2398
2337
String *lisptype = get_lisp_type(Getattr(p, "type"), Getattr(p, "name"));
2338
2399
2339
#ifdef ALLEGROCL_DEBUG
2400
Printf(stderr,"lisptype of '%s' '%s' = '%s'\n", Getattr(p,"type"), Getattr(p,"name"), lisptype);
2340
Printf(stderr, "lisptype of '%s' '%s' = '%s'\n", Getattr(p, "type"), Getattr(p, "name"), lisptype);
2401
2341
#endif
2402
2342
2403
2343
// while we're walking the parameters, generating LIN
2404
2344
// wrapper code...
2405
Setattr(p,"lname",NewStringf("SWIG_arg%d", largnum));
2345
Setattr(p, "lname", NewStringf("SWIG_arg%d", largnum));
2406
2346
2407
String *parm_code = Getattr(p,"tmap:lin");
2347
String *parm_code = Getattr(p, "tmap:lin");
2408
2348
if (parm_code) {
2409
String *lname = Getattr(p,"lname");
2349
String *lname = Getattr(p, "lname");
2410
2350
2411
Printf(largs," %s",lname);
2412
Replaceall(parm_code,"$in", argname);
2413
Replaceall(parm_code,"$out", lname);
2414
Replaceall(parm_code,"$in_fftype", ffitype);
2415
Replaceall(parm_code,"$*in_fftype", deref_ffitype);
2416
Replaceall(wrap->code,"$body", parm_code);
2351
Printf(largs, " %s", lname);
2352
Replaceall(parm_code, "$in", argname);
2353
Replaceall(parm_code, "$out", lname);
2354
Replaceall(parm_code, "$in_fftype", ffitype);
2355
Replaceall(parm_code, "$*in_fftype", deref_ffitype);
2356
Replaceall(wrap->code, "$body", parm_code);
2417
2357
}
2418
2419
String *dispatchtype=Getattr(n, "sym:overloaded") ?
2420
dispatching_type(p) :
2421
NewString("");
2358
2359
String *dispatchtype = Getattr(n, "sym:overloaded") ? dispatching_type(p) : NewString("");
2422
2360
2423
2361
// if this parameter has been removed from the C/++ wrapper
2424
2362
// it shouldn't be in the lisp wrapper either.
2425
if(!checkAttribute(p,"tmap:in:numinputs","0")) {
2426
Printf(f_cl, "(%s %s %s %s %s)",
2363
if (!checkAttribute(p, "tmap:in:numinputs", "0")) {
2364
Printf(f_cl, "(%s %s %s %s %s)",
2427
2365
// parms in the ff wrapper, but not in the lisp wrapper.
2428
(checkAttribute(p,"tmap:lin:numinputs","0") ? ":p-" : ":p+"),
2429
argname, dispatchtype, ffitype, lisptype);
2430
2431
first=0;
2366
(checkAttribute(p, "tmap:lin:numinputs", "0") ? ":p-" : ":p+"), argname, dispatchtype, ffitype, lisptype);
2367
2368
first = 0;
2432
2369
}
2433
2370
2434
2371
Delete(ffitype);
2436
2373
}
2437
2374
}
2438
2375
2439
Printf(wrap->locals,"%s",largs);
2376
Printf(wrap->locals, "%s", largs);
2440
2377
}
2441
2378
2442
String *lout = Getattr(n,"tmap:lout");
2443
Replaceall(wrap->code,"$body", lout);
2379
String *lout = Getattr(n, "tmap:lout");
2380
Replaceall(lout, "$owner", GetFlag(n, "feature:new") ? "t" : "nil");
2381
2382
Replaceall(wrap->code, "$body", lout);
2444
2383
// $lclass handling.
2445
String *lclass = (String *)0;
2446
SwigType *parsed = Swig_cparse_type(Getattr(n,"tmap:ctype"));
2384
String *lclass = (String *) 0;
2385
SwigType *parsed = Swig_cparse_type(Getattr(n, "tmap:ctype"));
2447
2386
// SwigType *cl_t = SwigType_typedef_resolve_all(parsed);
2448
2387
SwigType *cl_t = class_from_class_or_class_ref(parsed);
2388
String *out_ffitype = compose_foreign_type(parsed);
2389
String *deref_out_ffitype;
2390
String *out_temp = Copy(parsed);
2391
2392
if (SwigType_ispointer(out_temp)) {
2393
SwigType_pop(out_temp);
2394
deref_out_ffitype = compose_foreign_type(out_temp);
2395
} else {
2396
deref_out_ffitype = Copy(out_ffitype);
2397
}
2398
2399
Delete(out_temp);
2400
2449
2401
Delete(parsed);
2450
2402
int isPtrReturn = 0;
2451
2403
2452
if(cl_t) {
2404
if (cl_t) {
2453
2405
lclass = lookup_defined_foreign_ltype(cl_t);
2454
2406
isPtrReturn = 1;
2455
2407
}
2456
2457
2408
// if (SwigType_ispointer(cl_t)) {
2458
2409
// isPtrReturn = 1;
2459
2410
// SwigType_pop(cl_t);
2461
2412
// }
2462
2413
2463
2414
int ff_foreign_ptr = 0;
2464
if(!lclass) {
2415
if (!lclass) {
2465
2416
ff_foreign_ptr = 1;
2466
2417
lclass = NewStringf("ff:foreign-pointer");
2467
2418
}
2468
2469
2419
#ifdef ALLEGROCL_WRAP_DEBUG
2470
Printf(stderr,"for output wrapping %s: type=%s, ctype=%s\n",
2471
Getattr(n,"name"), Getattr(n,"type"),
2472
Swig_cparse_type(Getattr(n,"tmap:ctype")));
2473
#endif
2474
2475
if(lclass) Replaceall(wrap->code,"$lclass", lclass);
2476
2420
Printf(stderr, "for output wrapping %s: type=%s, ctype=%s\n", Getattr(n, "name"), Getattr(n, "type"), Swig_cparse_type(Getattr(n, "tmap:ctype")));
2421
#endif
2422
2423
if (lclass)
2424
Replaceall(wrap->code, "$lclass", lclass);
2425
if (out_ffitype)
2426
Replaceall(wrap->code, "$out_fftype", out_ffitype);
2427
if (deref_out_ffitype)
2428
Replaceall(wrap->code, "$*out_fftype", deref_out_ffitype);
2477
2429
// if(Replaceall(wrap->code,"$lclass", lclass) && !isPtrReturn) {
2478
2430
// Swig_warning(WARN_LANG_RETURN_TYPE,Getfile(n), Getline(n),
2479
2431
// "While Wrapping %s, replaced a $lclass reference when return type is non-pointer %s!\n",
2480
2432
// Getattr(n,"name"), cl_t);
2481
2433
// }
2482
2434
2483
Replaceall(wrap->code,"$body", NewStringf("(swig-ff-call%s)", wrap->locals));
2435
Replaceall(wrap->code, "$body", NewStringf("(swig-ff-call%s)", wrap->locals));
2484
2436
// Replaceall(wrap->code,"$body",
2485
// (!Strcmp(result_type,"void") ?
2486
// NewStringf("(swig-ff-call%s)", wrap->locals) :
2487
// NewStringf("(push (swig-ff-call%s) ACL_result)", wrap->locals)));
2488
String* ldestructor = Copy(lclass);
2437
// (!Strcmp(result_type,"void") ?
2438
// NewStringf("(swig-ff-call%s)", wrap->locals) :
2439
// NewStringf("(push (swig-ff-call%s) ACL_result)", wrap->locals)));
2440
String *ldestructor = Copy(lclass);
2489
2441
if (ff_foreign_ptr)
2490
2442
Replaceall(ldestructor, ldestructor, "identity");
2491
2443
else
2492
2444
Replaceall(ldestructor, ":type :class", ":type :destructor");
2493
if (Replaceall(wrap->code,"$ldestructor", ldestructor) > 0 &&
2494
ff_foreign_ptr) {
2445
if (Replaceall(wrap->code, "$ldestructor", ldestructor) > 0 && ff_foreign_ptr) {
2495
2446
Swig_warning(WARN_LANG_RETURN_TYPE, Getfile(n), Getline(n),
2496
"While wrapping %s, replaced an $ldestructor reference "
2497
"when there was no Lisp class.\n",
2498
Getattr(n,"name"));
2447
"While wrapping %s, replaced an $ldestructor reference " "when there was no Lisp class.\n", Getattr(n, "name"));
2499
2448
}
2500
2449
Delete(ldestructor);
2501
2502
Printf(f_cl, ")\n"); /* finish arg list */
2450
2451
Printf(f_cl, ")\n"); /* finish arg list */
2503
2452
2504
2453
/////////////////////////////////////////////////////
2505
2454
// Lisp foreign call return type and optimizations //
2506
2455
/////////////////////////////////////////////////////
2507
Printf(f_cl, " (:returning (%s %s)",
2508
compose_foreign_type(result_type),
2509
get_lisp_type(Getattr(n, "type"), "result"));
2510
2456
Printf(f_cl, " (:returning (%s %s)", compose_foreign_type(result_type), get_lisp_type(Getattr(n, "type"), "result"));
2457
2511
2458
for (Iterator option = First(n); option.item; option = Next(option)) {
2512
if (Strncmp("feature:ffargs:", option.key, 15)) continue;
2459
if (Strncmp("feature:ffargs:", option.key, 15))
2460
continue;
2513
2461
String *option_val = option.item;
2514
2462
String *option_name = NewString(Char(option.key) + 14);
2515
2463
Replaceall(option_name, "_", "-");
2516
2464
2517
2465
// TODO: varargs vs call-direct ?
2518
2466
Printf(f_cl, "\n %s %s", option_name, option_val);
2519
2467
2520
2468
Delete(option_name);
2521
2469
}
2522
2470
2523
Printf(f_cl,")\n %s)\n\n", wrap->code);
2471
Printf(f_cl, ")\n %s)\n\n", wrap->code);
2524
2472
// Wrapper_print(wrap, stderr);
2525
2473
2526
2474
Delete(result_type);
2528
2476
Delete(pl);
2529
2477
2530
2478
#ifdef ALLEGROCL_WRAP_DEBUG
2531
Printf(stderr,"emit_defun: EXIT\n");
2479
Printf(stderr, "emit_defun: EXIT\n");
2532
2480
#endif
2533
2481
2534
2482
return SWIG_OK;
2535
2483
}
2536
2484
2537
int ALLEGROCL :: functionWrapper(Node *n) {
2485
int ALLEGROCL::functionWrapper(Node *n) {
2538
2486
2539
ParmList *parms = CopyParmList(Getattr(n,"parms"));
2487
ParmList *parms = CopyParmList(Getattr(n, "parms"));
2540
2488
Wrapper *wrap = NewWrapper();
2541
2489
2542
String *raw_return_type = Swig_typemap_lookup_new("ctype",n,"",0);
2490
String *raw_return_type = Swig_typemap_lookup_new("ctype", n, "", 0);
2543
2491
SwigType *return_type = Swig_cparse_type(raw_return_type);
2544
2492
SwigType *resolved = SwigType_typedef_resolve_all(return_type);
2545
2493
int is_void_return = (Cmp(resolved, "void") == 0);
2546
2494
Delete(resolved);
2547
if (!is_void_return)
2548
{
2495
if (!is_void_return) {
2549
2496
String *lresult_init = NewStringf("lresult = (%s)0", raw_return_type);
2550
Wrapper_add_localv(wrap,"lresult", raw_return_type, lresult_init, NIL);
2497
Wrapper_add_localv(wrap, "lresult", raw_return_type, lresult_init, NIL);
2551
2498
Delete(lresult_init);
2552
2499
}
2553
2554
2500
// Emit all of the local variables for holding arguments.
2555
2501
emit_args(Getattr(n, "type"), parms, wrap);
2556
2502
2560
2506
emit_attach_parmmaps(parms, wrap);
2561
2507
2562
2508
String *mangled = mangle_name(n);
2563
Node *overloaded = Getattr(n,"sym:overloaded");
2509
Node *overloaded = Getattr(n, "sym:overloaded");
2564
2510
2565
2511
// Parameter overloading
2566
Setattr(n,"wrap:parms", parms);
2567
Setattr(n,"wrap:name", mangled);
2512
Setattr(n, "wrap:parms", parms);
2513
Setattr(n, "wrap:name", mangled);
2568
2514
2569
2515
if (overloaded) {
2570
2516
// emit warnings when overloading is impossible on the lisp side.
2574
2520
if (Getattr(n, "overload:ignore")) {
2575
2521
// if we're the last overload, make sure to force the emit
2576
2522
// of the rest of the overloads before we leave.
2577
Printf(stderr, "ignored overload %s(%x)\n", Getattr(n,"name"),
2578
Getattr(n,"sym:nextSibling"));
2579
if(!Getattr(n,"sym:nextSibling")) {
2523
Printf(stderr, "ignored overload %s(%x)\n", Getattr(n, "name"), Getattr(n, "sym:nextSibling"));
2524
if (!Getattr(n, "sym:nextSibling")) {
2580
2525
update_package_if_needed(n);
2581
emit_buffered_defuns(n);
2582
emit_dispatch_defun(n);
2526
emit_buffered_defuns(n);
2527
emit_dispatch_defun(n);
2583
2528
}
2584
2529
return SWIG_OK;
2585
2530
}
2586
2531
}
2587
2588
2532
// Get number of required and total arguments
2589
2533
int num_arguments = emit_num_arguments(parms);
2590
2534
int gencomma = 0;
2591
2535
2592
2536
#ifdef ALLEGROCL_DEBUG
2593
Printf(stderr,"Walking parameters for %s '%s'\n", Getattr(n,"allegrocl:kind"), Getattr(n,"name"));
2537
Printf(stderr, "Walking parameters for %s '%s'\n", Getattr(n, "allegrocl:kind"), Getattr(n, "name"));
2594
2538
#endif
2595
2539
// Now walk the function parameter list and generate code to get arguments
2596
2540
String *name_and_parms = NewStringf("%s (", mangled);
2597
int i; Parm *p;
2598
for (i = 0, p=parms; i < num_arguments; i++) {
2541
int i;
2542
Parm *p;
2543
for (i = 0, p = parms; i < num_arguments; i++) {
2599
2544
2600
while (p && checkAttribute(p,"tmap:in:numinputs","0")) {
2601
p = Getattr(p,"tmap:in:next");
2545
while (p && checkAttribute(p, "tmap:in:numinputs", "0")) {
2546
p = Getattr(p, "tmap:in:next");
2602
2547
}
2603
2548
2604
if(!p) break;
2549
if (!p)
2550
break;
2605
2551
2606
2552
SwigType *c_parm_type = Swig_cparse_type(Getattr(p, "tmap:ctype"));
2607
String *arg = NewStringf("l%s", Getattr(p,"lname"));
2553
String *arg = NewStringf("l%s", Getattr(p, "lname"));
2608
2554
2609
2555
// Emit parameter declaration
2610
if (gencomma) Printf(name_and_parms, ", ");
2556
if (gencomma)
2557
Printf(name_and_parms, ", ");
2611
2558
String *parm_decl = SwigType_str(c_parm_type, arg);
2612
2559
Printf(name_and_parms, "%s", parm_decl);
2613
2560
#ifdef ALLEGROCL_DEBUG
2614
Printf(stderr," param: %s\n", parm_decl);
2561
Printf(stderr, " param: %s\n", parm_decl);
2615
2562
#endif
2616
2563
Delete(parm_decl);
2617
2564
gencomma = 1;
2618
2565
2619
2566
// Emit parameter conversion code
2620
String *parm_code = Getattr(p,"tmap:in");
2567
String *parm_code = Getattr(p, "tmap:in");
2621
2568
//if (!parm_code) {
2622
2569
// Swig_warning(...);
2623
2570
// p = nextSibling(p);
2624
/*} else*/ {
2571
/*} else */ {
2625
2572
// canThrow(n, "in", p);
2626
Replaceall(parm_code,"$input", arg);
2627
Setattr(p,"emit:input", arg);
2628
Printf(wrap->code,"%s\n", parm_code);
2629
p = Getattr(p,"tmap:in:next");
2573
Replaceall(parm_code, "$input", arg);
2574
Setattr(p, "emit:input", arg);
2575
Printf(wrap->code, "%s\n", parm_code);
2576
p = Getattr(p, "tmap:in:next");
2630
2577
}
2631
2578
2632
2579
Delete(arg);
2633
2580
}
2634
2581
Printf(name_and_parms, ")");
2637
2584
String *signature = SwigType_str(return_type, name_and_parms);
2638
2585
Printf(wrap->def, "EXPORT %s {", signature);
2639
2586
if (CPlusPlus)
2640
Printf(wrap->code," try {\n");
2587
Printf(wrap->code, " try {\n");
2641
2588
emit_action(n, wrap);
2642
if (!is_void_return)
2643
{
2644
String *result_convert = Swig_typemap_lookup_new("out",n,"result",0);
2589
if (!is_void_return) {
2590
String *result_convert = Swig_typemap_lookup_new("out", n, "result", 0);
2645
2591
Replaceall(result_convert, "$result", "lresult");
2646
2592
Printf(wrap->code, "%s\n", result_convert);
2647
2593
Printf(wrap->code, " return lresult;\n");
2648
2594
Delete(result_convert);
2649
2595
}
2650
2596
if (CPlusPlus) {
2651
Printf(wrap->code," } catch (...) {\n");
2597
Printf(wrap->code, " } catch (...) {\n");
2652
2598
if (!is_void_return)
2653
Printf(wrap->code," return (%s)0;\n", raw_return_type);
2654
Printf(wrap->code," }\n");
2599
Printf(wrap->code, " return (%s)0;\n", raw_return_type);
2600
Printf(wrap->code, " }\n");
2655
2601
}
2656
Printf(wrap->code,"}\n");
2602
Printf(wrap->code, "}\n");
2657
2603
2658
2604
/* print this when in C mode? make this a command-line arg? */
2659
if (Generate_Wrapper)
2605
if (Generate_Wrapper)
2660
2606
Wrapper_print(wrap, f_cxx);
2661
2607
2662
String *f_buffer = NewString("");
2663
2664
emit_defun(n,f_buffer);
2665
Setattr(n,"allegrocl:lisp-wrap",f_buffer);
2608
String *f_buffer = NewString("");
2609
2610
emit_defun(n, f_buffer);
2611
Setattr(n, "allegrocl:lisp-wrap", f_buffer);
2666
2612
2667
2613
if (!overloaded || !Getattr(n, "sym:nextSibling")) {
2668
2614
update_package_if_needed(n);
2676
2622
return SWIG_OK;
2677
2623
}
2678
2624
2679
int ALLEGROCL :: namespaceDeclaration(Node *n) {
2625
int ALLEGROCL::namespaceDeclaration(Node *n) {
2680
2626
// Empty namespaces are not worth DEFPACKAGEing.
2681
2627
// Swig_print_node(n);
2682
2628
#ifdef ALLEGROCL_DEBUG
2683
2629
Printf(stderr, "namespaceDecl: '%s'(0x%x) (fc=0x%x)\n", Getattr(n, "sym:name"), n, firstChild(n));
2684
2630
#endif
2685
2631
2686
if (!firstChild(n)) return SWIG_OK;
2687
2688
String *name=Getattr(n, "sym:name");
2632
if (!firstChild(n))
2633
return SWIG_OK;
2634
2635
String *name = Getattr(n, "sym:name");
2689
2636
2690
2637
String *old_namespace = current_namespace;
2691
2638
if (Cmp(current_namespace, "") == 0)
2693
2640
else
2694
2641
current_namespace = NewStringf("%s::%s", current_namespace, name);
2695
2642
2696
if (!GetInt(defined_namespace_packages, current_namespace))
2697
{
2643
if (!GetInt(defined_namespace_packages, current_namespace)) {
2698
2644
SetInt(defined_namespace_packages, current_namespace, 1);
2699
2645
String *lispy_namespace = listify_namespace(current_namespace);
2700
2646
Printf(f_clhead, "(swig-defpackage %s)\n", lispy_namespace);
2708
2654
return SWIG_OK;
2709
2655
}
2710
2656
2711
int ALLEGROCL :: constructorHandler(Node *n)
2712
{
2657
int ALLEGROCL::constructorHandler(Node *n) {
2713
2658
#ifdef ALLEGROCL_DEBUG
2714
2659
Printf(stderr, "constructor %s\n", Getattr(n, "name"));
2715
2660
#endif
2716
2661
// Swig_print_node(n);
2717
2662
Setattr(n, "allegrocl:kind", "constructor");
2718
2663
Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
2719
2664
2720
2665
// Let SWIG generate a global forwarding function.
2721
2666
return Language::constructorHandler(n);
2722
2667
}
2723
2668
2724
int ALLEGROCL :: destructorHandler(Node *n)
2725
{
2669
int ALLEGROCL::destructorHandler(Node *n) {
2726
2670
#ifdef ALLEGROCL_DEBUG
2727
2671
Printf(stderr, "destructor %s\n", Getattr(n, "name"));
2728
2672
#endif
2729
2673
2730
2674
Setattr(n, "allegrocl:kind", "destructor");
2731
2675
Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
2732
2676
2733
2677
// Let SWIG generate a global forwarding function.
2734
2678
return Language::destructorHandler(n);
2735
2679
}
2736
2680
2737
int ALLEGROCL :: constantWrapper(Node *n) {
2681
int ALLEGROCL::constantWrapper(Node *n) {
2738
2682
2739
2683
#ifdef ALLEGROCL_DEBUG
2740
2684
Printf(stderr, "constant %s\n", Getattr(n, "name"));
2741
2685
#endif
2742
2686
2743
if(Generate_Wrapper) {
2687
if (Generate_Wrapper) {
2744
2688
// Setattr(n,"wrap:name",mangle_name(n, "ACLPP"));
2745
String *const_type = Getattr(n,"type");
2689
String *const_type = Getattr(n, "type");
2746
2690
2747
2691
String *const_val = 0;
2748
String *raw_const = Getattr(n,"value");
2692
String *raw_const = Getattr(n, "value");
2749
2693
2750
if(SwigType_type(const_type) == T_STRING) {
2751
const_val = NewStringf("\"%s\"",raw_const);
2694
if (SwigType_type(const_type) == T_STRING) {
2695
const_val = NewStringf("\"%s\"", raw_const);
2752
2696
} else if (SwigType_type(const_type) == T_CHAR) {
2753
const_val = NewStringf("'%s'",raw_const);
2697
const_val = NewStringf("'%s'", raw_const);
2754
2698
} else {
2755
2699
const_val = Copy(raw_const);
2756
2700
}
2757
2701
2758
SwigType_add_qualifier(const_type,"const");
2759
SwigType_add_qualifier(const_type,"static");
2760
2761
String *ppcname = NewStringf("ACLppc_%s",Getattr(n,"name"));
2762
Printf(f_cxx,"static const %s = %s;\n", SwigType_lstr(const_type,ppcname),
2763
const_val);
2764
2765
Setattr(n,"name",ppcname);
2766
SetFlag(n,"feature:immutable");
2702
SwigType_add_qualifier(const_type, "const");
2703
SwigType_add_qualifier(const_type, "static");
2704
2705
String *ppcname = NewStringf("ACLppc_%s", Getattr(n, "name"));
2706
Printf(f_cxx, "static const %s = %s;\n", SwigType_lstr(const_type, ppcname), const_val);
2707
2708
Setattr(n, "name", ppcname);
2709
SetFlag(n, "feature:immutable");
2767
2710
2768
2711
Delete(const_val);
2769
2712
return variableWrapper(n);
2770
2713
}
2771
2714
2772
String *type=Getattr(n, "type");
2773
String *value = Getattr(n,"value");
2774
String *converted_value=convert_literal(value, type);
2775
String *name=Getattr(n, "sym:name");
2715
String *type = Getattr(n, "type");
2716
String *value = Getattr(n, "value");
2717
String *converted_value = convert_literal(value, type);
2718
String *name = Getattr(n, "sym:name");
2776
2719
2777
2720
Setattr(n, "allegrocl:kind", "constant");
2778
2721
Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
2779
2722
2780
2723
#if 0
2781
Printf(stdout, "constant %s is of type %s. value: %s\n",
2782
name, type, converted_value);
2724
Printf(stdout, "constant %s is of type %s. value: %s\n", name, type, converted_value);
2783
2725
#endif
2784
2726
2785
if(converted_value) {
2786
Printf(f_clwrap, "(swig-defconstant \"%s\" %s)\n",
2787
name, converted_value);
2727
if (converted_value) {
2728
Printf(f_clwrap, "(swig-defconstant \"%s\" %s)\n", name, converted_value);
2788
2729
} else {
2789
Swig_warning(WARN_LANG_DISCARD_CONST, Getfile(n), Getline(n),
2790
"Unable to parse constant value '%s'. Setting to NIL\n", value);
2730
Swig_warning(WARN_LANG_DISCARD_CONST, Getfile(n), Getline(n), "Unable to parse constant value '%s'. Setting to NIL\n", value);
2791
2731
Printf(f_clwrap, "(swig-defconstant \"%s\" nil #| %s |#)\n", name, value);
2792
2732
}
2793
2733
2794
2734
Delete(converted_value);
2795
2735
2796
2736
return SWIG_OK;
2797
2737
}
2798
2738
2799
int ALLEGROCL :: globalvariableHandler(Node *n) {
2800
if(Generate_Wrapper) return Language::globalvariableHandler(n);
2739
int ALLEGROCL::globalvariableHandler(Node *n) {
2740
if (Generate_Wrapper)
2741
return Language::globalvariableHandler(n);
2801
2742
2802
2743
// String *name = Getattr(n, "name");
2803
SwigType *type = Getattr(n,"type");
2744
SwigType *type = Getattr(n, "type");
2804
2745
SwigType *ctype;
2805
2746
SwigType *rtype = SwigType_typedef_resolve_all(type);
2806
2747
2807
2748
int pointer_added = 0;
2808
2749
2809
if(SwigType_isclass(rtype)) {
2750
if (SwigType_isclass(rtype)) {
2810
2751
SwigType_add_pointer(type);
2811
2752
SwigType_add_pointer(rtype);
2812
2753
pointer_added = 1;
2813
2754
}
2814
2755
2815
ctype = SwigType_str(type,0);
2756
ctype = SwigType_str(type, 0);
2816
2757
// EXPORT <SwigType_str> <mangled_name>;
2817
2758
// <SwigType_str> <mangled_name> = <name>;
2818
2759
// Printf(f_cxx, "EXPORT %s %s;\n%s %s = %s%s;\n", ctype, mangled_name,
2819
// ctype, mangled_name, (pointer_added ? "&" : ""), name);
2760
// ctype, mangled_name, (pointer_added ? "&" : ""), name);
2820
2761
2821
2762
Printf(f_clwrap, "(swig-defvar \"%s\" \"%s\" :type %s)\n",
2822
Getattr(n,"sym:name"), Getattr(n,"sym:name"),
2823
((SwigType_isconst(type)) ? ":constant" : ":variable"));
2763
Getattr(n, "sym:name"), Getattr(n, "sym:name"), ((SwigType_isconst(type)) ? ":constant" : ":variable"));
2824
2764
2825
2765
return SWIG_OK;
2826
2766
}
2827
2767
2828
int ALLEGROCL :: variableWrapper(Node *n) {
2768
int ALLEGROCL::variableWrapper(Node *n) {
2829
2769
#ifdef ALLEGROCL_DEBUG
2830
2770
Printf(stderr, "variable %s\n", Getattr(n, "name"));
2831
2771
#endif
2833
2773
Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
2834
2774
2835
2775
// Let SWIG generate a get/set function pair.
2836
if(Generate_Wrapper) return Language::variableWrapper(n);
2776
if (Generate_Wrapper)
2777
return Language::variableWrapper(n);
2837
2778
2838
2779
String *name = Getattr(n, "name");
2839
SwigType *type = Getattr(n,"type");
2780
SwigType *type = Getattr(n, "type");
2840
2781
SwigType *ctype;
2841
2782
SwigType *rtype = SwigType_typedef_resolve_all(type);
2842
2783
2844
2785
2845
2786
int pointer_added = 0;
2846
2787
2847
if(SwigType_isclass(rtype)) {
2788
if (SwigType_isclass(rtype)) {
2848
2789
SwigType_add_pointer(type);
2849
2790
SwigType_add_pointer(rtype);
2850
2791
pointer_added = 1;
2851
2792
}
2852
2793
2853
ctype = SwigType_str(type,0);
2794
ctype = SwigType_str(type, 0);
2854
2795
// EXPORT <SwigType_str> <mangled_name>;
2855
2796
// <SwigType_str> <mangled_name> = <name>;
2856
Printf(f_cxx, "EXPORT %s %s;\n%s %s = %s%s;\n", ctype, mangled_name,
2857
ctype, mangled_name, (pointer_added ? "&" : ""), name);
2797
Printf(f_cxx, "EXPORT %s %s;\n%s %s = %s%s;\n", ctype, mangled_name, ctype, mangled_name, (pointer_added ? "&" : ""), name);
2858
2798
2859
Printf(f_cl, "(swig-defvar \"%s\" :type %s)\n",
2860
mangled_name,
2861
((SwigType_isconst(type)) ? ":constant" : ":variable"));
2799
Printf(f_cl, "(swig-defvar \"%s\" :type %s)\n", mangled_name, ((SwigType_isconst(type)) ? ":constant" : ":variable"));
2862
2800
/*
2863
Printf(f_cxx, "// swigtype: %s\n", SwigType_typedef_resolve_all(Getattr(n,"type")));
2864
Printf(f_cxx, "// vwrap: %s\n", compose_foreign_type(SwigType_strip_qualifiers(Copy(rtype))));
2865
*/
2801
Printf(f_cxx, "// swigtype: %s\n", SwigType_typedef_resolve_all(Getattr(n,"type")));
2802
Printf(f_cxx, "// vwrap: %s\n", compose_foreign_type(SwigType_strip_qualifiers(Copy(rtype))));
2803
*/
2866
2804
2867
2805
Delete(mangled_name);
2868
2806
2869
2807
return SWIG_OK;
2870
2808
}
2871
2809
2872
int ALLEGROCL :: memberfunctionHandler(Node *n) {
2810
int ALLEGROCL::memberfunctionHandler(Node *n) {
2873
2811
#ifdef ALLEGROCL_DEBUG
2874
Printf(stderr, "member function %s::%s\n",
2875
Getattr(parent_node_skipping_extends(n), "name"), Getattr(n, "name"));
2812
Printf(stderr, "member function %s::%s\n", Getattr(parent_node_skipping_extends(n), "name"), Getattr(n, "name"));
2876
2813
#endif
2877
2814
Setattr(n, "allegrocl:kind", "member function");
2878
2815
Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
2881
2818
return Language::memberfunctionHandler(n);
2882
2819
}
2883
2820
2884
int ALLEGROCL :: membervariableHandler(Node *n) {
2821
int ALLEGROCL::membervariableHandler(Node *n) {
2885
2822
#ifdef ALLEGROCL_DEBUG
2886
Printf(stderr, "member variable %s::%s\n",
2887
Getattr(parent_node_skipping_extends(n), "name"), Getattr(n, "name"));
2823
Printf(stderr, "member variable %s::%s\n", Getattr(parent_node_skipping_extends(n), "name"), Getattr(n, "name"));
2888
2824
#endif
2889
2825
Setattr(n, "allegrocl:kind", "member variable");
2890
2826
Setattr(n, "allegrocl:old-sym:name", Getattr(n, "sym:name"));
2893
2829
return Language::membervariableHandler(n);
2894
2830
}
2895
2831
2896
int ALLEGROCL :: typedefHandler(Node *n) {
2832
int ALLEGROCL::typedefHandler(Node *n) {
2897
2833
2898
2834
#ifdef ALLEGROCL_TYPE_DEBUG
2899
Printf(stderr,"In typedefHAND\n");
2835
Printf(stderr, "In typedefHAND\n");
2900
2836
// Swig_print_node(n);
2901
#endif
2837
#endif
2902
2838
2903
2839
// has the side-effect of noting any implicit
2904
2840
// template instantiations in type.
2905
Delete(compose_foreign_type(Getattr(n,"type")));
2841
Delete(compose_foreign_type(Getattr(n, "type")));
2906
2842
2907
String *sym_name = Getattr(n,"sym:name");
2843
String *sym_name = Getattr(n, "sym:name");
2908
2844
2909
2845
String *name;
2910
2846
String *type_ref;
2911
2847
2912
if(in_class) {
2848
if (in_class) {
2913
2849
#ifdef ALLEGROCL_TYPE_DEBUG
2914
Printf(stderr, " typedef in class '%s'(%x)\n", Getattr(in_class,"sym:name"),in_class);
2915
#endif
2916
Setattr(n,"allegrocl:typedef:in-class",in_class);
2850
Printf(stderr, " typedef in class '%s'(%x)\n", Getattr(in_class, "sym:name"), in_class);
2851
#endif
2852
Setattr(n, "allegrocl:typedef:in-class", in_class);
2917
2853
}
2918
2854
2919
if(in_class) {
2920
String *class_name = Getattr(in_class,"name");
2921
name = NewStringf("%s__%s",class_name,sym_name);
2855
if (in_class) {
2856
String *class_name = Getattr(in_class, "name");
2857
name = NewStringf("%s__%s", class_name, sym_name);
2922
2858
type_ref = NewStringf("%s::%s", class_name, sym_name);
2923
Setattr(n,"allegrocl:in-class",in_class);
2859
Setattr(n, "allegrocl:in-class", in_class);
2924
2860
} else {
2925
2861
name = Copy(sym_name);
2926
type_ref = Copy(Getattr(n,"name"));
2862
type_ref = Copy(Getattr(n, "name"));
2927
2863
}
2928
2864
2929
Setattr(n,"allegrocl:namespace",current_namespace);
2865
Setattr(n, "allegrocl:namespace", current_namespace);
2930
2866
add_defined_foreign_type(n, 0, type_ref, name);
2931
2867
2932
2868
#ifdef ALLEGROCL_TYPE_DEBUG
2933
Printf(stderr,"Out typedefHAND\n");
2934
#endif
2869
Printf(stderr, "Out typedefHAND\n");
2870
#endif
2935
2871
2936
2872
return SWIG_OK;
2937
2873
}
2938
2874
2939
2875
// forward referenced classes are added specially to defined_foreign_types
2940
int ALLEGROCL :: classforwardDeclaration(Node *n) {
2876
int ALLEGROCL::classforwardDeclaration(Node *n) {
2941
2877
add_forward_referenced_type(n);
2942
2878
return SWIG_OK;
2943
2879
}
2944
2880
2945
int ALLEGROCL :: classHandler(Node *n) {
2881
int ALLEGROCL::classHandler(Node *n) {
2946
2882
#ifdef ALLEGROCL_DEBUG
2947
Printf(stderr, "class %s::%s\n", current_namespace,
2948
Getattr(n, "sym:name"));
2883
Printf(stderr, "class %s::%s\n", current_namespace, Getattr(n, "sym:name"));
2949
2884
#endif
2950
String *name=Getattr(n, "sym:name");
2951
String *kind = Getattr(n,"kind");
2952
2885
String *name = Getattr(n, "sym:name");
2886
String *kind = Getattr(n, "kind");
2887
2953
2888
// maybe just remove this check and get rid of the else clause below.
2954
if (Strcmp(kind, "struct") == 0 ||
2955
Strcmp(kind, "class") == 0 ||
2956
Strcmp(kind, "union") == 0)
2957
{
2889
if (Strcmp(kind, "struct") == 0 || Strcmp(kind, "class") == 0 || Strcmp(kind, "union") == 0) {
2958
2890
if (Generate_Wrapper)
2959
2891
return cppClassHandler(n);
2960
2892
else
2961
2893
return cClassHandler(n);
2962
}
2963
else
2964
{
2965
Printf(stderr, "Don't know how to deal with %s kind of class yet.\n",
2966
kind);
2894
} else {
2895
Printf(stderr, "Don't know how to deal with %s kind of class yet.\n", kind);
2967
2896
Printf(stderr, " (name: %s)\n", name);
2968
2897
SWIG_exit(EXIT_FAILURE);
2969
2898
return SWIG_OK;
2970
2899
}
2971
2900
2972
2901
return SWIG_OK;
2973
2902
}
2974
2903
2975
int ALLEGROCL :: cClassHandler(Node *n) {
2904
int ALLEGROCL::cClassHandler(Node *n) {
2976
2905
// String *cDeclName = Getattr(n,"classDeclaration:name");
2977
2906
// String *name= Getattr(n, "sym:name");
2978
2907
// String *kind = Getattr(n,"kind");
2983
2912
String *ns = listify_namespace(current_namespace);
2984
2913
2985
2914
#ifdef ALLEGROCL_TYPE_DEBUG
2986
Printf(stderr,"In cClassHAND\n");
2987
#endif
2915
Printf(stderr, "In cClassHAND\n");
2916
#endif
2988
2917
2989
2918
add_defined_foreign_type(n);
2990
2919
2991
2920
Delete(ns);
2992
2921
2993
2922
#ifdef ALLEGROCL_TYPE_DEBUG
2994
Printf(stderr,"Out cClassHAND\n");
2995
#endif
2923
Printf(stderr, "Out cClassHAND\n");
2924
#endif
2996
2925
2997
2926
return SWIG_OK;
2998
2927
}
2999
2928
3000
int ALLEGROCL :: cppClassHandler(Node *n) {
2929
int ALLEGROCL::cppClassHandler(Node *n) {
3001
2930
3002
2931
// String *name=Getattr(n, "sym:name");
3003
2932
// String *kind = Getattr(n,"kind");
3010
2939
3011
2940
The %template directive results in a templated class instantiation
3012
2941
that will actually be seen by <LANG> :: classHandler().
3013
2942
3014
2943
In this case, we don't want to error if the type already exists;
3015
2944
the point is to force the creation of wrappers for the templated
3016
2945
class.
3017
*/
3018
String *templated = Getattr(n,"template");
2946
*/
2947
String *templated = Getattr(n, "template");
3019
2948
String *t_name;
3020
2949
// String *ns = listify_namespace(current_namespace);
3021
2950
3022
if(templated) {
2951
if (templated) {
3023
2952
t_name = namespaced_name(n);
3024
2953
// t_name = Getattr(n,"name");
3025
2954
} else {
3026
t_name = Getattr(n,"name");
2955
t_name = Getattr(n, "name");
3027
2956
}
3028
2957
3029
Setattr(n,"allegrocl:namespace",current_namespace);
3030
2958
Setattr(n, "allegrocl:namespace", current_namespace);
2959
3031
2960
/* Add this structure to the known lisp types.
3032
2961
Class may contain references to the type currently being
3033
2962
defined */
3034
if(!templated || !lookup_defined_foreign_type(t_name)) {
2963
if (!templated || !lookup_defined_foreign_type(t_name)) {
3035
2964
#ifdef ALLEGROCL_CLASS_DEBUG
3036
Printf(stderr, "Adding %s foreign type\n", Getattr(n,"sym:name"));
3037
#endif
2965
Printf(stderr, "Adding %s foreign type\n", Getattr(n, "sym:name"));
2966
#endif
3038
2967
add_defined_foreign_type(n);
3039
2968
} else {
3040
2969
#ifdef ALLEGROCL_CLASS_DEBUG
3041
Printf(stderr, "cppClassHand: type %s already exists. Assuming %%template instantiation for wrapping purposes.\n", Getattr(n,"sym:name"));
2970
Printf(stderr, "cppClassHand: type %s already exists. Assuming %%template instantiation for wrapping purposes.\n", Getattr(n, "sym:name"));
3042
2971
#endif
3043
add_defined_foreign_type(n,1);
2972
add_defined_foreign_type(n, 1);
3044
2973
}
3045
2974
3046
2975
// mjb - for real fun, generate wrappers for class slot access.
3054
2983
#ifdef ALLEGROCL_CLASS_DEBUG
3055
2984
Printf(stderr, " MANUALLY walking class members... \n");
3056
2985
#endif
3057
for(c=firstChild(n); c; c=nextSibling(c)) {
2986
for (c = firstChild(n); c; c = nextSibling(c)) {
3058
2987
// ping the types of all children--even protected and private
3059
2988
// so their types can be added to the linked_type_list.
3060
SwigType *childType = NewStringf("%s%s", Getattr(c,"decl"),
3061
Getattr(c,"type"));
3062
if(!SwigType_isfunction(childType))
2989
SwigType *childType = NewStringf("%s%s", Getattr(c, "decl"),
2990
Getattr(c, "type"));
2991
if (!SwigType_isfunction(childType))
3063
2992
Delete(compose_foreign_type(childType));
3064
2993
3065
2994
Delete(childType);
3081
3010
return SWIG_OK;
3082
3011
}
3083
3012
3084
int ALLEGROCL :: emit_one(Node *n)
3085
{
3013
int ALLEGROCL::emit_one(Node *n) {
3086
3014
// When the current package does not correspond with the current
3087
3015
// namespace we need to generate an IN-PACKAGE form, unless the
3088
3016
// current node is another namespace node.
3089
if (Cmp(nodeType(n), "namespace") != 0 &&
3090
Cmp(current_package, current_namespace) != 0)
3091
{
3017
if (Cmp(nodeType(n), "namespace") != 0 && Cmp(current_package, current_namespace) != 0) {
3092
3018
String *lispy_namespace = listify_namespace(current_namespace);
3093
3019
Printf(f_clwrap, "(swig-in-package %s)\n", lispy_namespace);
3094
3020
Delete(lispy_namespace);
3096
3022
current_package = NewStringf("%s", current_namespace);
3097
3023
}
3098
3024
3099
Setattr(n,"allegrocl:package",current_package);
3025
Setattr(n, "allegrocl:package", current_package);
3100
3026
3101
3027
return Language::emit_one(n);
3102
3028
}
3103
3029
3104
int ALLEGROCL :: enumDeclaration(Node *n) {
3030
int ALLEGROCL::enumDeclaration(Node *n) {
3105
3031
3106
if(Getattr(n,"sym:name")) {
3032
if (Getattr(n, "sym:name")) {
3107
3033
add_defined_foreign_type(n);
3108
3034
}
3109
3035
Node *c;
3110
for(c = firstChild(n); c; c=nextSibling(c)) {
3036
for (c = firstChild(n); c; c = nextSibling(c)) {
3111
3037
ALLEGROCL::enumvalueDeclaration(c);
3112
3038
// since we walk our own children, we need to add
3113
3039
// the current package ourselves.
3114
Setattr(c,"allegrocl:package",current_package);
3040
Setattr(c, "allegrocl:package", current_package);
3115
3041
}
3116
3042
return SWIG_OK;
3117
3043
}
3118
3044
3119
3045
3120
int ALLEGROCL :: enumvalueDeclaration(Node *n) {
3046
int ALLEGROCL::enumvalueDeclaration(Node *n) {
3121
3047
3122
3048
/* print this when in C mode? make this a command-line arg? */
3123
3049
3124
if(Generate_Wrapper) {
3050
if (Generate_Wrapper) {
3125
3051
String *mangled_name = mangle_name(n, "ACL_ENUM");
3126
3052
3127
Printf(f_cxx, "EXPORT const %s %s = %s;\n", Getattr(n, "type"),
3128
mangled_name, Getattr(n, "value"));
3053
Printf(f_cxx, "EXPORT const %s %s = %s;\n", Getattr(n, "type"), mangled_name, Getattr(n, "value"));
3129
3054
3130
3055
Delete(mangled_name);
3131
3056
}
3133
3058
return SWIG_OK;
3134
3059
}
3135
3060
3136
int ALLEGROCL :: templateDeclaration(Node *n) {
3061
int ALLEGROCL::templateDeclaration(Node *n) {
3137
3062
3138
String *type = Getattr(n,"templatetype");
3063
String *type = Getattr(n, "templatetype");
3139
3064
3140
3065
// Printf(stderr, "tempDecl: %s %s\n", Getattr(n,"name"),
3141
3066
// type);
3142
3067
// Swig_print_node(n);
3143
3068
3144
if(!Strcmp(type,"cdecl")) {
3145
SwigType *ty = NewStringf("%s%s",Getattr(n,"decl"),
3146
Getattr(n,"type"));
3069
if (!Strcmp(type, "cdecl")) {
3070
SwigType *ty = NewStringf("%s%s", Getattr(n, "decl"),
3071
Getattr(n, "type"));
3147
3072
Delete(ty);
3148
3073
}
3149
3074
3150
3075
Delete(type);
3151
3076
3152
3077
return SWIG_OK;
Loggerhead is a web-based interface for Breezy
Version: 2.0.1