PageRenderTime 156ms CodeModel.GetById 20ms app.highlight 122ms RepoModel.GetById 1ms app.codeStats 1ms

/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