/trunk/Source/Modules/allegrocl.cxx
C++ | 2061 lines | 1514 code | 285 blank | 262 comment | 406 complexity | 56e85084a7a4afb78afa412910f3ad6e MD5 | raw file
Large files files are truncated, but you can click here to view the full file
1/* ----------------------------------------------------------------------------- 2 * This file is part of SWIG, which is licensed as a whole under version 3 3 * (or any later version) of the GNU General Public License. Some additional 4 * terms also apply to certain portions of SWIG. The full details of the SWIG 5 * license and copyrights can be found in the LICENSE and COPYRIGHT files 6 * included with the SWIG source code as distributed by the SWIG developers 7 * and at http://www.swig.org/legal.html. 8 * 9 * allegrocl.cxx 10 * 11 * ALLEGROCL language module for SWIG. 12 * ----------------------------------------------------------------------------- */ 13 14char cvsroot_allegrocl_cxx[] = "$Id: allegrocl.cxx 12830 2011-10-30 21:51:50Z wsfulton $"; 15 16#include "swigmod.h" 17#include "cparse.h" 18#include <ctype.h> 19 20// #define ALLEGROCL_DEBUG 21// #define ALLEGROCL_WRAP_DEBUG 22// #define ALLEGROCL_TYPE_DEBUG 23// #define ALLEGROCL_CLASS_DEBUG 24 25static const char *usage = (char *) "\ 26Allegro CL Options (available with -allegrocl)\n\ 27 -identifier-converter <type or funcname> - \n\ 28 Specifies the type of conversion to do on C identifiers to convert\n\ 29 them to symbols. There are two built-in converters: 'null' and\n\ 30 'lispify'. The default is 'null'. If you supply a name other\n\ 31 than one of the built-ins, then a function by that name will be\n\ 32 called to convert identifiers to symbols.\n\ 33 -[no]cwrap - Turn on or turn off generation of an intermediate C file when\n\ 34 creating a C interface. By default this is only done for C++ code.\n\ 35 -isolate - Define all SWIG helper functions in a package unique to this\n\ 36 module. Avoids redefinition warnings when loading multiple\n\ 37 SWIGged modules into the same running Allegro CL image.\n\ 38"; 39 40static File *f_cl = 0; 41String *f_clhead = NewString(""); 42String *f_clwrap = NewString("(swig-in-package ())\n\n"); 43static File *f_begin; 44static File *f_runtime; 45static File *f_cxx_header = 0; 46static File *f_cxx_wrapper = 0; 47 48static String *module_name = 0; 49static String *swig_package = 0; 50 51const char *identifier_converter = "identifier-convert-null"; 52 53static bool CWrap = true; // generate wrapper file for C code by default. most correct. 54static bool Generate_Wrapper = false; 55static bool unique_swig_package = false; 56 57static SwigType *fwdref_ffi_type = NewString("__SWIGACL_FwdReference"); 58 59static String *current_namespace = NewString(""); 60static String *current_package = NewString(""); 61static Hash *defined_namespace_packages = NewHash(); 62static Node *in_class = 0; 63 64static Node *first_linked_type = 0; 65static Hash *defined_foreign_types = NewHash(); 66static Hash *defined_foreign_ltypes = NewHash(); 67 68static String *anon_type_name = NewString("anontype"); 69static int anon_type_count = 0; 70 71// stub 72String *convert_literal(String *num_param, String *type, bool try_to_split = true); 73 74class ALLEGROCL:public Language { 75public: 76 virtual void main(int argc, char *argv[]); 77 virtual int top(Node *n); 78 virtual int functionWrapper(Node *n); 79 virtual int namespaceDeclaration(Node *n); 80 virtual int constructorHandler(Node *n); 81 virtual int destructorHandler(Node *n); 82 virtual int globalvariableHandler(Node *n); 83 virtual int variableWrapper(Node *n); 84 virtual int constantWrapper(Node *n); 85 virtual int memberfunctionHandler(Node *n); 86 virtual int membervariableHandler(Node *n); 87 virtual int classHandler(Node *n); 88 virtual int emit_one(Node *n); 89 virtual int enumDeclaration(Node *n); 90 virtual int enumvalueDeclaration(Node *n); 91 virtual int typedefHandler(Node *n); 92 virtual int classforwardDeclaration(Node *n); 93 virtual int templateDeclaration(Node *n); 94 virtual int validIdentifier(String *s); 95private: 96 int emit_defun(Node *n, File *f_cl); 97 int emit_dispatch_defun(Node *n); 98 int emit_buffered_defuns(Node *n); 99 int cClassHandler(Node *n); 100 int cppClassHandler(Node *n); 101}; 102static ALLEGROCL *allegrocl = 0; 103 104static String *trim(String *str) { 105 char *c = Char(str); 106 while (*c != '\0' && isspace((int) *c)) 107 ++c; 108 String *result = NewString(c); 109 Chop(result); 110 return result; 111} 112 113int is_integer(String *s) { 114 char *c = Char(s); 115 if (c[0] == '#' && (c[1] == 'x' || c[1] == 'o')) 116 c += 2; 117 118 while (*c) { 119 if (!isdigit(*c)) 120 return 0; 121 c++; 122 } 123 return 1; 124} 125 126String *class_from_class_or_class_ref(String *type) { 127 SwigType *stripped = SwigType_strip_qualifiers(type); 128 if (SwigType_isclass(stripped)) 129 return stripped; 130 131 if (SwigType_ispointer(stripped) || SwigType_isreference(stripped)) { 132 // Printf(stderr,"It is a pointer/reference. Is it a class?\n"); 133 SwigType_pop(stripped); 134 if (SwigType_isclass(stripped)) { 135 return stripped; 136 } 137 } 138 return 0; 139} 140 141String *lookup_defined_foreign_type(String *k) { 142 143#ifdef ALLEGROCL_TYPE_DEBUG 144 Printf(stderr, "Looking up defined type '%s'.\n Found: '%s'\n", k, Getattr(defined_foreign_types, k)); 145#endif 146 147 return Getattr(defined_foreign_types, k); 148} 149 150String *listify_namespace(String *namespaze) { 151 if (Len(namespaze) == 0) 152 return NewString("()"); 153 String *result = NewStringf("(\"%s\")", namespaze); 154 Replaceall(result, "::", "\" \""); 155 return result; 156} 157 158String *namespaced_name(Node *n, String *ns = current_namespace) { 159 160 return NewStringf("%s%s%s", ns, (Len(ns) != 0) ? "::" : "", Getattr(n, "sym:name")); 161} 162 163// "Namespace::Nested::Class2::Baz" -> "Baz" 164static String *strip_namespaces(String *str) { 165 SwigType *new_type = Copy(str); 166 SwigType *leading_type = SwigType_pop(new_type); 167 char *result = Char(leading_type); 168 169 if(SwigType_istemplate(leading_type)) { 170 result = Char(SwigType_templateprefix(leading_type)); 171 } else { 172 if (!SwigType_issimple(leading_type)) 173 return NewString(str); 174 } 175 176 String *stripped_one; 177 while ((stripped_one = Strstr(result, "::"))) 178 result = Char(stripped_one) + 2; 179 180 if(SwigType_istemplate(leading_type)) { 181 SwigType_push(new_type, NewStringf("%s%s%s", result, SwigType_templateargs(leading_type), 182 SwigType_templatesuffix(leading_type))); 183 return new_type; 184 } 185 186 return NewString(result); 187} 188 189static String *namespace_of(String *str) { 190 char *p = Char(str); 191 char *start = Char(str); 192 char *result = 0; 193 String *stripped_one; 194 195 while ((stripped_one = Strstr(p, "::"))) { 196 p = Char(stripped_one) + 2; 197 } 198 if (p > start) { 199 int len = p - start - 1; 200 result = (char *) malloc(len); 201 strncpy(result, start, len - 1); 202 result[len - 1] = 0; 203 } 204 return Char(result); 205} 206 207void add_linked_type(Node *n) { 208#ifdef ALLEGROCL_CLASS_DEBUG 209 Printf(stderr, "Adding linked node of type: %s(%s) %s(%x)\n\n", nodeType(n), Getattr(n, "storage"), Getattr(n, "name"), n); 210 // Swig_print_node(n); 211#endif 212 if (!first_linked_type) { 213 first_linked_type = n; 214 Setattr(n, "allegrocl:last_linked_type", n); 215 } else { 216 Node *t = Getattr(first_linked_type, "allegrocl:last_linked_type"); 217 Setattr(t, "allegrocl:next_linked_type", n); 218 Setattr(first_linked_type, "allegrocl:last_linked_type", n); 219 } 220} 221 222void replace_linked_type(Node *old, Node *new_node) { 223 Node *prev = Getattr(old, "allegrocl:prev_linked_type"); 224 225 Setattr(new_node, "allegrocl:next_linked_type", Getattr(old, "allegrocl:next_linked_type")); 226 if (prev) 227 Setattr(prev, "allegrocl:next_linked_type", new_node); 228 Delattr(old, "allegrocl:next_linked_type"); 229 Delattr(old, "allegrocl:prev_linked_type"); 230 231 // check if we're replacing the first link. 232 if (first_linked_type == old) { 233 first_linked_type = new_node; 234 Setattr(first_linked_type, "allegrocl:last_linked_type", Getattr(old, "allegrocl:last_linked_type")); 235 } 236 // check if we're replacing the last link. 237 if (Getattr(first_linked_type, "allegrocl:last_linked_type") == old) 238 Setattr(first_linked_type, "allegrocl:last_linked_type", new_node); 239} 240 241void insert_linked_type_at(Node *old, Node *new_node, int before = 1) { 242 Node *p = 0; 243 244 if (!first_linked_type) { 245 add_linked_type(new_node); 246 return; 247 } 248 249 if (!before) { 250 Setattr(new_node, "allegrocl:next_linked_type", Getattr(old, "allegrocl:next_linked_type")); 251 Setattr(old, "allegrocl:next_linked_type", new_node); 252 if (Getattr(first_linked_type, "allegrocl:last_linked_type") == old) 253 Setattr(first_linked_type, "allegrocl:last_linked_type", new_node); 254 } else { 255 Node *c = first_linked_type; 256 while (c) { 257 if (c == old) { 258 break; 259 } else { 260 p = c; 261 c = Getattr(c, "allegrocl:next_linked_type"); 262 } 263 } 264 if (c == old) { 265 Setattr(new_node, "allegrocl:next_linked_type", c); 266 if (first_linked_type == c) { 267 first_linked_type = new_node; 268 Setattr(first_linked_type, "allegrocl:last_linked_type", Getattr(c, "allegrocl:last_linked_type")); 269 Delattr(c, "allegrocl:last_linked_type"); 270 } 271 if (p) 272 Setattr(p, "allegrocl:next_linked_type", new_node); 273 } 274 } 275} 276 277Node *find_linked_type_by_name(String *name) { 278 Node *p = 0; 279 Node *c = first_linked_type; 280 281 // Printf(stderr,"in find_linked_type_by_name '%s'...", name); 282 while (c) { 283 String *key = Getattr(c, "name"); 284 if (!Strcmp(key, name)) { 285 break; 286 } else { 287 p = c; 288 c = Getattr(c, "allegrocl:next_linked_type"); 289 } 290 } 291 // Printf(stderr,"exit find_linked_type_by_name.\n"); 292 293 if (p && c) 294 Setattr(c, "allegrocl:prev_linked_type", p); 295 // Printf(stderr,"find_linked_type_by_name: DONE\n"); 296 return c; 297} 298 299Node *get_primary_synonym_of(Node *n) { 300 Node *p = Getattr(n, "allegrocl:synonym-of"); 301 Node *prim = n; 302 303 // Printf(stderr, "getting primary synonym of %x\n", n); 304 while (p) { 305 // Printf(stderr, " found one! %x\n", p); 306 prim = p; 307 p = Getattr(p, "allegrocl:synonym-of"); 308 } 309 // Printf(stderr,"get_primary_syn: DONE. returning %s(%x)\n", Getattr(prim,"name"),prim); 310 return prim; 311} 312 313void add_forward_referenced_type(Node *n, int overwrite = 0) { 314 String *k = Getattr(n, "name"); 315 String *name = Getattr(n, "sym:name"); 316 String *ns = listify_namespace(current_namespace); 317 318 String *val = Getattr(defined_foreign_types, k); 319 320 if (!val || overwrite) { 321#ifdef ALLEGROCL_TYPE_DEBUG 322 Printf(stderr, "Adding forward reference for %s (overwrite=%d)\n", k, overwrite); 323#endif 324 Setattr(defined_foreign_types, Copy(k), NewString("forward-reference")); 325 326 String *mangled_lname_gen = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", name, ns); 327 328 Setattr(defined_foreign_ltypes, Copy(k), mangled_lname_gen); 329 // Printf(f_cl, ";; forward reference stub\n" 330 // "(swig-def-foreign-class \"%s\" (ff:foreign-pointer) (:class ))\n\n" 331 // , name); 332 333#ifdef ALLEGROCL_CLASS_DEBUG 334 Printf(stderr, "Linking forward reference type = %s(%x)\n", k, n); 335#endif 336 add_linked_type(n); 337 } 338} 339 340void add_defined_foreign_type(Node *n, int overwrite = 0, String *k = 0, 341 String *name = 0, String *ns = current_namespace) { 342 343 String *val; 344 String *ns_list = listify_namespace(ns); 345 String *templated = n ? Getattr(n, "template") : 0; 346 String *cDeclName = n ? Getattr(n, "name") : 0; 347 348#ifdef ALLEGROCL_CLASS_DEBUG 349 Printf(stderr, "IN A-D-F-T. (n=%x, ow=%d, k=%s, name=%s, ns=%s\n", n, overwrite, k, name, ns); 350 Printf(stderr, " templated = '%x', classDecl = '%x'\n", templated, cDeclName); 351#endif 352 if (n) { 353 if (!name) 354 name = Getattr(n, "sym:name"); 355 if (!name) 356 name = strip_namespaces(Getattr(n, "name")); 357 if (templated) { 358 k = namespaced_name(n); 359 } else { 360 String *kind_of_type = Getattr(n, "kind"); 361 362 /* 363 For typedefs of the form: 364 365 typedef struct __xxx { ... } xxx; 366 367 behavior differs between C mode and C++ mode. 368 369 C Mode: 370 add_defined_foreign_type will be called once via classHandler 371 to define the type for 'struct __xxx' and add the mapping from 372 'struct __xxx' -> 'xxx' 373 374 It will also be called once via typedefHandler to add the 375 mapping 'xxx' -> 'xxx' 376 377 C++ Mode: 378 add_defined_foreign_type will be called once via classHandler 379 to define the type for 'xxx'. it also adds the mapping from 380 'xxx' -> 'xxx' and also for 'struct xxx' -> 'xxx' 381 382 In typedefHandler, we again try to add the mapping from 383 'xxx' -> 'xxx', which already exists. This second mapping 384 is ignored. 385 386 Both modes: 387 388 All references to this typedef'd struct will appear in 389 generated lisp code as an objectd of type 'xxx'. For 390 non-typedef'd structs, the classHand mapping will be 391 392 struct __xxx -> (swig-insert-id "__xxx") 393 */ 394 // Swig_print_node(n); 395 String *unnamed = Getattr(n, "unnamed"); 396 if (kind_of_type && (!Strcmp(kind_of_type, "struct") 397 || !Strcmp(kind_of_type, "union")) && cDeclName && !unnamed) { 398 k = NewStringf("%s %s", kind_of_type, cDeclName); 399 } else { 400 if (!Strcmp(nodeType(n), "enum") && unnamed) { 401 name = NewStringf("%s%d", anon_type_name, anon_type_count++); 402 k = NewStringf("enum %s", name); 403 Setattr(n, "allegrocl:name", name); 404 405 } else { 406 k = k ? k : Getattr(n, "name"); 407 } 408 } 409 } 410 // Swig_print_node(n); 411 } 412 413 String *tname = SwigType_istemplate_templateprefix(name); 414 if (tname) { 415 String *temp = strip_namespaces(tname); 416 name = NewStringf("%s%s%s", temp, SwigType_templateargs(name), SwigType_templatesuffix(name)); 417 Delete(temp); 418 Delete(tname); 419 } 420 421 val = lookup_defined_foreign_type(k); 422 423 int is_fwd_ref = 0; 424 if (val) 425 is_fwd_ref = !Strcmp(val, "forward-reference"); 426 427 if (!val || overwrite || is_fwd_ref) { 428#ifdef ALLEGROCL_CLASS_DEBUG 429 Printf(stderr, "Adding defined type '%s' = '%s' '%s' (overwrite=%d, in-class=%d)\n", k, ns, name, overwrite, in_class); 430#endif 431 String *mangled_name_gen = NewStringf("#.(swig-insert-id \"%s\" %s :type :type)", name, ns_list); 432 String *mangled_lname_gen = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", name, ns_list); 433 434 Setattr(defined_foreign_types, Copy(k), Copy(mangled_name_gen)); 435 Setattr(defined_foreign_ltypes, Copy(k), Copy(mangled_lname_gen)); 436 437 if (CPlusPlus) { 438 bool cpp_struct = Strstr(k, "struct ") ? true : false; 439 bool cpp_union = Strstr(k, "union ") ? true : false; 440 441 String *cpp_type = 0; 442 if (cpp_struct) { 443 cpp_type = Copy(k); 444 Replaceall(cpp_type, "struct ", ""); 445 } else if (cpp_union) { 446 cpp_type = Copy(k); 447 Replaceall(cpp_type, "union ", ""); 448 } 449 450 if (cpp_struct || cpp_union) { 451#ifdef ALLEGROCL_CLASS_DEBUG 452 Printf(stderr, " Also adding defined type '%s' = '%s' '%s' (overwrite=%d)\n", cpp_type, ns, name, overwrite); 453#endif 454 Setattr(defined_foreign_types, Copy(cpp_type), Copy(mangled_name_gen)); 455 Setattr(defined_foreign_ltypes, Copy(cpp_type), Copy(mangled_lname_gen)); 456 } 457 } 458#ifdef ALLEGROCL_CLASS_DEBUG 459 Printf(stderr, "looking to add %s/%s(%x) to linked_type_list...\n", k, name, n); 460#endif 461 if (is_fwd_ref) { 462 // Printf(stderr,"*** 1\n"); 463 add_linked_type(n); 464 } else { 465 // Printf(stderr,"*** 1-a\n"); 466 if (SwigType_istemplate(k)) { 467 SwigType *resolved = SwigType_typedef_resolve_all(k); 468 // Printf(stderr,"*** 1-b\n"); 469 Node *match = find_linked_type_by_name(resolved); 470 Node *new_node = 0; 471 // Printf(stderr, "*** temp-1\n"); 472 if (n) { 473 new_node = n; 474 } else { 475#ifdef ALLEGROCL_CLASS_DEBUG 476 Printf(stderr, "Creating a new templateInst:\n"); 477 Printf(stderr, " name = %s\n", resolved); 478 Printf(stderr, " sym:name = %s\n", name); 479 Printf(stderr, " real-name = %s\n", k); 480 Printf(stderr, " type = %s\n", resolved); 481 Printf(stderr, " ns = %s\n\n", ns); 482#endif 483 new_node = NewHash(); 484 Setattr(new_node, "nodeType", "templateInst"); 485 Setattr(new_node, "name", Copy(resolved)); 486 Setattr(new_node, "sym:name", Copy(name)); 487 Setattr(new_node, "real-name", Copy(k)); 488 Setattr(new_node, "type", Copy(resolved)); 489 Setattr(new_node, "allegrocl:namespace", ns); 490 Setattr(new_node, "allegrocl:package", ns); 491 } 492 493 if (!match) { 494 if (!Strcmp(nodeType(new_node), "templateInst") && in_class) { 495 /* this is an implicit template instantiation found while 496 walking a class. need to insert this into the 497 linked_type list before the current class definition */ 498#ifdef ALLEGROCL_CLASS_DEBUG 499 Printf(stderr, "trying to insert a templateInst before a class\n"); 500#endif 501 insert_linked_type_at(in_class, new_node); 502#ifdef ALLEGROCL_CLASS_DEBUG 503 Printf(stderr, "DID IT!\n"); 504#endif 505 } else { 506 // Printf(stderr,"*** 3\n"); 507 add_linked_type(new_node); 508 } 509 Setattr(new_node, "allegrocl:synonym:is-primary", "1"); 510 } else { 511 // a synonym type was found (held in variable 'match') 512 // Printf(stderr, "setting primary synonym of %x to %x\n", new_node, match); 513 if (new_node == match) 514 Printf(stderr, "Hey-4 * - '%s' is a synonym of iteself!\n", Getattr(new_node, "name")); 515 Setattr(new_node, "allegrocl:synonym-of", match); 516 // Printf(stderr,"*** 4\n"); 517 add_linked_type(new_node); 518 } 519 } else { 520 Node *match; 521 522 if (!Strcmp(nodeType(n), "cdecl") && !Strcmp(Getattr(n, "storage"), "typedef")) { 523 SwigType *type = SwigType_strip_qualifiers(Getattr(n, "type")); 524#ifdef ALLEGROCL_CLASS_DEBUG 525 Printf(stderr, "Examining typedef '%s' for class references. (%d)\n", type, SwigType_isclass(type)); 526#endif 527 if (SwigType_isclass(type)) { 528#ifdef ALLEGROCL_CLASS_DEBUG 529 Printf(stderr, "Found typedef of a class '%s'\n", type); 530#endif 531 /* 532 For the following parsed expression: 533 534 typedef struct __xxx { ... } xxx; 535 536 if n is of kind "class" (defining the class 'struct __xxx' 537 then we add n to the linked type list. 538 539 if n is "cdecl" node of storage "typedef" (to note 540 that xxx is equivalent to 'struct __xxx' then we don't 541 want to add this node to the linked type list. 542 */ 543 String *defined_type = lookup_defined_foreign_type(type); 544 String *defined_key_type = lookup_defined_foreign_type(k); 545 546 if ((Strstr(type, "struct ") || Strstr(type, "union ")) 547 && defined_type && !Strcmp(defined_type, defined_key_type)) { 548 // mark as a synonym but don't add to linked_type list 549 // Printf(stderr,"*** 4.8\n"); 550 Setattr(n, "allegrocl:synonym", "1"); 551 } else { 552 SwigType *lookup_type = SwigType_istemplate(type) ? SwigType_typedef_resolve_all(type) : Copy(type); 553 match = find_linked_type_by_name(lookup_type); 554 if (match) { 555 Setattr(n, "allegrocl:synonym", "1"); 556 Setattr(n, "allegrocl:synonym-of", match); 557 Setattr(n, "real-name", Copy(lookup_type)); 558 559 // Printf(stderr, "*** pre-5: found match of '%s'(%x)\n", Getattr(match,"name"),match); 560 // if(n == match) Printf(stderr, "Hey-5 *** setting synonym of %x to %x\n", n, match); 561 // Printf(stderr,"*** 5\n"); 562 add_linked_type(n); 563 } else { 564#ifdef ALLEGROCL_CLASS_DEBUG 565 Printf(stderr, "Creating classfoward node for struct stub in typedef.\n"); 566#endif 567 Node *new_node = NewHash(); 568 String *symname = Copy(type); 569 Replaceall(symname, "struct ", ""); 570 Setattr(new_node, "nodeType", "classforward"); 571 Setattr(new_node, "name", Copy(type)); 572 Setattr(new_node, "sym:name", symname); 573 Setattr(new_node, "allegrocl:namespace", ns); 574 Setattr(new_node, "allegrocl:package", ns); 575 576 String *mangled_new_name = NewStringf("#.(swig-insert-id \"%s\" %s)", symname, ns_list); 577 String *mangled_new_lname = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", symname, ns_list); 578 Setattr(defined_foreign_types, Copy(symname), Copy(mangled_new_name)); 579 Setattr(defined_foreign_ltypes, Copy(symname), Copy(mangled_new_lname)); 580 581 // Printf(stderr,"Weird! Can't find the type!\n"); 582 add_forward_referenced_type(new_node); 583 add_linked_type(new_node); 584 585 Setattr(n, "allegrocl:synonym", "1"); 586 Setattr(n, "allegrocl:synonym-of", new_node); 587 588 add_linked_type(n); 589 } 590 Delete(lookup_type); 591 } 592 } else { 593 // check if it's a pointer or reference to a class. 594 // Printf(stderr,"Checking if '%s' is a p. or r. to a class\n", type); 595 String *class_ref = class_from_class_or_class_ref(type); 596 if (class_ref) { 597 match = find_linked_type_by_name(class_ref); 598 Setattr(n, "allegrocl:synonym", "1"); 599 Setattr(n, "allegrocl:synonym-of", match); 600 add_linked_type(n); 601 } 602 } 603 Delete(type); 604 // synonym types have already been added. 605 // Printf(stderr,"*** 10\n"); 606 if (!Getattr(n, "allegrocl:synonym")) 607 add_linked_type(n); 608 } else if (Getattr(n, "template")) { 609 // Printf(stderr, "this is a class template node(%s)\n", nodeType(n)); 610 String *resolved = SwigType_typedef_resolve_all(Getattr(n, "name")); 611 612#ifdef ALLEGROCL_CLASS_DEBUG 613 Printf(stderr, " looking up %s for linked type match with %s...\n", Getattr(n, "sym:name"), resolved); 614#endif 615 match = find_linked_type_by_name(resolved); 616 if (!match) { 617#ifdef ALLEGROCL_CLASS_DEBUG 618 Printf(stderr, "found no implicit instantiation of %%template node %s(%x)\n", Getattr(n, "name"), n); 619#endif 620 add_linked_type(n); 621 } else { 622 Node *primary = get_primary_synonym_of(match); 623 624 Setattr(n, "allegrocl:synonym:is-primary", "1"); 625 Delattr(primary, "allegrocl:synonym:is-primary"); 626 if (n == match) 627 Printf(stderr, "Hey-7 * setting synonym of %x to %x\n (match = %x)", primary, n, match); 628 Setattr(primary, "allegrocl:synonym-of", n); 629 // Printf(stderr,"*** 7\n"); 630 add_linked_type(n); 631 } 632 } else { 633#ifdef ALLEGROCL_CLASS_DEBUG 634 Printf(stderr, "linking type '%s'(%x)\n", k, n); 635#endif 636 // Printf(stderr,"*** 8\n"); 637 add_linked_type(n); 638 } 639 } 640 } 641 Delete(mangled_name_gen); 642 Delete(mangled_lname_gen); 643 } else { 644 if (!CPlusPlus || Strcmp(Getattr(n,"kind"),"typedef")) { 645 Swig_warning(WARN_TYPE_REDEFINED, Getfile(n), Getline(n), 646 "Attempting to store a foreign type that exists: %s (%s)\n", 647 k, val); 648 } 649 } 650 651 Delete(ns_list); 652 653#ifdef ALLEGROCL_CLASS_DEBUG 654 Printf(stderr, "OUT A-D-F-T\n"); 655#endif 656} 657 658void note_implicit_template_instantiation(SwigType *t) { 659 // the namespace of the implicit instantiation is not necessarily 660 // current_namespace. Attempt to cull this from the type. 661#ifdef ALLEGROCL_CLASS_DEBUG 662 Printf(stderr, "culling namespace of '%s' from '%s'\n", t, SwigType_templateprefix(t)); 663#endif 664 SwigType *type = Copy(t); 665 SwigType *tok = SwigType_pop(type); 666 String *implicit_ns = SwigType_istemplate(tok) ? namespace_of(SwigType_templateprefix(tok)) : 0; 667 add_defined_foreign_type(0, 0, t, t, implicit_ns ? implicit_ns : current_namespace); 668 669 Delete(type); 670} 671 672String *get_ffi_type(Node *n, SwigType *ty, const_String_or_char_ptr name) { 673 /* lookup defined foreign type. 674 if it exists, it will return a form suitable for placing 675 into lisp code to generate the def-foreign-type name */ 676 677#ifdef ALLEGROCL_TYPE_DEBUG 678 Printf(stderr, "inside g_f_t: looking up '%s' '%s'\n", ty, name); 679#endif 680 681 String *found_type = lookup_defined_foreign_type(ty); 682 683 if (found_type) { 684#ifdef ALLEGROCL_TYPE_DEBUG 685 Printf(stderr, "found_type '%s'\n", found_type); 686#endif 687 return (Strcmp(found_type, "forward-reference") ? Copy(found_type) : get_ffi_type(n, fwdref_ffi_type, "")); 688 } else { 689 Node *node = NewHash(); 690 Setattr(node, "type", ty); 691 Setfile(node, Getfile(n)); 692 Setline(node, Getline(n)); 693 const String *tm = Swig_typemap_lookup("ffitype", node, name, 0); 694 Delete(node); 695 696 if (tm) { 697#ifdef ALLEGROCL_TYPE_DEBUG 698 Printf(stderr, "g-f-t: found ffitype typemap '%s'\n", tm); 699#endif 700 return NewString(tm); 701 } 702 703 if (SwigType_istemplate(ty)) { 704 note_implicit_template_instantiation(ty); 705 return Copy(lookup_defined_foreign_type(ty)); 706 } 707 } 708 return 0; 709} 710 711String *lookup_defined_foreign_ltype(String *l) { 712 713#ifdef ALLEGROCL_TYPE_DEBUG 714 Printf(stderr, "Looking up defined ltype '%s'.\n Found: '%s'\n", l, Getattr(defined_foreign_ltypes, l)); 715#endif 716 return Getattr(defined_foreign_ltypes, l); 717} 718 719/* walk type and return string containing lisp version. 720 recursive. */ 721String *internal_compose_foreign_type(Node *n, SwigType *ty) { 722 723 SwigType *tok; 724 String *ffiType = NewString(""); 725 726 // for a function type, need to walk the parm list. 727 while (Len(ty) != 0) { 728 tok = SwigType_pop(ty); 729 730 if (SwigType_isfunction(tok)) { 731 // Generate Function wrapper 732 Printf(ffiType, "(:function "); 733 // walk parm list 734 List *pl = SwigType_parmlist(tok); 735 736 Printf(ffiType, "("); // start parm list 737 for (Iterator i = First(pl); i.item; i = Next(i)) { 738 SwigType *f_arg = SwigType_strip_qualifiers(i.item); 739 Printf(ffiType, "%s ", internal_compose_foreign_type(n, f_arg)); 740 Delete(f_arg); 741 } 742 Printf(ffiType, ")"); // end parm list. 743 744 // do function return type. 745 Printf(ffiType, " %s)", internal_compose_foreign_type(n, ty)); 746 break; 747 } else if (SwigType_ispointer(tok) || SwigType_isreference(tok)) { 748 Printf(ffiType, "(* %s)", internal_compose_foreign_type(n, ty)); 749 } else if (SwigType_isarray(tok)) { 750 Printf(ffiType, "(:array %s", internal_compose_foreign_type(n, ty)); 751 String *atype = NewString("int"); 752 String *dim = convert_literal(SwigType_array_getdim(tok, 0), atype); 753 Delete(atype); 754 if (is_integer(dim)) { 755 Printf(ffiType, " %s)", dim); 756 } else { 757 Printf(ffiType, " #| %s |#)", SwigType_array_getdim(tok, 0)); 758 } 759 } else if (SwigType_ismemberpointer(tok)) { 760 // temp 761 Printf(ffiType, "(* %s)", internal_compose_foreign_type(n, ty)); 762 } else { 763 String *res = get_ffi_type(n, tok, ""); 764 if (res) { 765 Printf(ffiType, "%s", res); 766 } else { 767 SwigType *resolved_type = SwigType_typedef_resolve_all(tok); 768 if (Cmp(resolved_type, tok) != 0) { 769 res = get_ffi_type(n, resolved_type, ""); 770 if (res) { 771 } else { 772 res = internal_compose_foreign_type(n, resolved_type); 773 } 774 if (res) 775 Printf(ffiType, "%s", res); 776 } 777 778 if (!res) { 779 String *is_struct = 0; 780 String *tok_remove_text = 0; 781 String *tok_name = Copy(tok); 782 String *tok_key = SwigType_str(tok,0); 783 if ((is_struct = Strstr(tok_key, "struct ")) || Strstr(tok_key, "union ")) { 784 tok_remove_text = NewString(is_struct ? "struct " : "union "); 785 } 786 787 /* be more permissive of opaque types. This is the swig way. 788 compiles will notice if these types are ultimately not 789 present. */ 790 791 if(tok_remove_text) { 792 Replaceall(tok_name,tok_remove_text,""); 793 } 794 tok_name = strip_namespaces(tok_name); 795 Delete(tok_remove_text); 796 // Swig_warning(WARN_TYPE_UNDEFINED_CLASS, Getfile(tok), Getline(tok), "Unable to find definition of '%s', assuming forward reference.\n", tok); 797 798#ifdef ALLEGROCL_TYPE_DEBUG 799 Printf(stderr, "i-c-f-t: adding forward reference for unknown type '%s'. mapping: %s -> %s\n", tok, tok_key, tok_name); 800#endif 801 Node *nn = NewHash(); 802 Setattr(nn,"nodeType","classforward"); 803 Setattr(nn,"kind","class"); 804 Setattr(nn,"sym:name",tok_name); 805 Setattr(nn,"name",tok_key); 806 Setattr(nn,"allegrocl:package",current_namespace); 807 808 add_forward_referenced_type(nn, 0); 809 // tok_name is dangling here, unused. ouch. why? 810 Printf(ffiType, "%s", get_ffi_type(n, tok, ""), tok_name); 811 } 812 } 813 } 814 } 815 return ffiType; 816} 817 818String *compose_foreign_type(Node *n, SwigType *ty, String * /*id*/ = 0) { 819 820#ifdef ALLEGROCL_TYPE_DEBUG 821 Printf(stderr, "compose_foreign_type: ENTER (%s)...\n ", ty); 822 // Printf(stderr, "compose_foreign_type: ENTER (%s)(%s)...\n ", ty, (id ? id : 0)); 823 /* String *id_ref = SwigType_str(ty, id); 824 Printf(stderr, "looking up typemap for %s, found '%s'(%x)\n", 825 id_ref, lookup_res ? Getattr(lookup_res, "code") : 0, lookup_res); 826 if (lookup_res) Swig_print_node(lookup_res); 827 */ 828#endif 829 830 /* should we allow named lookups in the typemap here? YES! */ 831 /* unnamed lookups should be found in get_ffi_type, called 832 by internal_compose_foreign_type(), below. */ 833 834 /* I'm reverting to 'no' for the question above. I can no longer 835 remember why I needed it. If a user needed it, I'll find out 836 as soon as they upgrade. Sigh. -mutandiz 9/16/2008. */ 837 838/* 839 if(id && lookup_res) { 840#ifdef ALLEGROCL_TYPE_DEBUG 841 Printf(stderr, "compose_foreign_type: EXIT-1 (%s)\n ", Getattr(lookup_res, "code")); 842#endif 843 return NewString(Getattr(lookup_res, "code")); 844 } 845*/ 846 847 SwigType *temp = SwigType_strip_qualifiers(ty); 848 String *res = internal_compose_foreign_type(n, temp); 849 Delete(temp); 850 851#ifdef ALLEGROCL_TYPE_DEBUG 852 Printf(stderr, "compose_foreign_type: EXIT (%s)\n ", res); 853#endif 854 855 return res; 856} 857 858void update_package_if_needed(Node *n, File *f = f_clwrap) { 859#ifdef ALLEGROCL_DEBUG 860 Printf(stderr, "update_package: ENTER... \n"); 861 Printf(stderr, " current_package = '%s'\n", current_package); 862 Printf(stderr, " node_package = '%s'\n", Getattr(n, "allegrocl:package")); 863 Printf(stderr, " node(%x) = '%s'\n", n, Getattr(n, "name")); 864#endif 865 String *node_package = Getattr(n, "allegrocl:package"); 866 if (Strcmp(current_package, node_package)) { 867 String *lispy_package = listify_namespace(node_package); 868 869 Delete(current_package); 870 current_package = Copy(node_package); 871 Printf(f, "\n(swig-in-package %s)\n", lispy_package); 872 Delete(lispy_package); 873 } 874#ifdef ALLEGROCL_DEBUG 875 Printf(stderr, "update_package: EXIT.\n"); 876#endif 877} 878 879static String *mangle_name(Node *n, char const *prefix = "ACL", String *ns = current_namespace) { 880 String *suffix = Getattr(n, "sym:overname"); 881 String *pre_mangled_name = NewStringf("%s_%s__%s%s", prefix, ns, Getattr(n, "sym:name"), suffix); 882 String *mangled_name = Swig_name_mangle(pre_mangled_name); 883 Delete(pre_mangled_name); 884 return mangled_name; 885} 886 887/* utilities */ 888 889/* remove a pointer from ffitype. non-destructive. 890 (* :char) ==> :char 891 (* (:array :int 30)) ==> (:array :int 30) */ 892String *dereference_ffitype(String *ffitype) { 893 char *start; 894 char *temp = Char(ffitype); 895 String *reduced_type = 0; 896 897 if(temp && temp[0] == '(' && temp[1] == '*') { 898 temp += 2; 899 900 // walk past start of pointer references 901 while(*temp == ' ') temp++; 902 start = temp; 903 // temp = Char(reduced_type); 904 reduced_type = NewString(start); 905 temp = Char(reduced_type); 906 // walk to end of string. remove closing paren 907 while(*temp != '\0') temp++; 908 *(--temp) = '\0'; 909 } 910 911 return reduced_type ? reduced_type : Copy(ffitype); 912} 913 914/* returns new string w/ parens stripped */ 915String *strip_parens(String *string) { 916 string = Copy(string); 917 Replaceall(string, "(", ""); 918 Replaceall(string, ")", ""); 919 return string; 920} 921 922int ALLEGROCL::validIdentifier(String *s) { 923#ifdef ALLEGROCL_DEBUG 924 Printf(stderr, "validIdentifier %s\n", s); 925#endif 926 927 char *c = Char(s); 928 929 bool got_dot = false; 930 bool only_dots = true; 931 932 /* Check that s is a valid common lisp symbol. There's a lot of leeway here. 933 A common lisp symbol is essentially any token that's not a number and 934 does not consist of only dots. 935 936 We are expressly not allowing spaces in identifiers here, but spaces 937 could be added via the identifier converter. */ 938 while (*c) { 939 if (*c == '.') { 940 got_dot = true; 941 } else { 942 only_dots = false; 943 } 944 if (!isgraph(*c)) 945 return 0; 946 c++; 947 } 948 949 return (got_dot && only_dots) ? 0 : 1; 950} 951 952String *infix_to_prefix(String *val, char split_op, const String *op, String *type) { 953 List *ored = Split(val, split_op, -1); 954 955 // some float hackery 956 if (((split_op == '+') || (split_op == '-')) && Len(ored) == 2 && 957 (SwigType_type(type) == T_FLOAT || SwigType_type(type) == T_DOUBLE || SwigType_type(type) == T_LONGDOUBLE)) { 958 // check that we're not splitting a float 959 String *possible_result = convert_literal(val, type, false); 960 if (possible_result) 961 return possible_result; 962 963 } 964 // try parsing the split results. if any part fails, kick out. 965 bool part_failed = false; 966 if (Len(ored) > 1) { 967 String *result = NewStringf("(%s", op); 968 for (Iterator i = First(ored); i.item; i = Next(i)) { 969 String *converted = convert_literal(i.item, type); 970 if (converted) { 971 Printf(result, " %s", converted); 972 Delete(converted); 973 } else { 974 part_failed = true; 975 break; 976 } 977 } 978 Printf(result, ")"); 979 Delete(ored); 980 return part_failed ? 0 : result; 981 } 982 Delete(ored); 983 return 0; 984} 985 986/* To be called by code generating the lisp interface 987 Will return a containing the literal based on type. 988 Will return null if there are problems. 989 990 try_to_split defaults to true (see stub above). 991 */ 992String *convert_literal(String *literal, String *type, bool try_to_split) { 993 String *num_param = Copy(literal); 994 String *trimmed = trim(num_param); 995 String *num = strip_parens(trimmed), *res = 0; 996 char *s = Char(num); 997 998 String *ns = listify_namespace(current_namespace); 999 1000 // very basic parsing of infix expressions. 1001 if (try_to_split && SwigType_type(type) != T_STRING) { 1002 if ((res = infix_to_prefix(num, '|', "logior", type))) 1003 return res; 1004 if ((res = infix_to_prefix(num, '&', "logand", type))) 1005 return res; 1006 if ((res = infix_to_prefix(num, '^', "logxor", type))) 1007 return res; 1008 if ((res = infix_to_prefix(num, '*', "*", type))) 1009 return res; 1010 if ((res = infix_to_prefix(num, '/', "/", type))) 1011 return res; 1012 if ((res = infix_to_prefix(num, '+', "+", type))) 1013 return res; 1014 if ((res = infix_to_prefix(num, '-', "-", type))) 1015 return res; 1016 // if ((res = infix_to_prefix(num, '~', "lognot", type))) return res; 1017 // if( (res = infix_to_prefix(num, '<<', "ash", type)) ) return res; 1018 } 1019 1020 // unary complement... 1021 if (s[0] == '~' && Len(num) >= 2) { 1022 String *id = NewString(++s); 1023 String *id_conv = convert_literal(id, type, false); 1024 Delete(id); 1025 if (id_conv) 1026 return NewStringf("(lognot %s)", id_conv); 1027 s--; 1028 } 1029 1030 if (SwigType_type(type) == T_FLOAT || SwigType_type(type) == T_DOUBLE || SwigType_type(type) == T_LONGDOUBLE) { 1031 // Use CL syntax for float literals 1032 String *oldnum = Copy(num); 1033 1034 // careful. may be a float identifier or float constant. 1035 char *num_start = Char(num); 1036 char *num_end = num_start + strlen(num_start) - 1; 1037 1038 bool is_literal = isdigit(*num_start) || (*num_start == '.'); 1039 1040 String *lisp_exp = 0; 1041 if (is_literal) { 1042 if (*num_end == 'f' || *num_end == 'F') { 1043 lisp_exp = NewString("f"); 1044 } else { 1045 lisp_exp = NewString("d"); 1046 } 1047 1048 if (*num_end == 'l' || *num_end == 'L' || *num_end == 'f' || *num_end == 'F') { 1049 *num_end = '\0'; 1050 num_end--; 1051 } 1052 1053 int exponents = Replaceall(num, "e", lisp_exp) + Replaceall(num, "E", lisp_exp); 1054 1055 if (!exponents) 1056 Printf(num, "%s0", lisp_exp); 1057 1058 if (exponents > 1 || (exponents + Replaceall(num, ".", ".") == 0)) { 1059 // Printf(stderr, "Can't parse '%s' as type '%s'.\n", oldnum, type); 1060 Delete(num); 1061 num = 0; 1062 } 1063 Delete(lisp_exp); 1064 } else { 1065 String *id = NewStringf("#.(swig-insert-id \"%s\" %s :type :constant)", 1066 num, ns); 1067 Delete(num); 1068 num = id; 1069 } 1070 1071 Delete(oldnum); 1072 Delete(trimmed); 1073 Delete(ns); 1074 return num; 1075 } else if (SwigType_type(type) == T_CHAR) { 1076 /* Use CL syntax for character literals */ 1077 Delete(num); 1078 Delete(trimmed); 1079 return NewStringf("#\\%s", num_param); 1080 } else if (SwigType_type(type) == T_STRING) { 1081 /* Use CL syntax for string literals */ 1082 Delete(num); 1083 Delete(trimmed); 1084 return NewStringf("\"%s\"", num_param); 1085 } else if (Len(num) >= 1 && (isdigit(s[0]) || s[0] == '+' || s[0] == '-')) { 1086 /* use CL syntax for numbers */ 1087 String *oldnum = Copy(num); 1088 int usuffixes = Replaceall(num, "u", "") + Replaceall(num, "U", ""); 1089 int lsuffixes = Replaceall(num, "l", "") + Replaceall(num, "L", ""); 1090 if (usuffixes > 1 || lsuffixes > 1) { 1091 Printf(stderr, "Weird!! number %s looks invalid.\n", oldnum); 1092 SWIG_exit(EXIT_FAILURE); 1093 } 1094 s = Char(num); 1095 if (s[0] == '0' && Len(num) >= 2) { 1096 /*octal or hex */ 1097 res = NewStringf("#%c%s", tolower(s[1]) == 'x' ? 'x' : 'o', s + 2); 1098 Delete(num); 1099 } else { 1100 res = num; 1101 } 1102 Delete(oldnum); 1103 Delete(trimmed); 1104 return res; 1105 } else if (allegrocl->validIdentifier(num)) { 1106 /* convert C/C++ identifiers to CL symbols */ 1107 res = NewStringf("#.(swig-insert-id \"%s\" %s :type :constant)", num, ns); 1108 Delete(num); 1109 Delete(trimmed); 1110 Delete(ns); 1111 return res; 1112 } else { 1113 Delete(trimmed); 1114 return num; 1115 } 1116} 1117 1118 1119void emit_stub_class(Node *n) { 1120 1121#ifdef ALLEGROCL_WRAP_DEBUG 1122 Printf(stderr, "emit_stub_class: ENTER... '%s'(%x)\n", Getattr(n, "sym:name"), n); 1123 Swig_print_node(n); 1124#endif 1125 1126 1127 String *name = Getattr(n, "sym:name"); 1128 1129 if (Getattr(n, "allegrocl:synonym:already-been-stubbed")) 1130 return; 1131 1132 String *tname = SwigType_istemplate_templateprefix(name); 1133 if (tname) { 1134 String *temp = strip_namespaces(tname); 1135 name = NewStringf("%s%s%s", temp, SwigType_templateargs(name), SwigType_templatesuffix(name)); 1136 Delete(temp); 1137 Delete(tname); 1138 } else { 1139 name = strip_namespaces(name); 1140 } 1141 1142 // Printf(f_clhead, ";; from emit-stub-class\n"); 1143 update_package_if_needed(n, f_clhead); 1144 Printf(f_clhead, ";; class template stub.\n"); 1145 Printf(f_clhead, "(swig-def-foreign-stub \"%s\")\n", name); 1146 1147 Setattr(n, "allegrocl:synonym:already-been-stubbed", "1"); 1148 1149#ifdef ALLEGROCL_WRAP_DEBUG 1150 Printf(stderr, "emit_stub_class: EXIT\n"); 1151#endif 1152} 1153 1154void emit_synonym(Node *synonym) { 1155 1156#ifdef ALLEGROCL_WRAP_DEBUG 1157 Printf(stderr, "emit_synonym: ENTER... \n"); 1158#endif 1159 1160 // Printf(stderr,"in emit_synonym for %s(%x)\n", Getattr(synonym,"name"),synonym); 1161 int is_tempInst = !Strcmp(nodeType(synonym), "templateInst"); 1162 String *synonym_type; 1163 1164 Node *of = get_primary_synonym_of(synonym); 1165 1166 if (is_tempInst) { 1167 // Printf(stderr, "*** using real-name '%s'\n", Getattr(synonym,"real-name")); 1168 synonym_type = Getattr(synonym, "real-name"); 1169 } else { 1170 // Printf(stderr, "*** using name '%s'\n", Getattr(synonym,"name")); 1171 synonym_type = Getattr(synonym, "name"); 1172 } 1173 1174 String *synonym_ns = listify_namespace(Getattr(synonym, "allegrocl:namespace")); 1175 String *syn_ltype, *syn_type, *of_ltype; 1176 // String *of_cdeclname = Getattr(of,"allegrocl:classDeclarationName"); 1177 String *of_ns = Getattr(of, "allegrocl:namespace"); 1178 String *of_ns_list = listify_namespace(of_ns); 1179 // String *of_name = of_cdeclname ? NewStringf("struct %s", Getattr(of,"name")) : NewStringf("%s::%s", of_ns, Getattr(of,"sym:name")); 1180 // String *of_name = NewStringf("%s::%s", of_ns, Getattr(of,"sym:name")); 1181 String *of_name = namespaced_name(of, of_ns); 1182 1183 if (CPlusPlus && !Strcmp(nodeType(synonym), "cdecl")) { 1184 syn_ltype = NewStringf("#.(swig-insert-id \"%s\" %s :type :class)", 1185 strip_namespaces(Getattr(synonym, "real-name")), synonym_ns); 1186 syn_type = NewStringf("#.(swig-insert-id \"%s\" %s :type :type)", 1187 strip_namespaces(Getattr(synonym, "real-name")), synonym_ns); 1188 } else { 1189 syn_ltype = lookup_defined_foreign_ltype(synonym_type); 1190 syn_type = lookup_defined_foreign_type(synonym_type); 1191 } 1192 1193 of_ltype = lookup_defined_foreign_ltype(of_name); 1194 1195 // Printf(stderr,";; from emit-synonym syn='%s' of_ltype='%s'\n", syn_ltype, of_ltype); 1196 if( of_ltype ) 1197 Printf(f_clhead, "(swig-def-synonym-type %s\n %s\n %s)\n", syn_ltype, of_ltype, syn_type); 1198 1199 Delete(synonym_ns); 1200 Delete(of_ns_list); 1201 Delete(of_name); 1202 1203#ifdef ALLEGROCL_WRAP_DEBUG 1204 Printf(stderr, "emit_synonym: EXIT\n"); 1205#endif 1206} 1207 1208void emit_full_class(Node *n) { 1209 1210#ifdef ALLEGROCL_WRAP_DEBUG 1211 Printf(stderr, "emit_full_class: ENTER... \n"); 1212#endif 1213 1214 String *name = Getattr(n, "sym:name"); 1215 String *kind = Getattr(n, "kind"); 1216 1217 // Printf(stderr,"in emit_full_class: '%s'(%x).", Getattr(n,"name"),n); 1218 if (Getattr(n, "allegrocl:synonym-of")) { 1219 // Printf(stderr,"but it's a synonym of something.\n"); 1220 update_package_if_needed(n, f_clhead); 1221 emit_synonym(n); 1222 return; 1223 } 1224 // collect superclasses 1225 String *bases = Getattr(n, "bases"); 1226 String *supers = NewString("("); 1227 if (bases) { 1228 int first = 1; 1229 for (Iterator i = First(bases); i.item; i = Next(i)) { 1230 if (!first) 1231 Printf(supers, " "); 1232 String *s = lookup_defined_foreign_ltype(Getattr(i.item, "name")); 1233 // String *name = Getattr(i.item,"name"); 1234 if (s) { 1235 Printf(supers, "%s", s); 1236 } else { 1237#ifdef ALLEGROCL_TYPE_DEBUG 1238 Printf(stderr, "emit_templ_inst: did not find ltype for base class %s (%s)", Getattr(i.item, "name"), Getattr(n, "allegrocl:namespace")); 1239#endif 1240 } 1241 } 1242 } else { 1243 Printf(supers, "ff:foreign-pointer"); 1244 } 1245 1246 // check for "feature:aclmixins" and add those as well. 1247 Printf(supers, " %s)", Getattr(n,"feature:aclmixins")); 1248 1249 // Walk children to generate type definition. 1250 String *slotdefs = NewString(" "); 1251 1252#ifdef ALLEGROCL_WRAP_DEBUG 1253 Printf(stderr, " walking children...\n"); 1254#endif 1255 1256 Node *c; 1257 for (c = firstChild(n); c; c = nextSibling(c)) { 1258 String *storage_type = Getattr(c, "storage"); 1259 if ((!Strcmp(nodeType(c), "cdecl") && (!storage_type || Strcmp(storage_type, "typedef")))) { 1260 String *access = Getattr(c, "access"); 1261 1262 // hack. why would decl have a value of "variableHandler" and now "0"? 1263 String *childDecl = Getattr(c, "decl"); 1264 // Printf(stderr,"childDecl = '%s' (%s)\n", childDecl, Getattr(c,"view")); 1265 if (!Strcmp(childDecl, "0")) 1266 childDecl = NewString(""); 1267 1268 SwigType *childType; 1269 String *cname; 1270 1271 // don't include types for private slots (yet). spr33959. 1272 if(access && Strcmp(access,"public")) { 1273 childType = NewStringf("int"); 1274 cname = NewString("nil"); 1275 } else { 1276 childType = NewStringf("%s%s", childDecl, Getattr(c, "type")); 1277 cname = Copy(Getattr(c, "name")); 1278 } 1279 1280 if (!SwigType_isfunction(childType)) { 1281 // Printf(slotdefs, ";;; member functions don't appear as slots.\n "); 1282 // Printf(slotdefs, ";; "); 1283 String *ns = listify_namespace(Getattr(n, "allegrocl:package")); 1284 1285#ifdef ALLEGROCL_WRAP_DEBUG 1286 Printf(stderr, "slot name = '%s' ns = '%s' class-of '%s' and type = '%s'\n", cname, ns, name, childType); 1287#endif 1288 Printf(slotdefs, "(#.(swig-insert-id \"%s\" %s :type :slot :class \"%s\") %s)", cname, ns, name, compose_foreign_type(n, childType)); 1289 Delete(ns); 1290 if (access && Strcmp(access, "public")) 1291 Printf(slotdefs, " ;; %s member", access); 1292 1293 Printf(slotdefs, "\n "); 1294 } 1295 Delete(childType); 1296 Delete(cname); 1297 } 1298 } 1299 1300 String *ns_list = listify_namespace(Getattr(n, "allegrocl:namespace")); 1301 update_package_if_needed(n, f_clhead); 1302 Printf(f_clhead, "(swig-def-foreign-class \"%s\"\n %s\n (:%s\n%s))\n\n", name, supers, kind, slotdefs); 1303 1304 Delete(supers); 1305 Delete(ns_list); 1306 1307 Setattr(n, "allegrocl:synonym:already-been-stubbed", "1"); 1308#ifdef ALLEGROCL_WRAP_DEBUG 1309 Printf(stderr, "emit_full_class: EXIT\n"); 1310#endif 1311 1312} 1313 1314void emit_class(Node *n) { 1315 1316#ifdef ALLEGROCL_WRAP_DEBUG 1317 Printf(stderr, "emit_class: ENTER... '%s'(%x)\n", Getattr(n, "sym:name"), n); 1318#endif 1319 1320 int is_tempInst = !Strcmp(nodeType(n), "templateInst"); 1321 1322 String *ns_list = listify_namespace(Getattr(n, "allegrocl:namespace")); 1323 String *name = Getattr(n, is_tempInst ? "real-name" : "name"); 1324 1325 String *tname = SwigType_istemplate_templateprefix(name); 1326 if (tname) { 1327 String *temp = strip_namespaces(tname); 1328 name = NewStringf("%s%s%s", temp, SwigType_templateargs(name), SwigType_templatesuffix(name)); 1329 Delete(temp); 1330 Delete(tname); 1331 } else { 1332 name = strip_namespaces(name); 1333 } 1334 1335 if (Getattr(n, "allegrocl:synonym:is-primary")) { 1336 // Printf(stderr," is primary... "); 1337 if (is_tempInst) { 1338 emit_stub_class(n); 1339 } else { 1340 emit_full_class(n); 1341 } 1342 } else { 1343 // Node *primary = Getattr(n,"allegrocl:synonym-of"); 1344 Node *primary = get_primary_synonym_of(n); 1345 if (primary && (primary != n)) { 1346 // Printf(stderr," emitting synonym... "); 1347 emit_stub_class(primary); 1348 update_package_if_needed(n, f_clhead); 1349 emit_synonym(n); 1350 } else { 1351 emit_full_class(n); 1352 } 1353 } 1354 // Printf(stderr,"DONE\n"); 1355 Delete(name); 1356 Delete(ns_list); 1357 1358#ifdef ALLEGROCL_WRAP_DEBUG 1359 Printf(stderr, "emit_class: EXIT\n"); 1360#endif 1361} 1362 1363void emit_typedef(Node *n) { 1364 1365#ifdef ALLEGROCL_WRAP_DEBUG 1366 Printf(stderr, "emit_typedef: ENTER... \n"); 1367#endif 1368 1369 String *name; 1370 String *sym_name = Getattr(n, "sym:name"); 1371 String *type = NewStringf("%s%s", Getattr(n, "decl"), Getattr(n, "type")); 1372 String *lisp_type = compose_foreign_type(n, type); 1373 Delete(type); 1374 Node *in_class = Getattr(n, "allegrocl:typedef:in-class"); 1375 1376 // Printf(stderr,"in emit_typedef: '%s'(%x).",Getattr(n,"name"),n); 1377 if (Getattr(n, "allegrocl:synonym-of")) { 1378 // Printf(stderr," but it's a synonym of something.\n"); 1379 emit_synonym(n); 1380 return; 1381 } 1382 1383 if (in_class) { 1384 String *class_name = Getattr(in_class, "name"); 1385 String *tname = SwigType_istemplate_templateprefix(class_name); 1386 if (tname) { 1387 String *temp = strip_namespaces(tname); 1388 class_name = NewStringf("%s%s%s", temp, SwigType_templateargs(class_name), SwigType_templatesuffix(class_name)); 1389 Delete(temp); 1390 Delete(tname); 1391 } 1392 1393 name = NewStringf("%s__%s", class_name, sym_name); 1394 Setattr(n, "allegrocl:in-class", in_class); 1395 } else { 1396 name = sym_name ? Copy(sym_name) : Copy(Getattr(n, "name")); 1397 } 1398 1399 // leave these in for now. might want to change these to def-foreign-class at some point. 1400// Printf(f_clhead, ";; %s\n", SwigType_typedef_resolve_all(lisp_type)); 1401 Printf(f_clhead, "(swig-def-foreign-type \"%s\"\n %s)\n", name, lisp_type); 1402 1403 Delete(name); 1404 1405#ifdef ALLEGROCL_WRAP_DEBUG 1406 Printf(stderr, "emit_typedef: EXIT\n"); 1407#endif 1408} 1409 1410void emit_enum_type_no_wrap(Node *n) { 1411 1412#ifdef ALLEGROCL_WRAP_DEBUG 1413 Printf(stderr, "emit_enum_type_no_wrap: ENTER... \n"); 1414#endif 1415 1416 String *unnamed = Getattr(n, "unnamed"); 1417 String *name; 1418 // SwigType *enumtype; 1419 1420 name = unnamed ? Getattr(n, "allegrocl:name") : Getattr(n, "sym:name"); 1421 SwigType *tmp = NewStringf("enum %s", unnamed ? unnamed : name); 1422 1423 Node *node = NewHash(); 1424 Setattr(node, "type", tmp); 1425 Setfile(node, Getfile(n)); 1426 Setline(node, Getline(n)); 1427 const String *enumtype = Swig_typemap_lookup("ffitype", node, "", 0); 1428 Delete(node); 1429 1430 Delete(tmp); 1431 1432 if (name) { 1433 String *ns = listify_namespace(current_namespace); 1434 1435 Printf(f_clhead, "(swig-def-foreign-type \"%s\" %s)\n", name, enumtype); 1436 Delete(ns); 1437 1438 // walk children. 1439 Node *c; 1440 for (c = firstChild(n); c; c = nextSibling(c)) { 1441 if (!Getattr(c, "error")) { 1442 String *val = Getattr(c, "enumvalue"); 1443 if (!val) 1444 val = Getattr(c, "enumvalueex"); 1445 String *converted_val = convert_literal(val, Getattr(c, "type")); 1446 String *valname = Getattr(c, "sym:name"); 1447 1448 if (converted_val) { 1449 Printf(f_clhead, "(swig-defconstant \"%s\" %s)\n", valname, converted_val); 1450 Delete(converted_val); 1451 } else { 1452 Swig_warning(WARN_LANG_DISCARD_CONST, Getfile(n), Getline(n), "Unable to parse enum value '%s'. Setting to NIL\n", val); 1453 Printf(f_clhead, "(swig-defconstant \"%s\" nil #| %s |#)\n", valname, val); 1454 } 1455 } 1456 } 1457 } 1458 Printf(f_clhead, "\n"); 1459 1460#ifdef ALLEGROCL_WRAP_DEBUG 1461 Printf(stderr, "emit_enum_type_no_wrap: EXIT\n"); 1462#endif 1463 1464} 1465 1466void emit_enum_type(Node *n) { 1467 1468#ifdef ALLEGROCL_WRAP_DEBUG 1469 Printf(stderr, "emit_enum_type: ENTER... \n"); 1470#endif 1471 1472 if (!Generate_Wrapper) { 1473 emit_enum_type_no_wrap(n); 1474 return; 1475 } 1476 1477 String *unnamed = Getattr(n, "unnamed"); 1478 String *name; 1479 // SwigType *enumtype; 1480 1481 name = unnamed ? Getattr(n, "allegrocl:name") : Getattr(n, "sym:name"); 1482 SwigType *tmp = NewStringf("enum %s", unnamed ? unnamed : name); 1483 1484 Node *node = NewHash(); 1485 Setattr(node, "type", tmp); 1486 Setfile(node, Getfile(n)); 1487 Setline(node, Getline(n)); 1488 const String *enumtype = Swig_typemap_lookup("ffitype", node, "", 0); 1489 Delete(node); 1490 1491 Delete(tmp); 1492 1493 if (name) { 1494 String *ns = listify_namespace(current_namespace); 1495 1496 Printf(f_clhead, "(swig-def-foreign-type \"%s\" %s)\n", name, enumtype); 1497 Delete(ns); 1498 1499 // walk children. 1500 Node *c; 1501 for(c = firstChild(n); c; c=nextSibling(c)) { 1502 String *mangled_name = mangle_name(c, "ACL_ENUM", Getattr(c,"allegrocl:package")); 1503 Printf(f_clhead, "(swig-defvar \"%s\" \"%s\" :type :constant :ftype :signed-long)\n", Getattr(c, "sym:name"), mangled_name); 1504 Delete(mangled_name); 1505 } 1506 } 1507#ifdef ALLEGROCL_WRAP_DEBUG 1508 Printf(stderr, "emit_enum_type: EXIT\n"); 1509#endif 1510 1511} 1512 1513void emit_default_linked_type(Node *n) { 1514 1515#ifdef ALLEGROCL_WRAP_DEBUG 1516 Printf(stderr, "emit_default_linked_type: ENTER... \n"); 1517#endif 1518 1519 // catchall for non class types. 1520 if (!Strcmp(nodeType(n), "classforward")) { 1521 Printf(f_clhead, ";; forward referenced stub.\n"); 1522 Printf(f_clhead, "(swig-def-foreign-class \"%s\" (ff:foreign-pointer) (:class ))\n\n", Getattr(n, "sym:name")); 1523 } else if (!Strcmp(nodeType(n), "enum")) { 1524 emit_enum_type(n); 1525 } else { 1526 Printf(stderr, "Don't know how to emit node type '%s' named '%s'\n", nodeType(n), Getattr(n, "name")); 1527 } 1528 1529#ifdef ALLEGROCL_WRAP_DEBUG 1530 Printf(stderr, "emit_default_linked_type: EXIT\n"); 1531#endif 1532 1533} 1534 1535void dump_linked_types(File *f) { 1536 Node *n = first_linked_type; 1537 int i = 0; 1538 while (n) { 1539 Printf(f, "%d: (%x) node '%s' name '%s'\n", i++, n, nodeType(n), Getattr(n, "sym:name")); 1540 1541 Node *t = Getattr(n, "allegrocl:synonym-of"); 1542 if (t) 1543 Printf(f, " synonym-of %s(%x)\n", Getattr(t, "name"), t); 1544 n = Getattr(n, "allegrocl:next_linked_type"); 1545 } 1546} 1547 1548void emit_linked_types() { 1549 1550#ifdef ALLEGROCL_WRAP_DEBUG 1551 Printf(stderr, "emit_linked_types: ENTER... "); 1552#endif 1553 1554 Node *n = first_linked_type; 1555 1556 while (n) { 1557 String *node_type = nodeType(n); 1558 1559 // Printf(stderr,"emitting node %s(%x) of type %s.", Getattr(n,"name"),n, nodeType(n)); 1560 if (!Strcmp(node_type, "class") || !Strcmp(node_type, "templateInst")) { 1561 // may need to emit a stub, so it will update the package itself. 1562 // Printf(stderr," Passing to emit_class."); 1563 emit_class(n); 1564 } …
Large files files are truncated, but you can click here to view the full file