Source/Modules/cffi.cxx

   1 /* -----------------------------------------------------------------------------
   2  * See the LICENSE file for information on copyright, usage and redistribution
   3  * of SWIG, and the README file for authors - http://www.swig.org/release.html.
   4  *
   5  * cffi.cxx
   6  *
   7  * cffi language module for SWIG.
   8  * ----------------------------------------------------------------------------- */
   9
  10 char cvsroot_cffi_cxx[] = "$Id: cffi.cxx 11380 2009-07-08 12:17:45Z wsfulton $";
  11
  12 #include "swigmod.h"
  13 #include "cparse.h"
  14 #include <ctype.h>
  15
  16 //#define CFFI_DEBUG
  17 //#define CFFI_WRAP_DEBUG
  18
  19 class CFFI:public Language {
  20 public:
  21   String *f_cl;
  22   String *f_clhead;
  23   String *f_clwrap;
  24   bool CWrap;     // generate wrapper file for C code?
  25   File *f_begin;
  26   File *f_runtime;
  27   File *f_cxx_header;
  28   File *f_cxx_wrapper;
  29   File *f_clos;
  30
  31   String *module;
  32   virtual void main(int argc, char *argv[]);
  33   virtual int top(Node *n);
  34   virtual int functionWrapper(Node *n);
  35   virtual int variableWrapper(Node *n);
  36   virtual int constantWrapper(Node *n);
  37   //  virtual int classDeclaration(Node *n);
  38   virtual int enumDeclaration(Node *n);
  39   virtual int typedefHandler(Node *n);
  40
  41   //c++ specific code
  42   virtual int constructorHandler(Node *n);
  43   virtual int destructorHandler(Node *n);
  44   virtual int memberfunctionHandler(Node *n);
  45   virtual int membervariableHandler(Node *n);
  46   virtual int classHandler(Node *n);
  47
  48 private:
  49   void emit_defun(Node *n, String *name);
  50   void emit_defmethod(Node *n);
  51   void emit_initialize_instance(Node *n);
  52   void emit_getter(Node *n);
  53   void emit_setter(Node *n);
  54   void emit_class(Node *n);
  55   void emit_struct_union(Node *n, bool un);
  56   void emit_export(Node *n, String *name);
  57   void emit_inline(Node *n, String *name);
  58   String *lispy_name(char *name);
  59   String *lispify_name(Node *n, String *ty, const char *flag, bool kw = false);
  60   String *convert_literal(String *num_param, String *type, bool try_to_split = true);
  61   String *infix_to_prefix(String *val, char split_op, const String *op, String *type);
  62   String *strip_parens(String *string);
  63   String *trim(String *string);
  64   int generate_typedef_flag;
  65   bool no_swig_lisp;
  66 };
  67
  68 void CFFI::main(int argc, char *argv[]) {
  69   int i;
  70
  71   Preprocessor_define("SWIGCFFI 1", 0);
  72   SWIG_library_directory("cffi");
  73   SWIG_config_file("cffi.swg");
  74   generate_typedef_flag = 0;
  75   no_swig_lisp = false;
  76   CWrap = false;
  77   for (i = 1; i < argc; i++) {
  78     if (!Strcmp(argv[i], "-help")) {
  79       Printf(stdout, "cffi Options (available with -cffi)\n");
  80       Printf(stdout,
  81        "   -generate-typedef\n"
  82        "\tIf this option is given then defctype will be used to generate\n"
  83        "\tshortcuts according to the typedefs in the input.\n"
  84        "   -[no]cwrap\n"
  85        "\tTurn on or turn off generation of an intermediate C file when\n"
  86        "\tcreating a C interface. By default this is only done for C++ code.\n"
  87        "   -[no]swig-lisp\n"
  88        "\tTurns on or off generation of code for helper lisp macro, functions,\n"
  89        "\tetc. which SWIG uses while generating wrappers. These macros, functions\n" "\tmay still be used by generated wrapper code.\n");
  90     } else if (!strcmp(argv[i], "-cwrap")) {
  91       CWrap = true;
  92       Swig_mark_arg(i);
  93     } else if ((Strcmp(argv[i], "-generate-typedef") == 0)) {
  94       generate_typedef_flag = 1;
  95       Swig_mark_arg(i);
  96     } else if (!strcmp(argv[i], "-nocwrap")) {
  97       CWrap = false;
  98       Swig_mark_arg(i);
  99     } else if (!strcmp(argv[i], "-swig-lisp")) {
 100       no_swig_lisp = false;
 101       Swig_mark_arg(i);
 102     } else if (!strcmp(argv[i], "-noswig-lisp")) {
 103       no_swig_lisp = true;
 104       Swig_mark_arg(i);
 105     }
 106
 107   }
 108   f_clhead = NewString("");
 109   f_clwrap = NewString("");
 110   f_cl = NewString("");
 111
 112   allow_overloading();
 113 }
 114
 115 int CFFI::top(Node *n) {
 116   File *f_null = NewString("");
 117   module = Getattr(n, "name");
 118
 119   String *cxx_filename = Getattr(n, "outfile");
 120   String *lisp_filename = NewString("");
 121
 122   Printf(lisp_filename, "%s%s.lisp", SWIG_output_directory(), module);
 123
 124   File *f_lisp = NewFile(lisp_filename, "w", SWIG_output_files());
 125   if (!f_lisp) {
 126     FileErrorDisplay(lisp_filename);
 127     SWIG_exit(EXIT_FAILURE);
 128   }
 129
 130   if (CPlusPlus || CWrap) {
 131     f_begin = NewFile(cxx_filename, "w", SWIG_output_files());
 132     if (!f_begin) {
 133       Close(f_lisp);
 134       Delete(f_lisp);
 135       Printf(stderr, "Unable to open %s for writing\n", cxx_filename);
 136       SWIG_exit(EXIT_FAILURE);
 137     }
 138
 139     String *clos_filename = NewString("");
 140     Printf(clos_filename, "%s%s-clos.lisp", SWIG_output_directory(), module);
 141     f_clos = NewFile(clos_filename, "w", SWIG_output_files());
 142     if (!f_clos) {
 143       Close(f_lisp);
 144       Delete(f_lisp);
 145       Printf(stderr, "Unable to open %s for writing\n", cxx_filename);
 146       SWIG_exit(EXIT_FAILURE);
 147     }
 148   } else {
 149     f_begin = NewString("");
 150     f_clos = NewString("");
 151   }
 152
 153   f_runtime = NewString("");
 154   f_cxx_header = f_runtime;
 155   f_cxx_wrapper = NewString("");
 156
 157   Swig_register_filebyname("header", f_cxx_header);
 158   Swig_register_filebyname("wrapper", f_cxx_wrapper);
 159   Swig_register_filebyname("begin", f_begin);
 160   Swig_register_filebyname("runtime", f_runtime);
 161   Swig_register_filebyname("lisphead", f_clhead);
 162   if (!no_swig_lisp)
 163     Swig_register_filebyname("swiglisp", f_cl);
 164   else
 165     Swig_register_filebyname("swiglisp", f_null);
 166
 167   Swig_banner(f_begin);
 168
 169   Printf(f_runtime, "\n");
 170   Printf(f_runtime, "#define SWIGCFFI\n");
 171   Printf(f_runtime, "\n");
 172
 173   Swig_banner_target_lang(f_lisp, ";;;");
 174
 175   Language::top(n);
 176   Printf(f_lisp, "%s\n", f_clhead);
 177   Printf(f_lisp, "%s\n", f_cl);
 178   Printf(f_lisp, "%s\n", f_clwrap);
 179
 180   Close(f_lisp);
 181   Delete(f_lisp);   // Deletes the handle, not the file
 182   Delete(f_cl);
 183   Delete(f_clhead);
 184   Delete(f_clwrap);
 185   Dump(f_runtime, f_begin);
 186   Close(f_begin);
 187   Delete(f_runtime);
 188   Delete(f_begin);
 189   Delete(f_cxx_wrapper);
 190   Delete(f_null);
 191
 192   return SWIG_OK;
 193 }
 194
 195 int CFFI::classHandler(Node *n) {
 196 #ifdef CFFI_DEBUG
 197   Printf(stderr, "class %s::%s\n", "some namespace",  //current_namespace,
 198    Getattr(n, "sym:name"));
 199 #endif
 200   String *name = Getattr(n, "sym:name");
 201   String *kind = Getattr(n, "kind");
 202
 203   // maybe just remove this check and get rid of the else clause below.
 204   if (Strcmp(kind, "struct") == 0) {
 205     emit_struct_union(n, false);
 206     return SWIG_OK;
 207   } else if (Strcmp(kind, "union") == 0) {
 208     emit_struct_union(n, true);
 209     return SWIG_OK;
 210   } else if (Strcmp(kind, "class") == 0) {
 211     emit_class(n);
 212     Language::classHandler(n);
 213   } else {
 214     Printf(stderr, "Don't know how to deal with %s kind of class yet.\n", kind);
 215     Printf(stderr, " (name: %s)\n", name);
 216     SWIG_exit(EXIT_FAILURE);
 217     return SWIG_OK;
 218   }
 219
 220   return SWIG_OK;
 221 }
 222
 223 int CFFI::constructorHandler(Node *n) {
 224 #ifdef CFFI_DEBUG
 225   Printf(stderr, "constructor %s\n", Getattr(n, "name"));
 226   Printf(stderr, "constructor %s\n and %s and %s", Getattr(n, "kind"), Getattr(n, "sym:name"), Getattr(n, "allegrocl:old-sym:name"));
 227 #endif
 228   Setattr(n, "cffi:constructorfunction", "1");
 229   // Let SWIG generate a global forwarding function.
 230   return Language::constructorHandler(n);
 231 }
 232
 233 int CFFI::destructorHandler(Node *n) {
 234 #ifdef CFFI_DEBUG
 235   Printf(stderr, "destructor %s\n", Getattr(n, "name"));
 236 #endif
 237
 238   // Let SWIG generate a global forwarding function.
 239   return Language::destructorHandler(n);
 240 }
 241
 242 void CFFI::emit_defmethod(Node *n) {
 243   String *args_placeholder = NewStringf("");
 244   String *args_call = NewStringf("");
 245
 246   ParmList *pl = Getattr(n, "parms");
 247   int argnum = 0;
 248   Node *parent = getCurrentClass();
 249   bool first = 0;
 250
 251   for (Parm *p = pl; p; p = nextSibling(p), argnum++) {
 252     String *argname = Getattr(p, "name");
 253     String *ffitype = Swig_typemap_lookup("lispclass", p, "", 0);
 254
 255     int tempargname = 0;
 256
 257     if(!first)
 258       first = true;
 259     else
 260       Printf(args_placeholder, " ");
 261
 262     if (!argname) {
 263       argname = NewStringf("arg%d", argnum);
 264       tempargname = 1;
 265     } else if (Strcmp(argname, "t") == 0 || Strcmp(argname, "T") == 0) {
 266       argname = NewStringf("t-arg%d", argnum);
 267       tempargname = 1;
 268     }
 269     if (Len(ffitype) > 0)
 270       Printf(args_placeholder, "(%s %s)", argname, ffitype);
 271     else
 272       Printf(args_placeholder, "%s", argname);
 273
 274     if (ffitype && Strcmp(ffitype, lispify_name(parent, lispy_name(Char(Getattr(parent, "sym:name"))), "'classname")) == 0)
 275       Printf(args_call, " (ff-pointer %s)", argname);
 276     else
 277       Printf(args_call, " %s", argname);
 278
 279     Delete(ffitype);
 280
 281     if (tempargname)
 282       Delete(argname);
 283   }
 284
 285   String *method_name = Getattr(n, "name");
 286   int x = Replace(method_name, "operator ", "", DOH_REPLACE_FIRST); //
 287
 288   if (x == 1)
 289     Printf(f_clos, "(cl:shadow \"%s\")\n", method_name);
 290
 291   Printf(f_clos, "(cl:defmethod %s (%s)\n  (%s%s))\n\n",
 292          lispify_name(n, lispy_name(Char(method_name)), "'method"), args_placeholder,
 293          lispify_name(n, Getattr(n, "sym:name"), "'function"), args_call);
 294
 295 }
 296
 297 void CFFI::emit_initialize_instance(Node *n) {
 298   String *args_placeholder = NewStringf("");
 299   String *args_call = NewStringf("");
 300
 301   ParmList *pl = Getattr(n, "parms");
 302   int argnum = 0;
 303   Node *parent = getCurrentClass();
 304
 305   for (Parm *p = pl; p; p = nextSibling(p), argnum++) {
 306     String *argname = Getattr(p, "name");
 307     String *ffitype = Swig_typemap_lookup("lispclass", p, "", 0);
 308
 309     int tempargname = 0;
 310     if (!argname) {
 311       argname = NewStringf("arg%d", argnum);
 312       tempargname = 1;
 313     } else if (Strcmp(argname, "t") == 0 || Strcmp(argname, "T") == 0) {
 314       argname = NewStringf("t-arg%d", argnum);
 315       tempargname = 1;
 316     }
 317     if (Len(ffitype) > 0)
 318       Printf(args_placeholder, " (%s %s)", argname, ffitype);
 319     else
 320       Printf(args_placeholder, " %s", argname);
 321
 322     if (Strcmp(ffitype, lispify_name(parent, lispy_name(Char(Getattr(parent, "sym:name"))), "'classname")) == 0)
 323       Printf(args_call, " (ff-pointer %s)", argname);
 324     else
 325       Printf(args_call, " %s", argname);
 326
 327     Delete(ffitype);
 328
 329     if (tempargname)
 330       Delete(argname);
 331   }
 332
 333   Printf(f_clos, "(cl:defmethod initialize-instance :after ((obj %s) &key%s)\n  (setf (slot-value obj 'ff-pointer) (%s%s)))\n\n",
 334          lispify_name(parent, lispy_name(Char(Getattr(parent, "sym:name"))), "'class"), args_placeholder,
 335          lispify_name(n, Getattr(n, "sym:name"), "'function"), args_call);
 336
 337 }
 338
 339 void CFFI::emit_setter(Node *n) {
 340   Node *parent = getCurrentClass();
 341   Printf(f_clos, "(cl:defmethod (cl:setf %s) (arg0 (obj %s))\n  (%s (ff-pointer obj) arg0))\n\n",
 342          lispify_name(n, Getattr(n, "name"), "'method"),
 343          lispify_name(parent, lispy_name(Char(Getattr(parent, "sym:name"))), "'class"), lispify_name(n, Getattr(n, "sym:name"), "'function"));
 344 }
 345
 346
 347 void CFFI::emit_getter(Node *n) {
 348   Node *parent = getCurrentClass();
 349   Printf(f_clos, "(cl:defmethod %s ((obj %s))\n  (%s (ff-pointer obj)))\n\n",
 350          lispify_name(n, Getattr(n, "name"), "'method"),
 351          lispify_name(parent, lispy_name(Char(Getattr(parent, "sym:name"))), "'class"), lispify_name(n, Getattr(n, "sym:name"), "'function"));
 352 }
 353
 354 int CFFI::memberfunctionHandler(Node *n) {
 355   // Let SWIG generate a global forwarding function.
 356   Setattr(n, "cffi:memberfunction", "1");
 357   return Language::memberfunctionHandler(n);
 358 }
 359
 360 int CFFI::membervariableHandler(Node *n) {
 361   // Let SWIG generate a get/set function pair.
 362   Setattr(n, "cffi:membervariable", "1");
 363   return Language::membervariableHandler(n);
 364 }
 365
 366 int CFFI::functionWrapper(Node *n) {
 367
 368   ParmList *parms = Getattr(n, "parms");
 369   String *iname = Getattr(n, "sym:name");
 370   Wrapper *f = NewWrapper();
 371
 372   String *raw_return_type = Swig_typemap_lookup("ctype", n, "", 0);
 373   SwigType *return_type = Swig_cparse_type(raw_return_type);
 374   SwigType *resolved = SwigType_typedef_resolve_all(return_type);
 375   int is_void_return = (Cmp(resolved, "void") == 0);
 376   Delete(resolved);
 377
 378   if (!is_void_return) {
 379     String *lresult_init = NewStringf("lresult = (%s)0", raw_return_type);
 380     Wrapper_add_localv(f, "lresult", raw_return_type, lresult_init, NIL);
 381     Delete(lresult_init);
 382   }
 383
 384   String *overname = 0;
 385   if (Getattr(n, "sym:overloaded")) {
 386     overname = Getattr(n, "sym:overname");
 387   } else {
 388     if (!addSymbol(iname, n)) {
 389       DelWrapper(f);
 390       return SWIG_ERROR;
 391     }
 392   }
 393
 394   String *wname = Swig_name_wrapper(iname);
 395   if (overname) {
 396     Append(wname, overname);
 397   }
 398   Setattr(n, "wrap:name", wname);
 399
 400   // Emit all of the local variables for holding arguments.
 401   emit_parameter_variables(parms, f);
 402
 403   // Attach the standard typemaps
 404   Swig_typemap_attach_parms("ctype", parms, f);
 405   emit_attach_parmmaps(parms, f);
 406
 407   int num_arguments = emit_num_arguments(parms);
 408   String *name_and_parms = NewStringf("%s (", wname);
 409   int i;
 410   Parm *p;
 411   int gencomma = 0;
 412
 413 #ifdef CFFI_DEBUG
 414   Printf(stderr, "function  -  %s - %d\n", Getattr(n, "name"), num_arguments);
 415 #endif
 416
 417   for (i = 0, p = parms; i < num_arguments; i++) {
 418
 419     while (checkAttribute(p, "tmap:in:numinputs", "0")) {
 420       p = Getattr(p, "tmap:in:next");
 421     }
 422
 423     SwigType *c_parm_type = Swig_cparse_type(Getattr(p, "tmap:ctype"));
 424     String *arg = NewStringf("l%s", Getattr(p, "lname"));
 425
 426     // Emit parameter declaration
 427     if (gencomma)
 428       Printf(name_and_parms, ", ");
 429     String *parm_decl = SwigType_str(c_parm_type, arg);
 430     Printf(name_and_parms, "%s", parm_decl);
 431 #ifdef CFFI_DEBUG
 432     Printf(stderr, "  param: %s\n", parm_decl);
 433 #endif
 434     Delete(parm_decl);
 435     gencomma = 1;
 436
 437     // Emit parameter conversion code
 438     String *parm_code = Getattr(p, "tmap:in");
 439     {
 440       Replaceall(parm_code, "$input", arg);
 441       Setattr(p, "emit:input", arg);
 442       Printf(f->code, "%s\n", parm_code);
 443       p = Getattr(p, "tmap:in:next");
 444     }
 445
 446     Delete(arg);
 447   }
 448   Printf(name_and_parms, ")");
 449
 450   // Emit the function definition
 451   String *signature = SwigType_str(return_type, name_and_parms);
 452   Printf(f->def, "EXPORT %s {", signature);
 453   Printf(f->code, "  try {\n");
 454
 455   String *actioncode = emit_action(n);
 456
 457   String *result_convert = Swig_typemap_lookup_out("out", n, "result", f, actioncode);
 458   Replaceall(result_convert, "$result", "lresult");
 459   Printf(f->code, "%s\n", result_convert);
 460   if(!is_void_return) Printf(f->code, "    return lresult;\n");
 461   Delete(result_convert);
 462   emit_return_variable(n, Getattr(n, "type"), f);
 463
 464   Printf(f->code, "  } catch (...) {\n");
 465   if (!is_void_return)
 466     Printf(f->code, "    return (%s)0;\n", raw_return_type);
 467   Printf(f->code, "  }\n");
 468   Printf(f->code, "}\n");
 469
 470   if (CPlusPlus)
 471     Wrapper_print(f, f_runtime);
 472
 473   if (CPlusPlus) {
 474     emit_defun(n, wname);
 475     if (Getattr(n, "cffi:memberfunction"))
 476       emit_defmethod(n);
 477     else if (Getattr(n, "cffi:membervariable")) {
 478       if (Getattr(n, "memberget"))
 479         emit_getter(n);
 480       else if (Getattr(n, "memberset"))
 481         emit_setter(n);
 482     }
 483     else if (Getattr(n, "cffi:constructorfunction")) {
 484       emit_initialize_instance(n);
 485     }
 486   } else
 487     emit_defun(n, iname);
 488
 489   //   if (!overloaded || !Getattr(n, "sym:nextSibling")) {
 490   //     update_package_if_needed(n);
 491   //     emit_buffered_defuns(n);
 492   //     // this is the last overload.
 493   //     if (overloaded) {
 494   //       emit_dispatch_defun(n);
 495   //     }
 496   //   }
 497
 498   Delete(wname);
 499   DelWrapper(f);
 500
 501   return SWIG_OK;
 502 }
 503
 504
 505 void CFFI::emit_defun(Node *n, String *name) {
 506
 507   //   String *storage=Getattr(n,"storage");
 508   //   if(!storage || (Strcmp(storage,"extern") && Strcmp(storage,"externc")))
 509   //     return SWIG_OK;
 510
 511   String *func_name = Getattr(n, "sym:name");
 512
 513   ParmList *pl = Getattr(n, "parms");
 514
 515   int argnum = 0;
 516
 517   func_name = lispify_name(n, func_name, "'function");
 518
 519   emit_inline(n, func_name);
 520
 521   Printf(f_cl, "\n(cffi:defcfun (\"%s\" %s)", name, func_name);
 522   String *ffitype = Swig_typemap_lookup("cout", n, ":pointer", 0);
 523
 524   Printf(f_cl, " %s", ffitype);
 525   Delete(ffitype);
 526
 527   for (Parm *p = pl; p; p = nextSibling(p), argnum++) {
 528
 529     if (SwigType_isvarargs(Getattr(p, "type"))) {
 530       Printf(f_cl, "\n  %s", NewString("&rest"));
 531       continue;
 532     }
 533
 534     String *argname = Getattr(p, "name");
 535
 536     ffitype = Swig_typemap_lookup("cin", p, "", 0);
 537
 538     int tempargname = 0;
 539     if (!argname) {
 540
 541       argname = NewStringf("arg%d", argnum);
 542       tempargname = 1;
 543     } else if (Strcmp(argname, "t") == 0 || Strcmp(argname, "T") == 0) {
 544       argname = NewStringf("t_arg%d", argnum);
 545       tempargname = 1;
 546     }
 547
 548     Printf(f_cl, "\n  (%s %s)", argname, ffitype);
 549
 550     Delete(ffitype);
 551
 552     if (tempargname)
 553       Delete(argname);
 554   }
 555   Printf(f_cl, ")\n");    /* finish arg list */
 556
 557   emit_export(n, func_name);
 558 }
 559
 560
 561 int CFFI::constantWrapper(Node *n) {
 562   String *type = Getattr(n, "type");
 563   String *converted_value = convert_literal(Getattr(n, "value"), type);
 564   String *name = lispify_name(n, Getattr(n, "sym:name"), "'constant");
 565
 566   if (Strcmp(name, "t") == 0 || Strcmp(name, "T") == 0)
 567     name = NewStringf("t_var");
 568
 569   Printf(f_cl, "\n(cl:defconstant %s %s)\n", name, converted_value);
 570   Delete(converted_value);
 571
 572   emit_export(n, name);
 573   return SWIG_OK;
 574 }
 575
 576 int CFFI::variableWrapper(Node *n) {
 577   //  String *storage=Getattr(n,"storage");
 578   //  Printf(stdout,"\"%s\" %s)\n",storage,Getattr(n, "sym:name"));
 579
 580   //  if(!storage || (Strcmp(storage,"extern") && Strcmp(storage,"externc")))
 581   //    return SWIG_OK;
 582
 583   String *var_name = Getattr(n, "sym:name");
 584   String *lisp_type = Swig_typemap_lookup("cin", n, "", 0);
 585   String *lisp_name = lispify_name(n, var_name, "'variable");
 586
 587   if (Strcmp(lisp_name, "t") == 0 || Strcmp(lisp_name, "T") == 0)
 588     lisp_name = NewStringf("t_var");
 589
 590   Printf(f_cl, "\n(cffi:defcvar (\"%s\" %s)\n %s)\n", var_name, lisp_name, lisp_type);
 591
 592   Delete(lisp_type);
 593
 594   emit_export(n, lisp_name);
 595   return SWIG_OK;
 596 }
 597
 598 int CFFI::typedefHandler(Node *n) {
 599   if (generate_typedef_flag && strncmp(Char(Getattr(n, "type")), "enum", 4)) {
 600     String *lisp_name = lispify_name(n, Getattr(n, "name"), "'typename");
 601     Printf(f_cl, "\n(cffi:defctype %s %s)\n", lisp_name, Swig_typemap_lookup("cin", n, "", 0));
 602     emit_export(n, lisp_name);
 603   }
 604   return Language::typedefHandler(n);
 605 }
 606
 607 int CFFI::enumDeclaration(Node *n) {
 608   String *name = Getattr(n, "sym:name");
 609   bool slot_name_keywords;
 610   String *lisp_name = 0;
 611   if (name && Len(name) != 0) {
 612     lisp_name = lispify_name(n, name, "'enumname");
 613     if (GetFlag(n, "feature:bitfield")) {
 614       Printf(f_cl, "\n(cffi:defbitfield %s", lisp_name);
 615     } else {
 616       Printf(f_cl, "\n(cffi:defcenum %s", lisp_name);
 617     }
 618     slot_name_keywords = true;
 619
 620     //Registering the enum name to the cin and cout typemaps
 621     Parm *pattern = NewParm(name, NULL);
 622     Swig_typemap_register("cin", pattern, lisp_name, NULL, NULL);
 623     Swig_typemap_register("cout", pattern, lisp_name, NULL, NULL);
 624     Delete(pattern);
 625     //Registering with the kind, i.e., enum
 626     pattern = NewParm(NewStringf("enum %s", name), NULL);
 627     Swig_typemap_register("cin", pattern, lisp_name, NULL, NULL);
 628     Swig_typemap_register("cout", pattern, lisp_name, NULL, NULL);
 629     Delete(pattern);
 630
 631   } else {
 632     Printf(f_cl, "\n(defanonenum %s", name);
 633     slot_name_keywords = false;
 634   }
 635
 636   for (Node *c = firstChild(n); c; c = nextSibling(c)) {
 637
 638     String *slot_name = lispify_name(c, Getattr(c, "name"), "'enumvalue", slot_name_keywords);
 639     String *value = Getattr(c, "enumvalue");
 640
 641     if (!value || GetFlag(n, "feature:bitfield:ignore_values"))
 642       Printf(f_cl, "\n\t%s", slot_name);
 643     else {
 644       String *type = Getattr(c, "type");
 645       String *converted_value = convert_literal(value, type);
 646       Printf(f_cl, "\n\t(%s #.%s)", slot_name, converted_value);
 647       Delete(converted_value);
 648     }
 649     Delete(value);
 650   }
 651
 652   Printf(f_cl, ")\n");
 653
 654   // No need to export keywords
 655   if (lisp_name && Len(lisp_name) != 0) {
 656     emit_export(n, lisp_name);
 657   } else {
 658     for (Node *c = firstChild(n); c; c = nextSibling(c))
 659       emit_export(c, lispify_name(c, Getattr(c, "name"), "'enumvalue"));
 660   }
 661
 662   return SWIG_OK;
 663 }
 664 void CFFI::emit_class(Node *n) {
 665
 666 #ifdef CFFI_WRAP_DEBUG
 667   Printf(stderr, "emit_class: ENTER... '%s'(%x)\n", Getattr(n, "sym:name"), n);
 668 #endif
 669
 670   String *name = Getattr(n, "sym:name");
 671   String *lisp_name = lispify_name(n, lispy_name(Char(name)), "'classname");
 672
 673   String *bases = Getattr(n, "bases");
 674   String *supers = NewString("(");
 675   if (bases) {
 676     int first = 1;
 677     for (Iterator i = First(bases); i.item; i = Next(i)) {
 678       if (!first)
 679   Printf(supers, " ");
 680       String *s = Getattr(i.item, "name");
 681       Printf(supers, "%s", lispify_name(i.item, s, "'classname"));
 682     }
 683   } else {
 684     // Printf(supers,"ff:foreign-pointer");
 685   }
 686
 687   Printf(supers, ")");
 688   Printf(f_clos, "\n(cl:defclass %s%s", lisp_name, supers);
 689   Printf(f_clos, "\n  ((ff-pointer :reader ff-pointer)))\n\n");
 690
 691   Parm *pattern = NewParm(Getattr(n, "name"), NULL);
 692
 693   Swig_typemap_register("lispclass", pattern, lisp_name, NULL, NULL);
 694   SwigType_add_pointer(Getattr(pattern, "type"));
 695   Swig_typemap_register("lispclass", pattern, lisp_name, NULL, NULL);
 696   SwigType_add_qualifier(Getattr(pattern, "type"), "const");
 697   Swig_typemap_register("lispclass", pattern, lisp_name, NULL, NULL);
 698   SwigType_del_pointer(Getattr(pattern, "type"));
 699   SwigType_add_reference(Getattr(pattern, "type"));
 700   Swig_typemap_register("lispclass", pattern, lisp_name, NULL, NULL);
 701
 702 #ifdef CFFI_WRAP_DEBUG
 703   Printf(stderr, "  pattern %s  name %s .. ... %s .\n", pattern, lisp_name);
 704 #endif
 705
 706   Delete(pattern);
 707
 708   // Walk children to generate type definition.
 709   String *slotdefs = NewString("   ");
 710
 711 #ifdef CFFI_WRAP_DEBUG
 712   Printf(stderr, "  walking children...\n");
 713 #endif
 714
 715   Node *c;
 716   for (c = firstChild(n); c; c = nextSibling(c)) {
 717     String *storage_type = Getattr(c, "storage");
 718     if ((!Strcmp(nodeType(c), "cdecl") && (!storage_type || Strcmp(storage_type, "typedef")))) {
 719       String *access = Getattr(c, "access");
 720
 721       // hack. why would decl have a value of "variableHandler" and now "0"?
 722       String *childDecl = Getattr(c, "decl");
 723       // Printf(stderr,"childDecl = '%s' (%s)\n", childDecl, Getattr(c,"view"));
 724       if (!Strcmp(childDecl, "0"))
 725   childDecl = NewString("");
 726
 727       SwigType *childType = NewStringf("%s%s", childDecl,
 728                Getattr(c, "type"));
 729       String *cname = (access && Strcmp(access, "public")) ? NewString("nil") : Copy(Getattr(c, "name"));
 730
 731       if (!SwigType_isfunction(childType)) {
 732   // Printf(slotdefs, ";;; member functions don't appear as slots.\n ");
 733   // Printf(slotdefs, ";; ");
 734   //        String *ns = listify_namespace(Getattr(n, "cffi:package"));
 735   String *ns = NewString("");
 736 #ifdef CFFI_WRAP_DEBUG
 737   Printf(stderr, "slot name = '%s' ns = '%s' class-of '%s' and type = '%s'\n", cname, ns, name, childType);
 738 #endif
 739   Printf(slotdefs, "(#.(swig-insert-id \"%s\" %s :type :slot :class \"%s\") %s)", cname, ns, name, childType);  //compose_foreign_type(childType)
 740   Delete(ns);
 741   if (access && Strcmp(access, "public"))
 742     Printf(slotdefs, " ;; %s member", access);
 743
 744   Printf(slotdefs, "\n   ");
 745       }
 746       Delete(childType);
 747       Delete(cname);
 748     }
 749   }
 750
 751
 752   //   String *ns_list = listify_namespace(Getattr(n,"cffi:namespace"));
 753   //   update_package_if_needed(n,f_clhead);
 754   //   Printf(f_clos,
 755   //          "(swig-def-foreign-class \"%s\"\n %s\n  (:%s\n%s))\n\n",
 756   //          name, supers, kind, slotdefs);
 757
 758   Delete(supers);
 759   //  Delete(ns_list);
 760
 761   //  Parm *pattern = NewParm(name,NULL);
 762   // Swig_typemap_register("cin",pattern,lisp_name,NULL,NULL);
 763   //Swig_typemap_register("cout",pattern,lisp_name,NULL,NULL);
 764   //Delete(pattern);
 765
 766 #ifdef CFFI_WRAP_DEBUG
 767   Printf(stderr, "emit_class: EXIT\n");
 768 #endif
 769 }
 770
 771 // Includes structs
 772 void CFFI::emit_struct_union(Node *n, bool un = false) {
 773 #ifdef CFFI_DEBUG
 774   Printf(stderr, "struct/union %s\n", Getattr(n, "name"));
 775   Printf(stderr, "struct/union %s\n and %s", Getattr(n, "kind"), Getattr(n, "sym:name"));
 776 #endif
 777
 778   String *name = Getattr(n, "sym:name");
 779   String *kind = Getattr(n, "kind");
 780
 781   if (Strcmp(kind, "struct") != 0 && Strcmp(kind, "union") != 0) {
 782     Printf(stderr, "Don't know how to deal with %s kind of class yet.\n", kind);
 783     Printf(stderr, " (name: %s)\n", name);
 784     SWIG_exit(EXIT_FAILURE);
 785   }
 786   String *lisp_name = lispify_name(n, name, "'classname");
 787
 788   //Register the struct/union name to the cin and cout typemaps
 789
 790   Parm *pattern = NewParm(name, NULL);
 791   Swig_typemap_register("cin", pattern, lisp_name, NULL, NULL);
 792   Swig_typemap_register("cout", pattern, lisp_name, NULL, NULL);
 793   Delete(pattern);
 794   //Registering with the kind, i.e., struct or union
 795   pattern = NewParm(NewStringf("%s %s", kind, name), NULL);
 796   Swig_typemap_register("cin", pattern, lisp_name, NULL, NULL);
 797   Swig_typemap_register("cout", pattern, lisp_name, NULL, NULL);
 798   Delete(pattern);
 799
 800   if (un) {
 801     Printf(f_cl, "\n(cffi:defcunion %s", lisp_name);
 802   } else
 803     Printf(f_cl, "\n(cffi:defcstruct %s", lisp_name);
 804
 805
 806   for (Node *c = firstChild(n); c; c = nextSibling(c)) {
 807 #ifdef CFFI_DEBUG
 808     Printf(stderr, "struct/union %s\n", Getattr(c, "name"));
 809     Printf(stderr, "struct/union %s and %s \n", Getattr(c, "kind"), Getattr(c, "sym:name"));
 810 #endif
 811
 812     if (Strcmp(nodeType(c), "cdecl")) {
 813       //C declaration ignore
 814       //        Printf(stderr, "Structure %s has a slot that we can't deal with.\n",
 815       //               name);
 816       //        Printf(stderr, "nodeType: %s, name: %s, type: %s\n",
 817       //               nodeType(c),
 818       //               Getattr(c, "name"),
 819       //               Getattr(c, "type"));
 820       //       SWIG_exit(EXIT_FAILURE);
 821     } else {
 822       SwigType *childType = NewStringf("%s%s", Getattr(c, "decl"), Getattr(c, "type"));
 823
 824       Node *node = NewHash();
 825       Setattr(node, "type", childType);
 826       Setfile(node, Getfile(n));
 827       Setline(node, Getline(n));
 828       const String *tm = Swig_typemap_lookup("cin", node, "", 0);
 829
 830       String *typespec = tm ? NewString(tm) : NewString("");
 831
 832       String *slot_name = lispify_name(c, Getattr(c, "sym:name"), "'slotname");
 833       if (Strcmp(slot_name, "t") == 0 || Strcmp(slot_name, "T") == 0)
 834         slot_name = NewStringf("t_var");
 835
 836       Printf(f_cl, "\n\t(%s %s)", slot_name, typespec);
 837
 838       Delete(node);
 839       Delete(childType);
 840       Delete(typespec);
 841     }
 842   }
 843
 844   Printf(f_cl, ")\n");
 845
 846   emit_export(n, lisp_name);
 847   for (Node *child = firstChild(n); child; child = nextSibling(child)) {
 848     if (!Strcmp(nodeType(child), "cdecl")) {
 849       emit_export(child, lispify_name(child, Getattr(child, "sym:name"), "'slotname"));
 850     }
 851   }
 852
 853   /* Add this structure to the known lisp types */
 854   //Printf(stdout, "Adding %s foreign type\n", name);
 855   //  add_defined_foreign_type(name);
 856
 857 }
 858
 859 void CFFI::emit_export(Node *n, String *name) {
 860   if (GetInt(n, "feature:export"))
 861     Printf(f_cl, "\n(cl:export '%s)\n", name);
 862 }
 863
 864 void CFFI::emit_inline(Node *n, String *name) {
 865   if (GetInt(n, "feature:inline"))
 866     Printf(f_cl, "\n(cl:declaim (cl:inline %s))\n", name);
 867 }
 868
 869 String *CFFI::lispify_name(Node *n, String *ty, const char *flag, bool kw) {
 870   String *intern_func = Getattr(n, "feature:intern_function");
 871   if (intern_func) {
 872     if (Strcmp(intern_func, "1") == 0)
 873       intern_func = NewStringf("swig-lispify");
 874     return NewStringf("#.(%s \"%s\" %s%s)", intern_func, ty, flag, kw ? " :keyword" : "");
 875   } else if (kw)
 876     return NewStringf(":%s", ty);
 877   else
 878     return ty;
 879 }
 880
 881 /* utilities */
 882 /* returns new string w/ parens stripped */
 883 String *CFFI::strip_parens(String *string) {
 884   char *s = Char(string), *p;
 885   int len = Len(string);
 886   String *res;
 887
 888   if (len == 0 || s[0] != '(' || s[len - 1] != ')') {
 889     return NewString(string);
 890   }
 891
 892   p = (char *) malloc(len - 2 + 1);
 893   if (!p) {
 894     Printf(stderr, "Malloc failed\n");
 895     SWIG_exit(EXIT_FAILURE);
 896   }
 897
 898   strncpy(p, s + 1, len - 1);
 899   p[len - 2] = 0;   /* null terminate */
 900
 901   res = NewString(p);
 902   free(p);
 903
 904   return res;
 905 }
 906
 907 String *CFFI::trim(String *str) {
 908   char *c = Char(str);
 909   while (*c != '\0' && isspace((int) *c))
 910     ++c;
 911   String *result = NewString(c);
 912   Chop(result);
 913   return result;
 914 }
 915
 916 String *CFFI::infix_to_prefix(String *val, char split_op, const String *op, String *type) {
 917   List *ored = Split(val, split_op, -1);
 918
 919   // some float hackery
 920   //i don't understand it, if you do then please explain
 921   //   if ( ((split_op == '+') || (split_op == '-')) && Len(ored) == 2 &&
 922   //        (SwigType_type(type) == T_FLOAT || SwigType_type(type) == T_DOUBLE ||
 923   //    SwigType_type(type) == T_LONGDOUBLE) ) {
 924   //     // check that we're not splitting a float
 925   //     String *possible_result = convert_literal(val, type, false);
 926   //     if (possible_result) return possible_result;
 927
 928   //   }
 929
 930   // try parsing the split results. if any part fails, kick out.
 931   bool part_failed = false;
 932   if (Len(ored) > 1) {
 933     String *result = NewStringf("(%s", op);
 934     for (Iterator i = First(ored); i.item; i = Next(i)) {
 935       String *converted = convert_literal(i.item, type);
 936       if (converted) {
 937   Printf(result, " %s", converted);
 938   Delete(converted);
 939       } else {
 940   part_failed = true;
 941   break;
 942       }
 943     }
 944     Printf(result, ")");
 945     Delete(ored);
 946     return part_failed ? 0 : result;
 947   } else {
 948     Delete(ored);
 949   }
 950   return 0;
 951 }
 952
 953 /* To be called by code generating the lisp interface
 954    Will return a String containing the literal based on type.
 955    Will return null if there are problems.
 956
 957    try_to_split defaults to true (see stub above).
 958 */
 959 String *CFFI::convert_literal(String *literal, String *type, bool try_to_split) {
 960   String *num_param = Copy(literal);
 961   String *trimmed = trim(num_param);
 962   String *num = strip_parens(trimmed), *res = 0;
 963   Delete(trimmed);
 964   char *s = Char(num);
 965
 966   // very basic parsing of infix expressions.
 967   if (try_to_split) {
 968     if ((res = infix_to_prefix(num, '|', "cl:logior", type)))
 969       return res;
 970     if ((res = infix_to_prefix(num, '&', "cl:logand", type)))
 971       return res;
 972     if ((res = infix_to_prefix(num, '^', "cl:logxor", type)))
 973       return res;
 974     if ((res = infix_to_prefix(num, '*', "cl:*", type)))
 975       return res;
 976     if ((res = infix_to_prefix(num, '/', "cl:/", type)))
 977       return res;
 978     if ((res = infix_to_prefix(num, '+', "cl:+", type)))
 979       return res;
 980     if ((res = infix_to_prefix(num, '-', "cl:-", type)))
 981       return res;
 982   }
 983
 984   if (SwigType_type(type) == T_FLOAT || SwigType_type(type) == T_DOUBLE || SwigType_type(type) == T_LONGDOUBLE) {
 985     // Use CL syntax for float literals
 986
 987     // careful. may be a float identifier or float constant.
 988     char *num_start = Char(num);
 989     char *num_end = num_start + strlen(num_start) - 1;
 990
 991     bool is_literal = isdigit(*num_start) || (*num_start == '.') || (*num_start == '+') || (*num_start == '-');
 992
 993     String *lisp_exp = 0;
 994     if (is_literal) {
 995       if (*num_end == 'f' || *num_end == 'F') {
 996         lisp_exp = NewString("f");
 997       } else {
 998         lisp_exp = NewString("d");
 999       }
1000
1001       if (*num_end == 'l' || *num_end == 'L' || *num_end == 'f' || *num_end == 'F') {
1002         *num_end = '\0';
1003         num_end--;
1004       }
1005
1006       int exponents = Replaceall(num, "e", lisp_exp) + Replaceall(num, "E", lisp_exp);
1007
1008       if (!exponents)
1009         Printf(num, "%s0", lisp_exp);
1010
1011       if (exponents > 1 || (exponents + Replaceall(num, ".", ".") == 0)) {
1012         Delete(num);
1013         num = 0;
1014       }
1015     }
1016     return num;
1017   } else if (SwigType_type(type) == T_CHAR) {
1018     /* Use CL syntax for character literals */
1019     String* result = NewStringf("#\\%c", s[2]);
1020     Delete(num);
1021     //    Printf(stderr, "%s  %c %d", s, s[2], s);
1022     return result;
1023   } else if (SwigType_type(type) == T_STRING) {
1024     /* Use CL syntax for string literals */
1025     String* result = NewStringf("\"%s\"", num_param);
1026     Delete(num);
1027     return result;
1028   } else if (SwigType_type(type) == T_INT || SwigType_type(type) == T_UINT) {
1029     // Printf(stderr, "Is a T_INT or T_UINT %s, before replaceall\n", s);
1030     Replaceall(num, "u", "");
1031     Replaceall(num, "U", "");
1032     Replaceall(num, "l", "");
1033     Replaceall(num, "L", "");
1034
1035     int i, j;
1036     if (sscanf(s, "%d >> %d", &i, &j) == 2) {
1037       String* result = NewStringf("(cl:ash %d -%d)", i, j);
1038       Delete(num);
1039       return result;
1040     } else if (sscanf(s, "%d << %d", &i, &j) == 2) {
1041       String* result = NewStringf("(cl:ash %d %d)", i, j);
1042       Delete(num);
1043       return result;
1044     }
1045   }
1046
1047   if (Len(num) >= 2 && s[0] == '0') { /* octal or hex */
1048     if (s[1] == 'x'){
1049       DohReplace(num,"0","#",DOH_REPLACE_FIRST);
1050     }
1051     else{
1052       DohReplace(num,"0","#o",DOH_REPLACE_FIRST);
1053     }
1054   }
1055   return num;
1056 }
1057
1058 //less flexible as it does the conversion in C, the lispify name does the conversion in lisp
1059 String *CFFI::lispy_name(char *name) {
1060   bool helper = false;
1061   String *new_name = NewString("");
1062   for (unsigned int i = 0; i < strlen(name); i++) {
1063     if (name[i] == '_' || name[i] == '-') {
1064       Printf(new_name, "%c", '-');
1065       helper = false;
1066     } else if (name[i] >= 'A' && name[i] <= 'Z') {
1067       if (helper)
1068   Printf(new_name, "%c", '-');
1069       Printf(new_name, "%c", ('a' + (name[i] - 'A')));
1070       helper = false;
1071     } else {
1072       helper = true;
1073       Printf(new_name, "%c", name[i]);
1074     }
1075   }
1076   return new_name;
1077 }
1078
1079 extern "C" Language *swig_cffi(void) {
1080   return new CFFI();
1081 }