Source/Modules/r.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  * r.cxx
   6  *
   7  * R language module for SWIG.
   8  * ----------------------------------------------------------------------------- */
   9
  10 char cvsroot_r_cxx[] = "$Id: r.cxx 11454 2009-07-26 21:21:26Z wsfulton $";
  11
  12 #include "swigmod.h"
  13
  14 #define UNUSED(a)  (void)a
  15
  16 static const double DEFAULT_NUMBER = .0000123456712312312323;
  17 static const int MAX_OVERLOAD_ARGS = 5;
  18
  19 static String* replaceInitialDash(const String *name)
  20 {
  21   String *retval;
  22   if (!Strncmp(name, "_", 1)) {
  23     retval = Copy(name);
  24     Insert(retval, 0, "s");
  25   } else {
  26     retval = Copy(name);
  27   }
  28   return retval;
  29 }
  30
  31 static String * getRTypeName(SwigType *t, int *outCount = NULL) {
  32   String *b = SwigType_base(t);
  33   List *els = SwigType_split(t);
  34   int count = 0;
  35   int i;
  36
  37   if(Strncmp(b, "struct ", 7) == 0)
  38     Replace(b, "struct ", "", DOH_REPLACE_FIRST);
  39
  40   /* Printf(stderr, "<getRTypeName> %s,base = %s\n", t, b);
  41      for(i = 0; i < Len(els); i++)
  42      Printf(stderr, "%d) %s, ", i, Getitem(els,i));
  43      Printf(stderr, "\n"); */
  44
  45   for(i = 0; i < Len(els); i++) {
  46     String *el = Getitem(els, i);
  47     if(Strcmp(el, "p.") == 0 || Strncmp(el, "a(", 2) == 0) {
  48       count++;
  49       Append(b, "Ref");
  50     }
  51   }
  52   if(outCount)
  53     *outCount = count;
  54
  55   String *tmp = NewString("");
  56   char *retName = Char(SwigType_manglestr(t));
  57   Insert(tmp, 0, retName);
  58   return tmp;
  59
  60   /*
  61   if(count)
  62     return(b);
  63
  64   Delete(b);
  65   return(NewString(""));
  66   */
  67 }
  68
  69 #if 0
  70 static String * getRType(Node *n) {
  71   SwigType *elType = Getattr(n, "type");
  72   SwigType *elDecl = Getattr(n, "decl");
  73   //XXX How can we tell if this is already done.
  74   SwigType_push(elType, elDecl);
  75   String *ans;
  76
  77   String *rtype = Swig_typemap_lookup("rtype", n, "", 0);
  78   String *i = getRTypeName(elType);
  79
  80   if(Len(i) == 0) {
  81     SwigType *td = SwigType_typedef_resolve(elType);
  82     if(td) {
  83       //     Printf(stderr, "Resolving typedef %s -> %s\n", elType, td);
  84       i = getRTypeName(td);
  85     }
  86   }
  87   //  Printf(stderr, "<getRType> i = %s,  rtype = %s  (for %s)\n",
  88   //     i, rtype, elType);
  89   if(rtype) {
  90     ans = NewString("");
  91     Printf(ans, "%s", rtype);
  92     Replaceall(ans, "$R_class", Char(i));
  93     //  Printf(stderr, "Found r type in typemap for %s (for %s) => %s (%s) => %s\n",
  94     //         SwigType_str(elType, 0), Getattr(n, "name"), rtype, i, ans);
  95   } else {
  96     ans = i;
  97   }
  98
  99   return(ans);
 100 }
 101 #endif
 102
 103 /*********************
 104  Tries to get the name of the R class corresponding  to the given type
 105   e.g. struct A * is ARef,  struct A**  is  ARefRef.
 106   Now handles arrays, i.e. struct A[2]
 107 ****************/
 108
 109 static String *getRClassName(String *retType, int /*addRef*/ = 1, int upRef=0) {
 110   String *tmp = NewString("");
 111   SwigType *resolved = SwigType_typedef_resolve_all(retType);
 112   char *retName = Char(SwigType_manglestr(resolved));
 113   if (upRef) {
 114     Printf(tmp, "_p%s", retName);
 115   } else{
 116     Insert(tmp, 0, retName);
 117   }
 118
 119   return tmp;
 120 /*
 121 #if 1
 122   List *l = SwigType_split(retType);
 123   int n = Len(l);
 124   if(!l || n == 0) {
 125 #ifdef R_SWIG_VERBOSE
 126     if (debugMode)
 127       Printf(stderr, "SwigType_split return an empty list for %s\n",
 128              retType);
 129 #endif
 130     return(tmp);
 131   }
 132
 133
 134   String *el = Getitem(l, n-1);
 135   char *ptr = Char(el);
 136   if(strncmp(ptr, "struct ", 7) == 0)
 137     ptr += 7;
 138
 139   Printf(tmp, "%s", ptr);
 140
 141   if(addRef) {
 142     for(int i = 0; i < n; i++) {
 143       if(Strcmp(Getitem(l, i), "p.") == 0 ||
 144          Strncmp(Getitem(l, i), "a(", 2) == 0)
 145         Printf(tmp, "Ref");
 146     }
 147   }
 148
 149 #else
 150   char *retName = Char(SwigType_manglestr(retType));
 151   if(!retName)
 152     return(tmp);
 153
 154   if(addRef) {
 155     while(retName && strlen(retName) > 1 && strncmp(retName, "_p", 2) == 0)  {
 156       retName += 2;
 157       Printf(tmp, "Ref");
 158     }
 159   }
 160   if(retName[0] == '_')
 161     retName ++;
 162   Insert(tmp, 0, retName);
 163 #endif
 164
 165   return tmp;
 166 */
 167 }
 168
 169 /*********************
 170  Tries to get the name of the R class corresponding  to the given type
 171   e.g. struct A * is ARef,  struct A**  is  ARefRef.
 172   Now handles arrays, i.e. struct A[2]
 173 ****************/
 174
 175 static String * getRClassNameCopyStruct(String *retType, int addRef) {
 176   String *tmp = NewString("");
 177
 178 #if 1
 179   List *l = SwigType_split(retType);
 180   int n = Len(l);
 181   if(!l || n == 0) {
 182 #ifdef R_SWIG_VERBOSE
 183     Printf(stderr, "SwigType_split return an empty list for %s\n", retType);
 184 #endif
 185     return(tmp);
 186   }
 187
 188
 189   String *el = Getitem(l, n-1);
 190   char *ptr = Char(el);
 191   if(strncmp(ptr, "struct ", 7) == 0)
 192     ptr += 7;
 193
 194   Printf(tmp, "%s", ptr);
 195
 196   if(addRef) {
 197     for(int i = 0; i < n; i++) {
 198       if(Strcmp(Getitem(l, i), "p.") == 0 ||
 199          Strncmp(Getitem(l, i), "a(", 2) == 0)
 200         Printf(tmp, "Ref");
 201     }
 202   }
 203
 204 #else
 205   char *retName = Char(SwigType_manglestr(retType));
 206   if(!retName)
 207     return(tmp);
 208
 209   if(addRef) {
 210     while(retName && strlen(retName) > 1 &&
 211           strncmp(retName, "_p", 2) == 0)  {
 212       retName += 2;
 213       Printf(tmp, "Ref");
 214     }
 215   }
 216
 217   if(retName[0] == '_')
 218     retName ++;
 219   Insert(tmp, 0, retName);
 220 #endif
 221
 222   return tmp;
 223 }
 224
 225
 226 /*********************************
 227   Write the elements of a list to the File*, one element per line.
 228   If quote  is true, surround the element with "element".
 229   This takes care of inserting a tab in front of each line and also
 230   a comma after each element, except the last one.
 231 **********************************/
 232
 233 static void writeListByLine(List *l, File *out, bool quote = 0) {
 234   int i, n = Len(l);
 235   for(i = 0; i < n; i++)
 236     Printf(out, "%s%s%s%s%s\n", tab8,
 237            quote ? "\"" :"",
 238            Getitem(l, i),
 239            quote ? "\"" :"", i < n-1 ? "," : "");
 240 }
 241
 242
 243 static const char *usage = (char *)"\
 244 R Options (available with -r)\n\
 245      -copystruct      - Emit R code to copy C structs (on by default)\n\
 246      -cppcast         - Enable C++ casting operators (default) \n\
 247      -debug           - Output debug\n\
 248      -dll <name>      - Name of the DLL (without the .dll or .so suffix). Default is the module name.\n\
 249      -gc              - Aggressive garbage collection\n\
 250      -memoryprof      - Add memory profile\n\
 251      -namespace       - Output NAMESPACE file\n\
 252      -no-init-code    - Turn off the generation of the R_init_<pkgname> code (registration information still generated)\n\
 253      -package <name>  - Package name for the PACKAGE argument of the R .Call() invocations. Default is the module name.\n\
 254 ";
 255
 256
 257
 258 /************
 259  Display the help for this module on the screen/console.
 260 *************/
 261 static void showUsage() {
 262   fputs(usage, stdout);
 263 }
 264
 265 static bool expandTypedef(SwigType *t) {
 266   if (SwigType_isenum(t)) return false;
 267   String *prefix = SwigType_prefix(t);
 268   if (Strncmp(prefix, "f", 1)) return false;
 269   if (Strncmp(prefix, "p.f", 3)) return false;
 270   return true;
 271 }
 272
 273
 274 /*****
 275       Determine whether  we should add a .copy argument to the S function
 276       that wraps/interfaces to the routine that returns the given type.
 277 *****/
 278 static int addCopyParameter(SwigType *type) {
 279   int ok = 0;
 280   ok = Strncmp(type, "struct ", 7) == 0 || Strncmp(type, "p.struct ", 9) == 0;
 281   if(!ok) {
 282     ok = Strncmp(type, "p.", 2);
 283   }
 284
 285   return(ok);
 286 }
 287
 288 static void replaceRClass(String *tm, SwigType *type) {
 289   String *tmp = getRClassName(type);
 290   String *tmp_base = getRClassName(type, 0);
 291   String *tmp_ref = getRClassName(type, 1, 1);
 292   Replaceall(tm, "$R_class", tmp);
 293   Replaceall(tm, "$*R_class", tmp_base);
 294   Replaceall(tm, "$&R_class", tmp_ref);
 295   Delete(tmp); Delete(tmp_base); Delete(tmp_ref);
 296 }
 297
 298 static double getNumber(String *value, String *type) {
 299   UNUSED(type);
 300
 301   double d = DEFAULT_NUMBER;
 302   if(Char(value)) {
 303     //        Printf(stderr, "getNumber %s %s\n", Char(value), type);
 304     if(sscanf(Char(value), "%lf", &d) != 1)
 305       return(DEFAULT_NUMBER);
 306   }
 307   return(d);
 308 }
 309
 310 class R : public Language {
 311 public:
 312   R();
 313   void registerClass(Node *n);
 314   void main(int argc, char *argv[]);
 315   int top(Node *n);
 316
 317   void dispatchFunction(Node *n);
 318   int functionWrapper(Node *n);
 319   int variableWrapper(Node *n);
 320
 321   int classDeclaration(Node *n);
 322   int enumDeclaration(Node *n);
 323
 324   int membervariableHandler(Node *n);
 325
 326   int typedefHandler(Node *n);
 327
 328   int memberfunctionHandler(Node *n) {
 329     if (debugMode)
 330       Printf(stderr, "<memberfunctionHandler> %s %s\n",
 331              Getattr(n, "name"),
 332              Getattr(n, "type"));
 333     member_name = Getattr(n, "name");
 334     processing_class_member_function = 1;
 335     int status = Language::memberfunctionHandler(n);
 336     processing_class_member_function = 0;
 337     return status;
 338   }
 339
 340   /* Grab the name of the current class being processed so that we can
 341      deal with members of that class. */
 342   int classHandler(Node *n){
 343     if(!ClassMemberTable)
 344       ClassMemberTable = NewHash();
 345
 346     class_name = Getattr(n, "name");
 347     int status = Language::classHandler(n);
 348
 349     class_name = NULL;
 350     return status;
 351   }
 352
 353   // Not used:
 354   String *runtimeCode();
 355
 356 protected:
 357   int addRegistrationRoutine(String *rname, int nargs);
 358   int outputRegistrationRoutines(File *out);
 359
 360   int outputCommandLineArguments(File *out);
 361   int generateCopyRoutines(Node *n);
 362   int DumpCode(Node *n);
 363
 364   int OutputMemberReferenceMethod(String *className, int isSet, List *el, File *out);
 365   int OutputArrayMethod(String *className, List *el, File *out);
 366   int OutputClassMemberTable(Hash *tb, File *out);
 367   int OutputClassMethodsTable(File *out);
 368   int OutputClassAccessInfo(Hash *tb, File *out);
 369
 370   int defineArrayAccessors(SwigType *type);
 371
 372   void addNamespaceFunction(String *name) {
 373     if(!namespaceFunctions)
 374       namespaceFunctions = NewList();
 375     Append(namespaceFunctions, name);
 376   }
 377
 378   void addNamespaceMethod(String *name) {
 379     if(!namespaceMethods)
 380       namespaceMethods = NewList();
 381     Append(namespaceMethods, name);
 382   }
 383
 384   String* processType(SwigType *t, Node *n, int *nargs = NULL);
 385   String *createFunctionPointerHandler(SwigType *t, Node *n, int *nargs);
 386   int addFunctionPointerProxy(String *name, Node *n, SwigType *t, String *s_paramTypes) {
 387     /*XXX Do we need to put the t in there to get the return type later. */
 388     if(!functionPointerProxyTable)
 389       functionPointerProxyTable = NewHash();
 390
 391     Setattr(functionPointerProxyTable, name, n);
 392
 393     Setattr(SClassDefs, name, name);
 394     Printv(s_classes, "setClass('",
 395            name,
 396            "',\n", tab8,
 397            "prototype = list(parameterTypes = c(", s_paramTypes, "),\n",
 398            tab8, tab8, tab8,
 399            "returnType = '", SwigType_manglestr(t), "'),\n", tab8,
 400            "contains = 'CRoutinePointer')\n\n##\n", NIL);
 401
 402     return SWIG_OK;
 403   }
 404
 405
 406   void addSMethodInfo(String *name,
 407                       String *argType, int nargs);
 408   // Simple initialization such as constant strings that can be reused.
 409   void init();
 410
 411
 412   void addAccessor(String *memberName, Wrapper *f,
 413                    String *name, int isSet = -1);
 414
 415   static int getFunctionPointerNumArgs(Node *n, SwigType *tt);
 416
 417 protected:
 418   bool copyStruct;
 419   bool memoryProfile;
 420   bool aggressiveGc;
 421
 422   // Strings into which we cumulate the generated code that is to be written
 423   //vto the files.
 424   String *sfile;
 425   String *f_init;
 426   String *s_classes;
 427   String *f_begin;
 428   String *f_runtime;
 429   String *f_wrapper;
 430   String *s_header;
 431   String *f_wrappers;
 432   String *s_init;
 433   String *s_init_routine;
 434   String *s_namespace;
 435
 436   // State variables that carry information across calls to functionWrapper()
 437   // from  member accessors and class declarations.
 438   String *opaqueClassDeclaration;
 439   int processing_variable;
 440   int processing_member_access_function;
 441   String *member_name;
 442   String *class_name;
 443
 444
 445   int processing_class_member_function;
 446   List *class_member_functions;
 447   List *class_member_set_functions;
 448
 449   /* */
 450   Hash *ClassMemberTable;
 451   Hash *ClassMethodsTable;
 452   Hash *SClassDefs;
 453   Hash *SMethodInfo;
 454
 455   // Information about routines that are generated and to be registered with
 456   // R for dynamic lookup.
 457   Hash *registrationTable;
 458   Hash *functionPointerProxyTable;
 459
 460   List *namespaceFunctions;
 461   List *namespaceMethods;
 462   List *namespaceClasses; // Probably can do this from ClassMemberTable.
 463
 464
 465   // Store a copy of the command line.
 466   // Need only keep a string that has it formatted.
 467   char **Argv;
 468   int    Argc;
 469   bool inCPlusMode;
 470
 471   // State variables that we remember from the command line settings
 472   // potentially that govern the code we generate.
 473   String *DllName;
 474   String *Rpackage;
 475   bool    noInitializationCode;
 476   bool    outputNamespaceInfo;
 477
 478   String *UnProtectWrapupCode;
 479
 480   // Static members
 481   static bool debugMode;
 482 };
 483
 484 R::R() :
 485   copyStruct(false),
 486   memoryProfile(false),
 487   aggressiveGc(false),
 488   sfile(0),
 489   f_init(0),
 490   s_classes(0),
 491   f_begin(0),
 492   f_runtime(0),
 493   f_wrapper(0),
 494   s_header(0),
 495   f_wrappers(0),
 496   s_init(0),
 497   s_init_routine(0),
 498   s_namespace(0),
 499   opaqueClassDeclaration(0),
 500   processing_variable(0),
 501   processing_member_access_function(0),
 502   member_name(0),
 503   class_name(0),
 504   processing_class_member_function(0),
 505   class_member_functions(0),
 506   class_member_set_functions(0),
 507   ClassMemberTable(0),
 508   ClassMethodsTable(0),
 509   SClassDefs(0),
 510   SMethodInfo(0),
 511   registrationTable(0),
 512   functionPointerProxyTable(0),
 513   namespaceFunctions(0),
 514   namespaceMethods(0),
 515   namespaceClasses(0),
 516   Argv(0),
 517   Argc(0),
 518   inCPlusMode(false),
 519   DllName(0),
 520   Rpackage(0),
 521   noInitializationCode(false),
 522   outputNamespaceInfo(false),
 523   UnProtectWrapupCode(0) {
 524 }
 525
 526 bool R::debugMode = false;
 527
 528 int R::getFunctionPointerNumArgs(Node *n, SwigType *tt) {
 529   (void) tt;
 530   n = Getattr(n, "type");
 531   if (debugMode)
 532     Printf(stderr, "type: %s\n", n);
 533 #if 0
 534   SwigType *tmp = SwigType_typedef_resolve(tt);
 535
 536   n = SwigType_typedef_resolve(tt);
 537 #endif
 538
 539   ParmList *parms = Getattr(n, "parms");
 540   if (debugMode)
 541     Printf(stderr, "parms = %p\n", parms);
 542   return ParmList_len(parms);
 543 }
 544
 545
 546 void R::addSMethodInfo(String *name, String *argType, int nargs) {
 547   (void) argType;
 548
 549   if(!SMethodInfo)
 550     SMethodInfo = NewHash();
 551   if (debugMode)
 552     Printf(stderr, "[addMethodInfo] %s\n", name);
 553
 554   Hash *tb = Getattr(SMethodInfo, name);
 555
 556   if(!tb) {
 557     tb = NewHash();
 558     Setattr(SMethodInfo, name, tb);
 559   }
 560
 561   String *str = Getattr(tb, "max");
 562   int max = -1;
 563   if(str)
 564     max = atoi(Char(str));
 565   if(max < nargs) {
 566     if(str)  Delete(str);
 567     str = NewStringf("%d", max);
 568     Setattr(tb, "max", str);
 569   }
 570 }
 571
 572 /*
 573 Returns the name of the new routine.
 574 */
 575 String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) {
 576   String *funName = SwigType_manglestr(t);
 577
 578   /* See if we have already processed this one. */
 579   if(functionPointerProxyTable && Getattr(functionPointerProxyTable, funName))
 580     return funName;
 581
 582   if (debugMode)
 583     Printf(stderr, "<createFunctionPointerHandler> Defining %s\n",  t);
 584
 585   SwigType *rettype = Copy(Getattr(n, "type"));
 586   SwigType *funcparams = SwigType_functionpointer_decompose(rettype);
 587   String *rtype = SwigType_str(rettype, 0);
 588
 589   //   ParmList *parms = Getattr(n, "parms");
 590   // memory leak
 591   ParmList *parms = SwigType_function_parms(SwigType_del_pointer(Copy(t)));
 592
 593
 594   //  if (debugMode) {
 595     Printf(stderr, "Type: %s\n", t);
 596     Printf(stderr, "Return type: %s\n", SwigType_base(t));
 597     //}
 598
 599   bool isVoidType = Strcmp(rettype, "void") == 0;
 600   if (debugMode)
 601     Printf(stderr, "%s is void ? %s  (%s)\n", funName, isVoidType ? "yes" : "no", rettype);
 602
 603   Wrapper *f = NewWrapper();
 604
 605   /* Go through argument list, attach lnames for arguments */
 606   int i = 0;
 607   Parm *p = parms;
 608   for (i = 0; p; p = nextSibling(p), ++i) {
 609     String *arg = Getattr(p, "name");
 610     String *lname = NewString("");
 611
 612     if (!arg && Cmp(Getattr(p, "type"), "void")) {
 613       lname = NewStringf("s_arg%d", i+1);
 614       Setattr(p, "name", lname);
 615     } else
 616       lname = arg;
 617
 618     Setattr(p, "lname", lname);
 619   }
 620
 621   Swig_typemap_attach_parms("out", parms, f);
 622   Swig_typemap_attach_parms("scoerceout", parms, f);
 623   Swig_typemap_attach_parms("scheck", parms, f);
 624
 625   Printf(f->def, "%s %s(", rtype, funName);
 626
 627   emit_parameter_variables(parms, f);
 628   emit_return_variable(n, rettype, f);
 629 //  emit_attach_parmmaps(parms,f);
 630
 631   /*  Using weird name and struct to avoid potential conflicts. */
 632   Wrapper_add_local(f, "r_swig_cb_data", "RCallbackFunctionData *r_swig_cb_data = R_SWIG_getCallbackFunctionData()");
 633   String *lvar = NewString("r_swig_cb_data");
 634
 635   Wrapper_add_local(f, "r_tmp", "SEXP r_tmp"); // for use in converting arguments to R objects for call.
 636   Wrapper_add_local(f, "r_nprotect", "int r_nprotect = 0"); // for use in converting arguments to R objects for call.
 637   Wrapper_add_local(f, "r_vmax", "char * r_vmax= 0"); // for use in converting arguments to R objects for call.
 638
 639   // Add local for error code in return value.  This is not in emit_return_variable because that assumes an out typemap
 640   // whereas the type makes are reverse
 641   Wrapper_add_local(f, "ecode", "int ecode = 0");
 642
 643   p = parms;
 644   int nargs = ParmList_len(parms);
 645   if(numArgs) {
 646     *numArgs = nargs;
 647     if (debugMode)
 648       Printf(stderr, "Setting number of parameters to %d\n", *numArgs);
 649   }
 650   String *setExprElements = NewString("");
 651
 652   String *s_paramTypes = NewString("");
 653   for(i = 0; p; i++) {
 654     SwigType *tt = Getattr(p, "type");
 655     SwigType *name = Getattr(p, "name");
 656     //       String   *lname  = Getattr(p,"lname");
 657     Printf(f->def,  "%s %s", SwigType_str(tt, 0), name);
 658     String *tm = Getattr(p, "tmap:out");
 659     if(tm) {
 660       Replaceall(tm, "$1", name);
 661       Replaceall(tm, "$result", "r_tmp");
 662       replaceRClass(tm, Getattr(p,"type"));
 663       Replaceall(tm,"$owner", "R_SWIG_EXTERNAL");
 664     }
 665
 666     Printf(setExprElements, "%s\n", tm);
 667     Printf(setExprElements, "SETCAR(r_swig_cb_data->el, %s);\n", "r_tmp");
 668     Printf(setExprElements, "r_swig_cb_data->el = CDR(r_swig_cb_data->el);\n\n");
 669
 670     Printf(s_paramTypes, "'%s'", SwigType_manglestr(tt));
 671
 672
 673     p = nextSibling(p);
 674     if(p) {
 675       Printf(f->def, ", ");
 676       Printf(s_paramTypes, ", ");
 677     }
 678   }
 679
 680   Printf(f->def,  ") {\n");
 681
 682   Printf(f->code, "Rf_protect(%s->expr = Rf_allocVector(LANGSXP, %d));\n", lvar, nargs + 1);
 683   Printf(f->code, "r_nprotect++;\n");
 684   Printf(f->code, "r_swig_cb_data->el = r_swig_cb_data->expr;\n\n");
 685
 686   Printf(f->code, "SETCAR(r_swig_cb_data->el, r_swig_cb_data->fun);\n");
 687   Printf(f->code, "r_swig_cb_data->el = CDR(r_swig_cb_data->el);\n\n");
 688
 689   Printf(f->code, "%s\n\n", setExprElements);
 690
 691   Printv(f->code, "r_swig_cb_data->retValue = R_tryEval(",
 692          "r_swig_cb_data->expr,",
 693          " R_GlobalEnv,",
 694          " &r_swig_cb_data->errorOccurred",
 695          ");\n",
 696          NIL);
 697
 698   Printv(f->code, "\n",
 699          "if(r_swig_cb_data->errorOccurred) {\n",
 700          "R_SWIG_popCallbackFunctionData(1);\n",
 701          "Rf_error(\"error in calling R function as a function pointer (",
 702          funName,
 703          ")\");\n",
 704          "}\n",
 705          NIL);
 706
 707
 708
 709   if(!isVoidType) {
 710     /* Need to deal with the return type of the function pointer, not the function pointer itself.
 711        So build a new node that has the relevant pieces.
 712        XXX  Have to be a little more clever so that we can deal with struct A * - the * is getting lost.
 713        Is this still true? If so, will a SwigType_push() solve things?
 714     */
 715     Node *bbase = NewHash();
 716
 717     Setattr(bbase, "type", rettype);
 718     Setattr(bbase, "name", NewString("result"));
 719     String *returnTM = Swig_typemap_lookup("in", bbase, "result", f);
 720     if(returnTM) {
 721       String *tm = returnTM;
 722       Replaceall(tm,"$input", "r_swig_cb_data->retValue");
 723       Replaceall(tm,"$target", "result");
 724       replaceRClass(tm, rettype);
 725       Replaceall(tm,"$owner", "R_SWIG_EXTERNAL");
 726       Replaceall(tm,"$disown","0");
 727       Printf(f->code, "%s\n", tm);
 728     }
 729     Delete(bbase);
 730   }
 731
 732   Printv(f->code, "R_SWIG_popCallbackFunctionData(1);\n", NIL);
 733   Printv(f->code, "\n", UnProtectWrapupCode, NIL);
 734
 735   if(!isVoidType)
 736     Printv(f->code,  "return result;\n", NIL);
 737
 738   Printv(f->code, "\n}\n", NIL);
 739
 740   /* To coerce correctly in S, we really want to have an extra/intermediate
 741      function that handles the scoerceout.
 742      We need to check if any of the argument types have an entry in
 743      that map. If none do, the ignore and call the function straight.
 744      Otherwise, generate the a marshalling function.
 745      Need to be able to find it in S. Or use an entirely generic one
 746      that evaluates the expressions.
 747      Handle errors in the evaluation of the function by restoring
 748      the stack, if there is one in use for this function (i.e. no
 749      userData).
 750   */
 751
 752   Wrapper_print(f, f_wrapper);
 753
 754   addFunctionPointerProxy(funName, n, t, s_paramTypes);
 755   Delete(s_paramTypes);
 756   Delete(rtype);
 757   Delete(rettype);
 758   Delete(funcparams);
 759
 760   return funName;
 761 }
 762
 763 void R::init() {
 764   UnProtectWrapupCode =
 765     NewStringf("%s", "vmaxset(r_vmax);\nif(r_nprotect)  Rf_unprotect(r_nprotect);\n\n");
 766
 767   SClassDefs = NewHash();
 768
 769   sfile = NewString("");
 770   f_init = NewString("");
 771   s_header = NewString("");
 772   f_begin = NewString("");
 773   f_runtime = NewString("");
 774   f_wrapper = NewString("");
 775   s_classes = NewString("");
 776   s_init = NewString("");
 777   s_init_routine = NewString("");
 778 }
 779
 780
 781
 782 #if 0
 783 int R::cDeclaration(Node *n) {
 784   SwigType *t = Getattr(n, "type");
 785   SwigType *name = Getattr(n, "name");
 786   if (debugMode)
 787     Printf(stderr, "cDeclaration (%s): %s\n", name, SwigType_lstr(t, 0));
 788   return Language::cDeclaration(n);
 789 }
 790 #endif
 791
 792
 793 /**
 794    Method from Language that is called to start the entire
 795    processing off, i.e. the generation of the code.
 796    It is called after the input has been read and parsed.
 797    Here we open the output streams and generate the code.
 798 ***/
 799 int R::top(Node *n) {
 800   String *module = Getattr(n, "name");
 801   if(!Rpackage)
 802     Rpackage = Copy(module);
 803   if(!DllName)
 804     DllName = Copy(module);
 805
 806   if(outputNamespaceInfo) {
 807     s_namespace = NewString("");
 808     Swig_register_filebyname("snamespace", s_namespace);
 809     Printf(s_namespace, "useDynLib(%s)\n", DllName);
 810   }
 811
 812   /* Associate the different streams with names so that they can be used in %insert directives by the
 813      typemap code. */
 814   Swig_register_filebyname("sinit", s_init);
 815   Swig_register_filebyname("sinitroutine", s_init_routine);
 816
 817   Swig_register_filebyname("begin", f_begin);
 818   Swig_register_filebyname("runtime", f_runtime);
 819   Swig_register_filebyname("init", f_init);
 820   Swig_register_filebyname("header", s_header);
 821   Swig_register_filebyname("wrapper", f_wrapper);
 822   Swig_register_filebyname("s", sfile);
 823   Swig_register_filebyname("sclasses", s_classes);
 824
 825   Swig_banner(f_begin);
 826
 827   Printf(f_runtime, "\n");
 828   Printf(f_runtime, "#define SWIGR\n");
 829   Printf(f_runtime, "\n");
 830
 831
 832   Swig_banner_target_lang(s_init, "#");
 833   outputCommandLineArguments(s_init);
 834
 835   Printf(f_wrapper, "#ifdef __cplusplus\n");
 836   Printf(f_wrapper, "extern \"C\" {\n");
 837   Printf(f_wrapper, "#endif\n\n");
 838
 839   Language::top(n);
 840
 841   Printf(f_wrapper, "#ifdef __cplusplus\n");
 842   Printf(f_wrapper, "}\n");
 843   Printf(f_wrapper, "#endif\n");
 844
 845   String *type_table = NewString("");
 846   SwigType_emit_type_table(f_runtime,f_wrapper);
 847   Delete(type_table);
 848
 849   if(ClassMemberTable) {
 850     //XXX OutputClassAccessInfo(ClassMemberTable, sfile);
 851     Delete(ClassMemberTable);
 852     ClassMemberTable = NULL;
 853   }
 854
 855   Printf(f_init,"}\n");
 856   if(registrationTable)
 857     outputRegistrationRoutines(f_init);
 858
 859   /* Now arrange to write the 2 files - .S and .c. */
 860
 861   DumpCode(n);
 862
 863   Delete(sfile);
 864   Delete(s_classes);
 865   Delete(s_init);
 866   Delete(f_wrapper);
 867   Delete(f_init);
 868
 869   Delete(s_header);
 870   Close(f_begin);
 871   Delete(f_runtime);
 872   Delete(f_begin);
 873
 874   return SWIG_OK;
 875 }
 876
 877
 878 /*****************************************************
 879   Write the generated code  to the .S and the .c files.
 880 ****************************************************/
 881 int R::DumpCode(Node *n) {
 882   String *output_filename = NewString("");
 883
 884
 885   /* The name of the file in which we will generate the S code. */
 886   Printf(output_filename, "%s%s.R", SWIG_output_directory(), Rpackage);
 887
 888 #ifdef R_SWIG_VERBOSE
 889   Printf(stderr, "Writing S code to %s\n", output_filename);
 890 #endif
 891
 892   File *scode = NewFile(output_filename, "w", SWIG_output_files());
 893   if (!scode) {
 894     FileErrorDisplay(output_filename);
 895     SWIG_exit(EXIT_FAILURE);
 896   }
 897   Delete(output_filename);
 898
 899
 900   Printf(scode, "%s\n\n", s_init);
 901   Printf(scode, "%s\n\n", s_classes);
 902   Printf(scode, "%s\n", sfile);
 903
 904   Close(scode);
 905   //  Delete(scode);
 906   String *outfile = Getattr(n,"outfile");
 907   File *runtime = NewFile(outfile,"w", SWIG_output_files());
 908   if (!runtime) {
 909     FileErrorDisplay(outfile);
 910     SWIG_exit(EXIT_FAILURE);
 911   }
 912
 913   Printf(runtime, "%s", f_begin);
 914   Printf(runtime, "%s\n", f_runtime);
 915   Printf(runtime, "%s\n", s_header);
 916   Printf(runtime, "%s\n", f_wrapper);
 917   Printf(runtime, "%s\n", f_init);
 918
 919   Close(runtime);
 920   Delete(runtime);
 921
 922   if(outputNamespaceInfo) {
 923     output_filename = NewString("");
 924     Printf(output_filename, "%sNAMESPACE", SWIG_output_directory());
 925     File *ns = NewFile(output_filename, "w", SWIG_output_files());
 926     if (!ns) {
 927       FileErrorDisplay(output_filename);
 928       SWIG_exit(EXIT_FAILURE);
 929     }
 930     Delete(output_filename);
 931
 932     Printf(ns, "%s\n", s_namespace);
 933
 934     Printf(ns, "\nexport(\n");
 935     writeListByLine(namespaceFunctions, ns);
 936     Printf(ns, ")\n");
 937     Printf(ns, "\nexportMethods(\n");
 938     writeListByLine(namespaceFunctions, ns, 1);
 939     Printf(ns, ")\n");
 940     Close(ns);
 941     Delete(ns);
 942     Delete(s_namespace);
 943   }
 944
 945   return SWIG_OK;
 946 }
 947
 948
 949
 950 /*
 951   We may need to do more.... so this is left as a
 952   stub for the moment.
 953 */
 954 int R::OutputClassAccessInfo(Hash *tb, File *out) {
 955   int n = OutputClassMemberTable(tb, out);
 956   OutputClassMethodsTable(out);
 957   return n;
 958 }
 959
 960 /************************************************************************
 961   Currently this just writes the information collected about the
 962   different methods of the C++ classes that have been processed
 963   to the console.
 964   This will be used later to define S4 generics and methods.
 965 **************************************************************************/
 966 int R::OutputClassMethodsTable(File *) {
 967   Hash *tb = ClassMethodsTable;
 968
 969   if(!tb)
 970     return SWIG_OK;
 971
 972   List *keys = Keys(tb);
 973   String *key;
 974   int i, n = Len(keys);
 975   if (debugMode) {
 976     for(i = 0; i < n ; i++ ) {
 977       key = Getitem(keys, i);
 978       Printf(stderr, "%d) %s\n", i, key);
 979       List *els = Getattr(tb, key);
 980       int nels = Len(els);
 981       Printf(stderr, "\t");
 982       for(int j = 0; j < nels; j+=2) {
 983         Printf(stderr, "%s%s", Getitem(els, j), j < nels - 1 ? ", " : "");
 984         Printf(stderr, "%s\n", Getitem(els, j+1));
 985       }
 986       Printf(stderr, "\n");
 987     }
 988   }
 989
 990   return SWIG_OK;
 991 }
 992
 993
 994 /*
 995   Iterate over the <class name>_set and <>_get
 996   elements and generate the $ and $<- functions
 997   that provide constrained access to the member
 998   fields in these elements.
 999
1000   tb - a hash table that is built up in functionWrapper
1001   as we process each membervalueHandler.
1002   The entries are indexed by <class name>_set and
1003   <class_name>_get. Each entry is a List *.
1004
1005   out - the stram where the code is to be written. This is the S
1006   code stream as we generate only S code here..
1007 */
1008 int R::OutputClassMemberTable(Hash *tb, File *out) {
1009   List *keys = Keys(tb), *el;
1010
1011   String *key;
1012   int i, n = Len(keys);
1013   /* Loop over all the  <Class>_set and <Class>_get entries in the table. */
1014
1015   if(n && outputNamespaceInfo) {
1016     Printf(s_namespace, "exportClasses(");
1017   }
1018   for(i = 0; i < n; i++) {
1019     key = Getitem(keys, i);
1020     el = Getattr(tb, key);
1021
1022     String *className = Getitem(el, 0);
1023     char *ptr = Char(key);
1024     ptr = &ptr[Len(key) - 3];
1025     int isSet = strcmp(ptr, "set") == 0;
1026
1027     //        OutputArrayMethod(className, el, out);
1028     OutputMemberReferenceMethod(className, isSet, el, out);
1029
1030     if(outputNamespaceInfo)
1031       Printf(s_namespace, "\"%s\"%s", className, i < n-1 ? "," : "");
1032   }
1033   if(n && outputNamespaceInfo) {
1034     Printf(s_namespace, ")\n");
1035   }
1036
1037   return n;
1038 }
1039
1040 /*******************************************************************
1041  Write the methods for $ or $<- for accessing a member field in an
1042  struct or union (or class).
1043  className - the name of the struct or union (e.g. Bar for struct Bar)
1044  isSet - a logical value indicating whether the method is for
1045            modifying ($<-) or accessing ($) the member field.
1046  el - a list of length  2 * # accessible member elements  + 1.
1047       The first element is the name of the class.
1048       The other pairs are  member name and the name of the R function to access it.
1049  out - the stream where we write the code.
1050 ********************************************************************/
1051 int R::OutputMemberReferenceMethod(String *className, int isSet,
1052                                    List *el, File *out) {
1053   int numMems = Len(el), j;
1054   int has_getitem = 0, has_setitem = 0, has_str = 0;
1055   int varaccessor = 0;
1056   if (numMems == 0)
1057     return SWIG_OK;
1058
1059   Wrapper *f = NewWrapper(), *attr = NewWrapper();
1060
1061   Printf(f->def, "function(x, name%s)", isSet ? ", value" : "");
1062   Printf(attr->def, "function(x, i, j, ...%s)", isSet ? ", value" : "");
1063
1064   Printf(f->code, "{\n");
1065   Printf(f->code, "%saccessorFuns = list(", tab8);
1066
1067   Node *itemList = NewHash();
1068   bool has_prev = false;
1069   for(j = 0; j < numMems; j+=3) {
1070     String *item = Getitem(el, j);
1071     if (Getattr(itemList, item))
1072       continue;
1073     Setattr(itemList, item, "1");
1074     if (!Strcmp(item, "__getitem__")) has_getitem = 1;
1075     if (!Strcmp(item, "__setitem__")) has_setitem = 1;
1076     if (!Strcmp(item, "__str__")) has_str = 1;
1077
1078     String *dup = Getitem(el, j + 1);
1079     char *ptr = Char(dup);
1080     ptr = &ptr[Len(dup) - 3];
1081
1082     if (!strcmp(ptr, "get"))
1083       varaccessor++;
1084
1085     String *pitem;
1086     if (!Strcmp(item, "operator ()")) {
1087       pitem = NewString("call");
1088     } else if (!Strcmp(item, "operator ->")) {
1089       pitem = NewString("deref");
1090     } else if (!Strcmp(item, "operator +")) {
1091       pitem = NewString("add");
1092     } else if (!Strcmp(item, "operator -")) {
1093       pitem = NewString("sub");
1094     } else {
1095       pitem = Copy(item);
1096     }
1097     if (has_prev)
1098       Printf(f->code, ", ");
1099     Printf(f->code, "'%s' = %s", pitem, dup);
1100     has_prev = true;
1101     Delete(pitem);
1102   }
1103   Delete(itemList);
1104   Printf(f->code, ")\n");
1105
1106   if (!isSet && varaccessor > 0) {
1107     Printf(f->code, "%svaccessors = c(", tab8);
1108     int vcount = 0;
1109     for(j = 0; j < numMems; j+=3) {
1110       String *item = Getitem(el, j);
1111       String *dup = Getitem(el, j + 1);
1112       char *ptr = Char(dup);
1113       ptr = &ptr[Len(dup) - 3];
1114
1115       if (!strcmp(ptr, "get")) {
1116         vcount++;
1117         Printf(f->code, "'%s'%s", item, vcount < varaccessor ? ", " : "");
1118       }
1119     }
1120     Printf(f->code, ")\n");
1121   }
1122
1123
1124   /*    Printv(f->code, tab8,
1125         "idx = pmatch(name, names(accessorFuns))\n",
1126         tab8,
1127         "if(is.na(idx)) {\n",
1128         tab8, tab4,
1129         "stop(\"No ", (isSet ? "modifiable" : "accessible"), " field named \", name, \" in ", className,
1130         ": fields are \", paste(names(accessorFuns), sep = \", \")",
1131         ")", "\n}\n", NIL); */
1132   Printv(f->code, tab8,
1133          "idx = pmatch(name, names(accessorFuns))\n",
1134          tab8,
1135          "if(is.na(idx)) \n",
1136          tab8, tab4, NIL);
1137   Printf(f->code, "return(callNextMethod(x, name%s))\n",
1138          isSet ? ", value" : "");
1139   Printv(f->code, tab8, "f = accessorFuns[[idx]]\n", NIL);
1140   if(isSet) {
1141     Printv(f->code, tab8, "f(x, value)\n", NIL);
1142     Printv(f->code, tab8, "x\n", NIL); // make certain to return the S value.
1143   } else {
1144     Printv(f->code, tab8, "formals(f)[[1]] = x\n", NIL);
1145     if (varaccessor) {
1146       Printv(f->code, tab8,
1147              "if (is.na(match(name, vaccessors))) f else f(x)\n", NIL);
1148     } else {
1149       Printv(f->code, tab8, "f\n", NIL);
1150     }
1151   }
1152   Printf(f->code, "}\n");
1153
1154
1155   Printf(out, "# Start of accessor method for %s\n", className);
1156   Printf(out, "setMethod('$%s', '_p%s', ",
1157          isSet ? "<-" : "",
1158          getRClassName(className));
1159   Wrapper_print(f, out);
1160   Printf(out, ")\n");
1161
1162   if(isSet) {
1163     Printf(out, "setMethod('[[<-', c('_p%s', 'character'),",
1164            getRClassName(className));
1165     Insert(f->code, 2, "name = i\n");
1166     Printf(attr->code, "%s", f->code);
1167     Wrapper_print(attr, out);
1168     Printf(out, ")\n");
1169   }
1170
1171   DelWrapper(attr);
1172   DelWrapper(f);
1173
1174   Printf(out, "# end of accessor method for %s\n", className);
1175
1176   return SWIG_OK;
1177 }
1178
1179 /*******************************************************************
1180  Write the methods for [ or [<- for accessing a member field in an
1181  struct or union (or class).
1182  className - the name of the struct or union (e.g. Bar for struct Bar)
1183  el - a list of length  2 * # accessible member elements  + 1.
1184       The first element is the name of the class.
1185       The other pairs are  member name and the name of the R function to access it.
1186  out - the stream where we write the code.
1187 ********************************************************************/
1188 int R::OutputArrayMethod(String *className, List *el, File *out) {
1189   int numMems = Len(el), j;
1190
1191   if(!el || numMems == 0)
1192     return(0);
1193
1194   Printf(out, "# start of array methods for %s\n", className);
1195   for(j = 0; j < numMems; j+=3) {
1196     String *item = Getitem(el, j);
1197     String *dup = Getitem(el, j + 1);
1198     if (!Strcmp(item, "__getitem__")) {
1199       Printf(out,
1200              "setMethod('[', '_p%s', function(x, i, j, ..., drop =TRUE) ",
1201              getRClassName(className));
1202       Printf(out, "  sapply(i, function (n)  %s(x, as.integer(n-1))))\n\n", dup);
1203     }
1204     if (!Strcmp(item, "__setitem__")) {
1205       Printf(out, "setMethod('[<-', '_p%s', function(x, i, j, ..., value)",
1206              getRClassName(className));
1207       Printf(out, "  sapply(1:length(i), function(n) %s(x, as.integer(i[n]-1), value[n])))\n\n", dup);
1208     }
1209
1210   }
1211
1212   Printf(out, "# end of array methods for %s\n", className);
1213
1214   return SWIG_OK;
1215 }
1216
1217
1218 /************************************************************
1219  Called when a enumeration is to be processed.
1220  We want to call the R function defineEnumeration().
1221  tdname is the typedef of the enumeration, i.e. giving its name.
1222 *************************************************************/
1223 int R::enumDeclaration(Node *n) {
1224   String *name = Getattr(n, "name");
1225   String *tdname = Getattr(n, "tdname");
1226
1227   /* Using name if tdname is empty. */
1228
1229   if(Len(tdname) == 0)
1230     tdname = name;
1231
1232
1233   if(!tdname || Strcmp(tdname, "") == 0) {
1234     Language::enumDeclaration(n);
1235     return SWIG_OK;
1236   }
1237
1238   String *mangled_tdname = SwigType_manglestr(tdname);
1239   String *scode = NewString("");
1240
1241   Printv(scode, "defineEnumeration('", mangled_tdname, "'",
1242          ",\n",  tab8, tab8, tab4, ".values = c(\n", NIL);
1243
1244   Node *c;
1245   int value = -1; // First number is zero
1246   for (c = firstChild(n); c; c = nextSibling(c)) {
1247     //      const char *tag = Char(nodeType(c));
1248     //      if (Strcmp(tag,"cdecl") == 0) {
1249     name = Getattr(c, "name");
1250     String *type = Getattr(c, "type");
1251     String *val = Getattr(c, "enumvalue");
1252     if(val && Char(val)) {
1253       int inval = (int) getNumber(val, type);
1254       if(inval == DEFAULT_NUMBER)
1255         value++;
1256       else
1257         value = inval;
1258     } else
1259       value++;
1260
1261     Printf(scode, "%s%s%s'%s' = %d%s\n", tab8, tab8, tab8, name, value,
1262            nextSibling(c) ? ", " : "");
1263     //      }
1264   }
1265
1266   Printv(scode, "))", NIL);
1267   Printf(sfile, "%s\n", scode);
1268
1269   Delete(scode);
1270   Delete(mangled_tdname);
1271
1272   return SWIG_OK;
1273 }
1274
1275
1276 /*************************************************************
1277 **************************************************************/
1278 int R::variableWrapper(Node *n) {
1279   String *name = Getattr(n, "sym:name");
1280
1281   processing_variable = 1;
1282   Language::variableWrapper(n); // Force the emission of the _set and _get function wrappers.
1283   processing_variable = 0;
1284
1285
1286   SwigType *ty = Getattr(n, "type");
1287   int addCopyParam = addCopyParameter(ty);
1288
1289   //XXX
1290   processType(ty, n);
1291
1292   if(!SwigType_isconst(ty)) {
1293     Wrapper *f = NewWrapper();
1294     Printf(f->def, "%s = \nfunction(value%s)\n{\n",
1295            name, addCopyParam ? ", .copy = FALSE" : "");
1296     Printv(f->code, "if(missing(value)) {\n",
1297            name, "_get(", addCopyParam ? ".copy" : "", ")\n}", NIL);
1298     Printv(f->code, " else {\n",
1299            name, "_set(value)\n}\n}", NIL);
1300
1301     Wrapper_print(f, sfile);
1302     DelWrapper(f);
1303   } else {
1304     Printf(sfile, "%s = %s_get\n", name, name);
1305   }
1306
1307   return SWIG_OK;
1308 }
1309
1310
1311 void R::addAccessor(String *memberName, Wrapper *wrapper, String *name,
1312                     int isSet) {
1313   if(isSet < 0) {
1314     int n = Len(name);
1315     char *ptr = Char(name);
1316     isSet = Strcmp(NewString(&ptr[n-3]), "set") == 0;
1317   }
1318
1319   List *l = isSet ? class_member_set_functions : class_member_functions;
1320
1321   if(!l) {
1322     l = NewList();
1323     if(isSet)
1324       class_member_set_functions = l;
1325     else
1326       class_member_functions = l;
1327   }
1328
1329   Append(l, memberName);
1330   Append(l, name);
1331
1332   String *tmp = NewString("");
1333   Wrapper_print(wrapper, tmp);
1334   Append(l, tmp);
1335   // if we could put the wrapper in directly:       Append(l, Copy(sfun));
1336   if (debugMode)
1337     Printf(stderr, "Adding accessor: %s (%s) => %s\n", memberName, name, tmp);
1338 }
1339
1340 #define MAX_OVERLOAD 256
1341
1342 struct Overloaded {
1343   Node      *n;          /* Node                               */
1344   int        argc;       /* Argument count                     */
1345   ParmList  *parms;      /* Parameters used for overload check */
1346   int        error;      /* Ambiguity error                    */
1347 };
1348
1349
1350 static List * Swig_overload_rank(Node *n,
1351                                  bool script_lang_wrapping) {
1352   Overloaded  nodes[MAX_OVERLOAD];
1353   int         nnodes = 0;
1354   Node *o = Getattr(n,"sym:overloaded");
1355
1356
1357   if (!o) return 0;
1358
1359   Node *c = o;
1360   while (c) {
1361     if (Getattr(c,"error")) {
1362       c = Getattr(c,"sym:nextSibling");
1363       continue;
1364     }
1365     /*    if (SmartPointer && Getattr(c,"cplus:staticbase")) {
1366           c = Getattr(c,"sym:nextSibling");
1367           continue;
1368           } */
1369
1370     /* Make a list of all the declarations (methods) that are overloaded with
1371      * this one particular method name */
1372
1373     if (Getattr(c,"wrap:name")) {
1374       nodes[nnodes].n = c;
1375       nodes[nnodes].parms = Getattr(c,"wrap:parms");
1376       nodes[nnodes].argc = emit_num_required(nodes[nnodes].parms);
1377       nodes[nnodes].error = 0;
1378       nnodes++;
1379     }
1380     c = Getattr(c,"sym:nextSibling");
1381   }
1382
1383   /* Sort the declarations by required argument count */
1384   {
1385     int i,j;
1386     for (i = 0; i < nnodes; i++) {
1387       for (j = i+1; j < nnodes; j++) {
1388         if (nodes[i].argc > nodes[j].argc) {
1389           Overloaded t = nodes[i];
1390           nodes[i] = nodes[j];
1391           nodes[j] = t;
1392         }
1393       }
1394     }
1395   }
1396
1397   /* Sort the declarations by argument types */
1398   {
1399     int i,j;
1400     for (i = 0; i < nnodes-1; i++) {
1401       if (nodes[i].argc == nodes[i+1].argc) {
1402         for (j = i+1; (j < nnodes) && (nodes[j].argc == nodes[i].argc); j++) {
1403           Parm *p1 = nodes[i].parms;
1404           Parm *p2 = nodes[j].parms;
1405           int   differ = 0;
1406           int   num_checked = 0;
1407           while (p1 && p2 && (num_checked < nodes[i].argc)) {
1408             //    Printf(stdout,"p1 = '%s', p2 = '%s'\n", Getattr(p1,"type"), Getattr(p2,"type"));
1409             if (checkAttribute(p1,"tmap:in:numinputs","0")) {
1410               p1 = Getattr(p1,"tmap:in:next");
1411               continue;
1412             }
1413             if (checkAttribute(p2,"tmap:in:numinputs","0")) {
1414               p2 = Getattr(p2,"tmap:in:next");
1415               continue;
1416             }
1417             String *t1 = Getattr(p1,"tmap:typecheck:precedence");
1418             String *t2 = Getattr(p2,"tmap:typecheck:precedence");
1419             if ((!t1) && (!nodes[i].error)) {
1420               Swig_warning(WARN_TYPEMAP_TYPECHECK, Getfile(nodes[i].n), Getline(nodes[i].n),
1421                            "Overloaded method %s not supported (no type checking rule for '%s').\n",
1422                            Swig_name_decl(nodes[i].n), SwigType_str(Getattr(p1, "type"), 0));
1423               nodes[i].error = 1;
1424             } else if ((!t2) && (!nodes[j].error)) {
1425               Swig_warning(WARN_TYPEMAP_TYPECHECK, Getfile(nodes[j].n), Getline(nodes[j].n),
1426                            "xx Overloaded method %s not supported (no type checking rule for '%s').\n",
1427                            Swig_name_decl(nodes[j].n), SwigType_str(Getattr(p2, "type"), 0));
1428               nodes[j].error = 1;
1429             }
1430             if (t1 && t2) {
1431               int t1v, t2v;
1432               t1v = atoi(Char(t1));
1433               t2v = atoi(Char(t2));
1434               differ = t1v-t2v;
1435             }
1436             else if (!t1 && t2) differ = 1;
1437             else if (t1 && !t2) differ = -1;
1438             else if (!t1 && !t2) differ = -1;
1439             num_checked++;
1440             if (differ > 0) {
1441               Overloaded t = nodes[i];
1442               nodes[i] = nodes[j];
1443               nodes[j] = t;
1444               break;
1445             } else if ((differ == 0) && (Strcmp(t1,"0") == 0)) {
1446               t1 = Getattr(p1,"ltype");
1447               if (!t1) {
1448                 t1 = SwigType_ltype(Getattr(p1,"type"));
1449                 if (Getattr(p1,"tmap:typecheck:SWIGTYPE")) {
1450                   SwigType_add_pointer(t1);
1451                 }
1452                 Setattr(p1,"ltype",t1);
1453               }
1454               t2 = Getattr(p2,"ltype");
1455               if (!t2) {
1456                 t2 = SwigType_ltype(Getattr(p2,"type"));
1457                 if (Getattr(p2,"tmap:typecheck:SWIGTYPE")) {
1458                   SwigType_add_pointer(t2);
1459                 }
1460                 Setattr(p2,"ltype",t2);
1461               }
1462
1463               /* Need subtype check here.  If t2 is a subtype of t1, then we need to change the
1464                  order */
1465
1466               if (SwigType_issubtype(t2,t1)) {
1467                 Overloaded t = nodes[i];
1468                 nodes[i] = nodes[j];
1469                 nodes[j] = t;
1470               }
1471
1472               if (Strcmp(t1,t2) != 0) {
1473                 differ = 1;
1474                 break;
1475               }
1476             } else if (differ) {
1477               break;
1478             }
1479             if (Getattr(p1,"tmap:in:next")) {
1480               p1 = Getattr(p1,"tmap:in:next");
1481             } else {
1482               p1 = nextSibling(p1);
1483             }
1484             if (Getattr(p2,"tmap:in:next")) {
1485               p2 = Getattr(p2,"tmap:in:next");
1486             } else {
1487               p2 = nextSibling(p2);
1488             }
1489           }
1490           if (!differ) {
1491             /* See if declarations differ by const only */
1492             String *d1 = Getattr(nodes[i].n,"decl");
1493             String *d2 = Getattr(nodes[j].n,"decl");
1494             if (d1 && d2) {
1495               String *dq1 = Copy(d1);
1496               String *dq2 = Copy(d2);
1497               if (SwigType_isconst(d1)) {
1498                 Delete(SwigType_pop(dq1));
1499               }
1500               if (SwigType_isconst(d2)) {
1501                 Delete(SwigType_pop(dq2));
1502               }
1503               if (Strcmp(dq1,dq2) == 0) {
1504
1505                 if (SwigType_isconst(d1) && !SwigType_isconst(d2)) {
1506                   if (script_lang_wrapping) {
1507                     // Swap nodes so that the const method gets ignored (shadowed by the non-const method)
1508                     Overloaded t = nodes[i];
1509                     nodes[i] = nodes[j];
1510                     nodes[j] = t;
1511                   }
1512                   differ = 1;
1513                   if (!nodes[j].error) {
1514                     if (script_lang_wrapping) {
1515                       Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[j].n), Getline(nodes[j].n),
1516                                    "Overloaded %s(%s) const ignored. Non-const method at %s:%d used.\n",
1517                                    Getattr(nodes[j].n,"name"), ParmList_errorstr(nodes[j].parms),
1518                                    Getfile(nodes[i].n), Getline(nodes[i].n));
1519                     } else {
1520                       if (!Getattr(nodes[j].n, "overload:ignore"))
1521                         Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
1522                                      "Overloaded method %s(%s) ignored. Method %s(%s) const at %s:%d used.\n",
1523                                      Getattr(nodes[j].n,"name"), ParmList_errorstr(nodes[j].parms),
1524                                      Getattr(nodes[i].n,"name"), ParmList_errorstr(nodes[i].parms),
1525                                      Getfile(nodes[i].n), Getline(nodes[i].n));
1526                     }
1527                   }
1528                   nodes[j].error = 1;
1529                 } else if (!SwigType_isconst(d1) && SwigType_isconst(d2)) {
1530                   differ = 1;
1531                   if (!nodes[j].error) {
1532                     if (script_lang_wrapping) {
1533                       Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[j].n), Getline(nodes[j].n),
1534                                    "Overloaded %s(%s) const ignored. Non-const method at %s:%d used.\n",
1535                                    Getattr(nodes[j].n,"name"), ParmList_errorstr(nodes[j].parms),
1536                                    Getfile(nodes[i].n), Getline(nodes[i].n));
1537                     } else {
1538                       if (!Getattr(nodes[j].n, "overload:ignore"))
1539                         Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
1540                                      "Overloaded method %s(%s) const ignored. Method %s(%s) at %s:%d used.\n",
1541                                      Getattr(nodes[j].n,"name"), ParmList_errorstr(nodes[j].parms),
1542                                      Getattr(nodes[i].n,"name"), ParmList_errorstr(nodes[i].parms),
1543                                      Getfile(nodes[i].n), Getline(nodes[i].n));
1544                     }
1545                   }
1546                   nodes[j].error = 1;
1547                 }
1548               }
1549               Delete(dq1);
1550               Delete(dq2);
1551             }
1552           }
1553           if (!differ) {
1554             if (!nodes[j].error) {
1555               if (script_lang_wrapping) {
1556                 Swig_warning(WARN_LANG_OVERLOAD_SHADOW, Getfile(nodes[j].n), Getline(nodes[j].n),
1557                              "Overloaded method %s is shadowed by %s at %s:%d.\n",
1558                              Swig_name_decl(nodes[j].n), Swig_name_decl(nodes[i].n),
1559                              Getfile(nodes[i].n), Getline(nodes[i].n));
1560               } else {
1561                 if (!Getattr(nodes[j].n, "overload:ignore"))
1562                   Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
1563                                "Overloaded method %s ignored. Method %s at %s:%d used.\n",
1564                                Swig_name_decl(nodes[j].n), Swig_name_decl(nodes[i].n),
1565                                Getfile(nodes[i].n), Getline(nodes[i].n));
1566               }
1567               nodes[j].error = 1;
1568             }
1569           }
1570         }
1571       }
1572     }
1573   }
1574   List *result = NewList();
1575   {
1576     int i;
1577     for (i = 0; i < nnodes; i++) {
1578       if (nodes[i].error)
1579         Setattr(nodes[i].n, "overload:ignore", "1");
1580       Append(result,nodes[i].n);
1581       //      Printf(stdout,"[ %d ] %s\n", i, ParmList_errorstr(nodes[i].parms));
1582       //      Swig_print_node(nodes[i].n);
1583     }
1584   }
1585   return result;
1586 }
1587
1588 void R::dispatchFunction(Node *n) {
1589   Wrapper *f = NewWrapper();
1590   String *symname = Getattr(n, "sym:name");
1591   String *nodeType = Getattr(n, "nodeType");
1592   bool constructor = (!Cmp(nodeType, "constructor"));
1593
1594   String *sfname = NewString(symname);
1595
1596   if (constructor)
1597     Replace(sfname, "new_", "", DOH_REPLACE_FIRST);
1598
1599   Printf(f->def,
1600          "`%s` <- function(...) {", sfname);
1601   List *dispatch = Swig_overload_rank(n, true);
1602   int   nfunc = Len(dispatch);
1603   Printv(f->code,
1604          "argtypes <- mapply(class, list(...))\n",
1605          "argv <- list(...)\n",
1606          "argc <- length(argtypes)\n", NIL );
1607
1608   Printf(f->code, "# dispatch functions %d\n", nfunc);
1609   int cur_args = -1;
1610   bool first_compare = true;
1611   for (int i=0; i < nfunc; i++) {
1612     Node *ni = Getitem(dispatch,i);
1613     Parm *pi = Getattr(ni,"wrap:parms");
1614     int num_arguments = emit_num_arguments(pi);
1615
1616     String *overname = Getattr(ni,"sym:overname");
1617     if (cur_args != num_arguments) {
1618       if (cur_args != -1) {
1619         Printv(f->code, "} else ", NIL);
1620       }
1621       Printf(f->code, "if (argc == %d) {", num_arguments);
1622       cur_args = num_arguments;
1623       first_compare = true;
1624     }
1625     Parm *p;
1626     int j;
1627     if (num_arguments > 0) {
1628       if (!first_compare) {
1629         Printv(f->code, " else ", NIL);
1630       } else {
1631         first_compare = false;
1632       }
1633       Printv(f->code, "if (", NIL);
1634       for (p =pi, j = 0 ; j < num_arguments ; j++) {
1635         String *tm = Swig_typemap_lookup("rtype", p, "", 0);
1636         if(tm) {
1637           replaceRClass(tm, Getattr(p, "type"));
1638         }
1639         if (DohStrcmp(tm,"numeric")==0) {
1640         Printf(f->code, "%sis.numeric(argv[[%d]])",
1641                j == 0 ? "" : " && ",
1642                j+1);
1643         }
1644         else {
1645         Printf(f->code, "%sextends(argtypes[%d], '%s')",
1646                j == 0 ? "" : " && ",
1647                j+1,
1648                tm);
1649         }
1650         p = Getattr(p, "tmap:in:next");
1651       }
1652       Printf(f->code, ") { f <- %s%s }\n", sfname, overname);
1653     } else {
1654       Printf(f->code, "f <- %s%s", sfname, overname);
1655     }
1656   }
1657   if (cur_args != -1) {
1658     Printv(f->code, "}", NIL);
1659   }
1660   Printv(f->code, "\nf(...)", NIL);
1661   Printv(f->code, "\n}", NIL);
1662   Wrapper_print(f, sfile);
1663   Printv(sfile, "# Dispatch function\n", NIL);
1664   DelWrapper(f);
1665 }
1666
1667 /******************************************************************
1668
1669 *******************************************************************/
1670 int R::functionWrapper(Node *n) {
1671   String *fname = Getattr(n, "name");
1672   String *iname = Getattr(n, "sym:name");
1673   String *type = Getattr(n, "type");
1674
1675   if (debugMode) {
1676     Printf(stderr,
1677            "<functionWrapper> %s %s %s\n", fname, iname, type);
1678   }
1679   String *overname = 0;
1680   String *nodeType = Getattr(n, "nodeType");
1681   bool constructor = (!Cmp(nodeType, "constructor"));
1682   bool destructor = (!Cmp(nodeType, "destructor"));
1683
1684   String *sfname = NewString(iname);
1685
1686   if (constructor)
1687     Replace(sfname, "new_", "", DOH_REPLACE_FIRST);
1688
1689   if (Getattr(n,"sym:overloaded")) {
1690     overname = Getattr(n,"sym:overname");
1691     Append(sfname, overname);
1692   }
1693
1694   if (debugMode)
1695     Printf(stderr,
1696            "<functionWrapper> processing parameters\n");
1697
1698
1699   ParmList *l = Getattr(n, "parms");
1700   Parm *p;
1701   String *tm;
1702
1703   p = l;
1704   while(p) {
1705     SwigType *resultType = Getattr(p, "type");
1706     if (expandTypedef(resultType) &&
1707         SwigType_istypedef(resultType)) {
1708       SwigType *resolved =
1709         SwigType_typedef_resolve_all(resultType);
1710       if (expandTypedef(resolved)) {
1711         Setattr(p, "type", Copy(resolved));
1712       }
1713     }
1714     p = nextSibling(p);
1715   }
1716
1717   String *unresolved_return_type =
1718     Copy(type);
1719   if (expandTypedef(type) &&
1720       SwigType_istypedef(type)) {
1721     SwigType *resolved =
1722       SwigType_typedef_resolve_all(type);
1723     if (expandTypedef(resolved)) {
1724       type = Copy(resolved);
1725       Setattr(n, "type", type);
1726     }
1727   }
1728   if (debugMode)
1729     Printf(stderr, "<functionWrapper> unresolved_return_type %s\n",
1730            unresolved_return_type);
1731   if(processing_member_access_function) {
1732     if (debugMode)
1733       Printf(stderr, "<functionWrapper memberAccess> '%s' '%s' '%s' '%s'\n",
1734              fname, iname, member_name, class_name);
1735
1736     if(opaqueClassDeclaration)
1737       return SWIG_OK;
1738
1739
1740     /* Add the name of this member to a list for this class_name.
1741        We will dump all these at the end. */
1742
1743     int n = Len(iname);
1744     char *ptr = Char(iname);
1745     bool isSet(Strcmp(NewString(&ptr[n-3]), "set") == 0);
1746
1747
1748     String *tmp = NewString("");
1749     Printf(tmp, "%s_%s", class_name, isSet ? "set" : "get");
1750
1751     List *memList = Getattr(ClassMemberTable, tmp);
1752     if(!memList) {
1753       memList = NewList();
1754       Append(memList, class_name);
1755       Setattr(ClassMemberTable, tmp, memList);
1756     }
1757     Delete(tmp);
1758     Append(memList, member_name);
1759     Append(memList, iname);
1760   }
1761
1762   int i;
1763   int nargs, num_required, varargs;
1764   UNUSED(varargs);
1765
1766   String *wname = Swig_name_wrapper(iname);
1767   Replace(wname, "_wrap", "R_swig", DOH_REPLACE_FIRST);
1768   if(overname)
1769     Append(wname, overname);
1770   Setattr(n,"wrap:name", wname);
1771
1772   Wrapper *f = NewWrapper();
1773   Wrapper *sfun = NewWrapper();
1774
1775   int isVoidReturnType = (Strcmp(type, "void") == 0);
1776   // Need to use the unresolved return type since
1777   // typedef resolution removes the const which causes a
1778   // mismatch with the function action
1779   emit_return_variable(n, unresolved_return_type, f);
1780
1781   SwigType *rtype = Getattr(n, "type");
1782   int addCopyParam = 0;
1783
1784   if(!isVoidReturnType)
1785     addCopyParam = addCopyParameter(rtype);
1786
1787
1788   // Can we get the nodeType() of the type node! and see if it is a struct.
1789   //    int addCopyParam = SwigType_isclass(rtype);
1790
1791   //    if(addCopyParam)
1792   if (debugMode)
1793     Printf(stderr, "Adding a .copy argument to %s for %s = %s\n",
1794            iname, type, addCopyParam ? "yes" : "no");
1795
1796   Printv(f->def, "SWIGEXPORT SEXP\n", wname, " ( ", NIL);
1797
1798   Printf(sfun->def, "# Start of %s\n", iname);
1799   Printv(sfun->def, "\n`", sfname, "` = function(", NIL);
1800
1801   if(outputNamespaceInfo) //XXX Need to be a little more discriminating
1802     addNamespaceFunction(iname);
1803
1804   Swig_typemap_attach_parms("scoercein", l, f);
1805   Swig_typemap_attach_parms("scoerceout", l, f);
1806   Swig_typemap_attach_parms("scheck", l, f);
1807
1808   emit_parameter_variables(l, f);
1809   emit_attach_parmmaps(l,f);
1810   Setattr(n,"wrap:parms",l);
1811
1812   nargs = emit_num_arguments(l);
1813   num_required = emit_num_required(l);
1814   varargs = emit_isvarargs(l);
1815
1816   Wrapper_add_local(f, "r_nprotect", "unsigned int r_nprotect = 0");
1817   Wrapper_add_localv(f, "r_ans", "SEXP", "r_ans = R_NilValue", NIL);
1818   Wrapper_add_localv(f, "r_vmax", "VMAXTYPE", "r_vmax = vmaxget()", NIL);
1819
1820   String *sargs = NewString("");
1821
1822
1823   String *s_inputTypes = NewString("");
1824   String *s_inputMap = NewString("");
1825   bool inFirstArg = true;
1826   bool inFirstType = true;
1827   Parm *curP;
1828   for (p =l, i = 0 ; i < nargs ; i++) {
1829
1830     while (checkAttribute(p, "tmap:in:numinputs", "0")) {
1831       p = Getattr(p, "tmap:in:next");
1832     }
1833
1834     SwigType *tt = Getattr(p, "type");
1835     int nargs = -1;
1836     String *funcptr_name = processType(tt, p, &nargs);
1837
1838     //      SwigType *tp = Getattr(p, "type");
1839     String   *name  = Getattr(p,"name");
1840     String   *lname  = Getattr(p,"lname");
1841
1842     // R keyword renaming
1843     if (name && Swig_name_warning(p, 0, name, 0))
1844       name = 0;
1845
1846     /* If we have a :: in the parameter name because we are accessing a static member of a class, say, then
1847        we need to remove that prefix. */
1848     while (Strstr(name, "::")) {
1849       //XXX need to free.
1850       name = NewStringf("%s", Strchr(name, ':') + 2);
1851       if (debugMode)
1852         Printf(stderr, "+++  parameter name with :: in it %s\n", name);
1853     }
1854     if (Len(name) == 0)
1855       name = NewStringf("s_arg%d", i+1);
1856
1857     name = replaceInitialDash(name);
1858
1859     if (!Strncmp(name, "arg", 3)) {
1860       name = Copy(name);
1861       Insert(name, 0, "s_");
1862     }
1863
1864     if(processing_variable) {
1865       name = Copy(name);
1866       Insert(name, 0, "s_");
1867     }
1868
1869     if(!Strcmp(name, fname)) {
1870       name = Copy(name);
1871       Insert(name, 0, "s_");
1872     }
1873
1874     Printf(sargs, "%s, ", name);
1875
1876     String *tm;
1877     if((tm = Getattr(p, "tmap:scoercein"))) {
1878       Replaceall(tm, "$input", name);
1879       replaceRClass(tm, Getattr(p, "type"));
1880
1881       if(funcptr_name) {
1882         //XXX need to get this to return non-zero
1883         if(nargs == -1)
1884           nargs = getFunctionPointerNumArgs(p, tt);
1885
1886         String *snargs = NewStringf("%d", nargs);
1887         Printv(sfun->code, "if(is.function(", name, ")) {", "\n",
1888                "assert('...' %in% names(formals(", name,
1889                ")) || length(formals(", name, ")) >= ", snargs, ")\n} ", NIL);
1890         Delete(snargs);
1891
1892         Printv(sfun->code, "else {\n",
1893                "if(is.character(", name, ")) {\n",
1894                name, " = getNativeSymbolInfo(", name, ")",
1895                "\n}\n",
1896                "if(is(", name, ", \"NativeSymbolInfo\")) {\n",
1897                name, " = ", name, "$address", "\n}\n",
1898                "}\n",
1899                NIL);
1900       } else {
1901         Printf(sfun->code, "%s\n", tm);
1902       }
1903     }
1904
1905     Printv(sfun->def, inFirstArg ? "" : ", ", name, NIL);
1906
1907     if ((tm = Getattr(p,"tmap:scheck"))) {
1908
1909       Replaceall(tm,"$target", lname);
1910       Replaceall(tm,"$source", name);
1911       Replaceall(tm,"$input", name);
1912       replaceRClass(tm, Getattr(p, "type"));
1913       Printf(sfun->code,"%s\n",tm);
1914     }
1915
1916
1917
1918     curP = p;
1919     if ((tm = Getattr(p,"tmap:in"))) {
1920
1921       Replaceall(tm,"$target", lname);
1922       Replaceall(tm,"$source", name);
1923       Replaceall(tm,"$input", name);
1924
1925       if (Getattr(p,"wrap:disown") || (Getattr(p,"tmap:in:disown"))) {
1926         Replaceall(tm,"$disown","SWIG_POINTER_DISOWN");
1927       } else {
1928         Replaceall(tm,"$disown","0");
1929       }
1930
1931       if(funcptr_name) {
1932         /* have us a function pointer */
1933         Printf(f->code, "if(TYPEOF(%s) != CLOSXP) {\n", name);
1934         Replaceall(tm,"$R_class", "");
1935       } else {
1936         replaceRClass(tm, Getattr(p, "type"));
1937       }
1938
1939
1940       Printf(f->code,"%s\n",tm);
1941       if(funcptr_name)
1942         Printf(f->code, "} else {\n%s = %s;\nR_SWIG_pushCallbackFunctionData(%s, NULL);\n}\n",
1943                lname, funcptr_name, name);
1944       Printv(f->def, inFirstArg ? "" : ", ", "SEXP ", name, NIL);
1945       if (Len(name) != 0)
1946         inFirstArg = false;
1947       p = Getattr(p,"tmap:in:next");
1948
1949     } else {
1950       p = nextSibling(p);
1951     }
1952
1953
1954     tm = Swig_typemap_lookup("rtype", curP, "", 0);
1955     if(tm) {
1956       replaceRClass(tm, Getattr(curP, "type"));
1957     }
1958     Printf(s_inputTypes, "%s'%s'", inFirstType ? "" : ", ", tm);
1959     Printf(s_inputMap, "%s%s='%s'", inFirstType ? "" : ", ", name, tm);
1960     inFirstType = false;
1961
1962     if(funcptr_name)
1963       Delete(funcptr_name);
1964   } /* end of looping over parameters. */
1965
1966   if(addCopyParam) {
1967     Printf(sfun->def, "%s.copy = FALSE", nargs > 0 ? ", " : "");
1968     Printf(f->def, "%sSEXP s_swig_copy", nargs > 0 ? ", " : "");
1969
1970     Printf(sargs, "as.logical(.copy), ");
1971   }
1972
1973   Printv(f->def, ")\n{\n", NIL);
1974   Printv(sfun->def, ")\n{\n", NIL);
1975
1976
1977   /* Insert cleanup code */
1978   String *cleanup = NewString("");
1979   for (p = l; p;) {
1980     if ((tm = Getattr(p, "tmap:freearg"))) {
1981       Replaceall(tm, "$source", Getattr(p, "lname"));
1982       Printv(cleanup, tm, "\n", NIL);
1983       p = Getattr(p, "tmap:freearg:next");
1984     } else {
1985       p = nextSibling(p);
1986     }
1987   }
1988
1989   String *outargs = NewString("");
1990   int numOutArgs = isVoidReturnType ? -1 : 0;
1991   for(p = l, i = 0; p; i++) {
1992     if((tm = Getattr(p, "tmap:argout"))) {
1993       //       String *lname =  Getattr(p, "lname");
1994       numOutArgs++;
1995       String *pos = NewStringf("%d", numOutArgs);
1996       Replaceall(tm,"$source", Getattr(p, "lname"));
1997       Replaceall(tm,"$result", "r_ans");
1998       Replaceall(tm,"$n", pos); // The position into which to store the answer.
1999       Replaceall(tm,"$arg", Getattr(p, "emit:input"));
2000       Replaceall(tm,"$input", Getattr(p, "emit:input"));
2001       Replaceall(tm,"$owner", "R_SWIG_EXTERNAL");
2002
2003
2004       Printf(outargs, "%s\n", tm);
2005       p = Getattr(p,"tmap:argout:next");
2006     } else
2007       p = nextSibling(p);
2008   }
2009
2010   String *actioncode = emit_action(n);
2011
2012   /* Deal with the explicit return value. */
2013   if ((tm = Swig_typemap_lookup_out("out", n, "result", f, actioncode))) {
2014     SwigType *retType = Getattr(n, "type");
2015     //Printf(stderr, "Return Value for %s, array? %s\n", retType, SwigType_isarray(retType) ? "yes" : "no");
2016     /*      if(SwigType_isarray(retType)) {
2017             defineArrayAccessors(retType);
2018             } */
2019
2020
2021     Replaceall(tm,"$1", "result");
2022     Replaceall(tm,"$result", "r_ans");
2023     replaceRClass(tm, retType);
2024
2025     if (GetFlag(n,"feature:new")) {
2026       Replaceall(tm, "$owner", "R_SWIG_OWNER");
2027     } else {
2028       Replaceall(tm,"$owner", "R_SWIG_EXTERNAL");
2029     }
2030
2031 #if 0
2032     if(addCopyParam) {
2033       Printf(f->code, "if(LOGICAL(s_swig_copy)[0]) {\n");
2034       Printf(f->code, "/* Deal with returning a reference. */\nr_ans = R_NilValue;\n");
2035       Printf(f->code, "}\n else {\n");
2036     }
2037 #endif
2038     Printf(f->code, "%s\n", tm);
2039 #if 0
2040     if(addCopyParam)
2041       Printf(f->code, "}\n"); /* end of if(s_swig_copy) ... else { ... } */
2042 #endif
2043
2044   } else {
2045     Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number,
2046                  "Unable to use return type %s in function %s.\n", SwigType_str(type, 0), fname);
2047   }
2048
2049
2050   if(Len(outargs)) {
2051     Wrapper_add_local(f, "R_OutputValues", "SEXP R_OutputValues");
2052
2053     String *tmp = NewString("");
2054     if(!isVoidReturnType)
2055       Printf(tmp, "Rf_protect(r_ans);\n");
2056
2057     Printf(tmp, "Rf_protect(R_OutputValues = Rf_allocVector(VECSXP,%d));\nr_nprotect += %d;\n",
2058            numOutArgs + !isVoidReturnType,
2059            isVoidReturnType ? 1 : 2);
2060
2061     if(!isVoidReturnType)
2062       Printf(tmp, "SET_VECTOR_ELT(R_OutputValues, 0, r_ans);\n");
2063     Printf(tmp, "r_ans = R_OutputValues;\n");
2064
2065     Insert(outargs, 0, tmp);
2066     Delete(tmp);
2067
2068
2069
2070     Printv(f->code, outargs, NIL);
2071     Delete(outargs);
2072
2073   }
2074
2075   /* Output cleanup code */
2076   Printv(f->code, cleanup, NIL);
2077   Delete(cleanup);
2078
2079
2080
2081   Printv(f->code, UnProtectWrapupCode, NIL);
2082
2083   /*If the user gave us something to convert the result in  */
2084   if ((tm = Swig_typemap_lookup("scoerceout", n,
2085                                     "result", sfun))) {
2086     Replaceall(tm,"$source","ans");
2087     Replaceall(tm,"$result","ans");
2088     replaceRClass(tm, Getattr(n, "type"));
2089     Chop(tm);
2090   }
2091
2092
2093   Printv(sfun->code, (Len(tm) ? "ans = " : ""), ".Call('", wname,
2094          "', ", sargs, "PACKAGE='", Rpackage, "')\n", NIL);
2095   if(Len(tm))
2096     Printf(sfun->code, "%s\n\nans\n", tm);
2097   if (destructor)
2098     Printv(f->code, "R_ClearExternalPtr(self);\n", NIL);
2099
2100   Printv(f->code, "return r_ans;\n}\n", NIL);
2101   Printv(sfun->code, "\n}", NIL);
2102
2103   /* Substitute the function name */
2104   Replaceall(f->code,"$symname",iname);
2105
2106   Wrapper_print(f, f_wrapper);
2107   Wrapper_print(sfun, sfile);
2108
2109   Printf(sfun->code, "\n# End of %s\n", iname);
2110   tm = Swig_typemap_lookup("rtype", n, "", 0);
2111   if(tm) {
2112     SwigType *retType = Getattr(n, "type");
2113     replaceRClass(tm, retType);
2114   }
2115
2116   Printv(sfile, "attr(`", sfname, "`, 'returnType') = '",
2117          isVoidReturnType ? "void" : (tm ? tm : ""),
2118          "'\n", NIL);
2119
2120   if(nargs > 0)
2121     Printv(sfile, "attr(`", sfname, "`, \"inputTypes\") = c(",
2122            s_inputTypes, ")\n", NIL);
2123   Printv(sfile, "class(`", sfname, "`) = c(\"SWIGFunction\", class('",
2124          sfname, "'))\n\n", NIL);
2125
2126   if (memoryProfile) {
2127     Printv(sfile, "memory.profile()\n", NIL);
2128   }
2129   if (aggressiveGc) {
2130     Printv(sfile, "gc()\n", NIL);
2131   }
2132
2133   // Printv(sfile, "setMethod('", name, "', '", name, "', ", iname, ")\n\n\n");
2134
2135
2136
2137   /* If we are dealing with a method in an C++ class, then
2138      add the name of the R function and its definition.
2139      XXX need to figure out how to store the Wrapper if possible in the hash/list.
2140      Would like to be able to do this so that we can potentialy insert
2141   */
2142   if(processing_member_access_function || processing_class_member_function) {
2143     String *tmp;
2144     if(member_name)
2145       tmp = member_name;
2146     else
2147       tmp = Getattr(n, "memberfunctionHandler:name");
2148     addAccessor(member_name, sfun, iname);
2149   }
2150
2151   if (Getattr(n, "sym:overloaded") &&
2152       !Getattr(n, "sym:nextSibling")) {
2153     dispatchFunction(n);
2154   }
2155
2156   addRegistrationRoutine(wname, addCopyParam ? nargs +1 : nargs);
2157
2158   DelWrapper(f);
2159   DelWrapper(sfun);
2160
2161   Delete(sargs);
2162   Delete(sfname);
2163   return SWIG_OK;
2164 }
2165
2166 /*****************************************************
2167  Add the specified routine name to the collection of
2168  generated routines that are called from R functions.
2169  This is used to register the routines with R for
2170  resolving symbols.
2171
2172  rname - the name of the routine
2173  nargs - the number of arguments it expects.
2174 ******************************************************/
2175 int R::addRegistrationRoutine(String *rname, int nargs) {
2176   if(!registrationTable)
2177     registrationTable = NewHash();
2178
2179   String *el =
2180     NewStringf("{\"%s\", (DL_FUNC) &%s, %d}", rname, rname, nargs);
2181
2182   Setattr(registrationTable, rname, el);
2183
2184   return SWIG_OK;
2185 }
2186
2187 /*****************************************************
2188  Write the registration information to an array and
2189  create the initialization routine for registering
2190  these.
2191 ******************************************************/
2192 int R::outputRegistrationRoutines(File *out) {
2193   int i, n;
2194   if(!registrationTable)
2195     return(0);
2196   if(inCPlusMode)
2197     Printf(out, "#ifdef __cplusplus\nextern \"C\" {\n#endif\n\n");
2198
2199   Printf(out, "#include <R_ext/Rdynload.h>\n\n");
2200   if(inCPlusMode)
2201     Printf(out, "#ifdef __cplusplus\n}\n#endif\n\n");
2202
2203   Printf(out, "SWIGINTERN R_CallMethodDef CallEntries[] = {\n");
2204
2205   List *keys = Keys(registrationTable);
2206   n = Len(keys);
2207   for(i = 0; i < n; i++)
2208     Printf(out, "   %s,\n", Getattr(registrationTable, Getitem(keys, i)));
2209
2210   Printf(out, "   {NULL, NULL, 0}\n};\n\n");
2211
2212   if(!noInitializationCode) {
2213     if (inCPlusMode)
2214       Printv(out, "extern \"C\" ", NIL);
2215     Printf(out, "SWIGEXPORT void R_init_%s(DllInfo *dll) {\n", Rpackage);
2216     Printf(out, "%sR_registerRoutines(dll, NULL, CallEntries, NULL, NULL);\n", tab4);
2217     if(Len(s_init_routine)) {
2218       Printf(out, "\n%s\n", s_init_routine);
2219     }
2220     Printf(out, "}\n");
2221   }
2222
2223   return n;
2224 }
2225
2226
2227
2228 /****************************************************************************
2229   Process a struct, union or class declaration in the source code,
2230   or an anonymous typedef struct
2231
2232 *****************************************************************************/
2233 //XXX What do we need to do here -
2234 // Define an S4 class to refer to this.
2235
2236 void R::registerClass(Node *n) {
2237   String *name = Getattr(n, "name");
2238   String *kind = Getattr(n, "kind");
2239
2240   if (debugMode)
2241     Swig_print_node(n);
2242   String *sname = NewStringf("_p%s", SwigType_manglestr(name));
2243   if(!Getattr(SClassDefs, sname)) {
2244     Setattr(SClassDefs, sname, sname);
2245     String *base;
2246
2247     if(Strcmp(kind, "class") == 0) {
2248       base = NewString("");
2249       List *l = Getattr(n, "bases");
2250       if(Len(l)) {
2251         Printf(base, "c(");
2252         for(int i = 0; i < Len(l); i++) {
2253           registerClass(Getitem(l, i));
2254           Printf(base, "'_p%s'%s",
2255                  SwigType_manglestr(Getattr(Getitem(l, i), "name")),
2256                  i < Len(l)-1 ? ", " : "");
2257         }
2258         Printf(base, ")");
2259       } else {
2260         base = NewString("'C++Reference'");
2261       }
2262     } else
2263       base = NewString("'ExternalReference'");
2264
2265     Printf(s_classes, "setClass('%s', contains = %s)\n", sname, base);
2266     Delete(base);
2267   }
2268
2269 }
2270
2271 int R::classDeclaration(Node *n) {
2272
2273   String *name = Getattr(n, "name");
2274   String *kind = Getattr(n, "kind");
2275
2276   if (debugMode)
2277     Swig_print_node(n);
2278   registerClass(n);
2279
2280
2281   /* If we have a typedef union { ... } U, then we never get to see the typedef
2282      via a regular call to typedefHandler. Instead, */
2283   if(Getattr(n, "unnamed") && Strcmp(Getattr(n, "storage"), "typedef") == 0
2284      && Getattr(n, "tdname") && Strcmp(Getattr(n, "tdname"), name) == 0) {
2285     if (debugMode)
2286       Printf(stderr, "Typedef in the class declaration for %s\n", name);
2287     //        typedefHandler(n);
2288   }
2289
2290   bool opaque = GetFlag(n, "feature:opaque") ? true : false;
2291
2292   if(opaque)
2293     opaqueClassDeclaration = name;
2294
2295   int status = Language::classDeclaration(n);
2296
2297   opaqueClassDeclaration = NULL;
2298
2299
2300   // OutputArrayMethod(name, class_member_functions, sfile);
2301   if (class_member_functions)
2302     OutputMemberReferenceMethod(name, 0, class_member_functions, sfile);
2303   if (class_member_set_functions)
2304     OutputMemberReferenceMethod(name, 1, class_member_set_functions, sfile);
2305
2306   if(class_member_functions) {
2307     Delete(class_member_functions);
2308     class_member_functions = NULL;
2309   }
2310   if(class_member_set_functions) {
2311     Delete(class_member_set_functions);
2312     class_member_set_functions = NULL;
2313   }
2314   if (Getattr(n, "has_destructor")) {
2315     Printf(sfile, "setMethod('delete', '_p%s', function(obj) {delete%s(obj)})\n",
2316            getRClassName(Getattr(n, "name")),
2317            getRClassName(Getattr(n, "name")));
2318
2319   }
2320   if(!opaque && !Strcmp(kind, "struct") && copyStruct) {
2321
2322     String *def =
2323       NewStringf("setClass(\"%s\",\n%srepresentation(\n", name, tab4);
2324     bool firstItem = true;
2325
2326     for(Node *c = firstChild(n); c; ) {
2327       String *elName;
2328       String *tp;
2329
2330       elName = Getattr(c, "name");
2331
2332       String *elKind = Getattr(c, "kind");
2333       if (Strcmp(elKind, "variable") != 0) {
2334         c = nextSibling(c);
2335         continue;
2336       }
2337       if (!Len(elName)) {
2338         c = nextSibling(c);
2339         continue;
2340       }
2341 #if 0
2342       tp = getRType(c);
2343 #else
2344       tp = Swig_typemap_lookup("rtype", c, "", 0);
2345       if(!tp) {
2346         c = nextSibling(c);
2347         continue;
2348       }
2349       if (Strstr(tp, "R_class")) {
2350         c = nextSibling(c);
2351         continue;
2352       }
2353       if (Strcmp(tp, "character") &&
2354           Strstr(Getattr(c, "decl"), "p.")) {
2355         c = nextSibling(c);
2356         continue;
2357       }
2358
2359       if (!firstItem) {
2360         Printf(def, ",\n");
2361       }
2362       //            else
2363       //XXX How can we tell if this is already done.
2364       //              SwigType_push(elType, elDecl);
2365
2366
2367       // returns ""  tp = processType(elType, c, NULL);
2368       //            Printf(stderr, "<classDeclaration> elType %p\n", elType);
2369       //            tp = getRClassNameCopyStruct(Getattr(c, "type"), 1);
2370 #endif
2371       String *elNameT = replaceInitialDash(elName);
2372       Printf(def, "%s%s = \"%s\"", tab8, elNameT, tp);
2373       firstItem = false;
2374       Delete(tp);
2375       Delete(elNameT);
2376       c = nextSibling(c);
2377     }
2378     Printf(def, "),\n%scontains = \"RSWIGStruct\")\n", tab8);
2379     Printf(s_classes, "%s\n\n# End class %s\n\n", def, name);
2380
2381     generateCopyRoutines(n);
2382
2383     Delete(def);
2384   }
2385
2386   return status;
2387 }
2388
2389
2390
2391 /***************************************************************
2392  Create the C routines that copy an S object of the class given
2393  by the given struct definition in Node *n to the C value
2394  and also the routine that goes from the C routine to an object
2395  of this S class.
2396 ****************************************************************/
2397 /*XXX
2398   Clean up the toCRef - make certain the names are correct for the types, etc.
2399   in all cases.
2400 */
2401
2402 int R::generateCopyRoutines(Node *n) {
2403   Wrapper *copyToR = NewWrapper();
2404   Wrapper *copyToC = NewWrapper();
2405
2406   String *name = Getattr(n, "name");
2407   String *tdname = Getattr(n, "tdname");
2408   String *kind = Getattr(n, "kind");
2409   String *type;
2410
2411   if(Len(tdname)) {
2412     type = Copy(tdname);
2413   } else {
2414     type = NewStringf("%s %s", kind, name);
2415   }
2416
2417   String *mangledName = SwigType_manglestr(name);
2418
2419   if (debugMode)
2420     Printf(stderr, "generateCopyRoutines:  name = %s, %s\n", name, type);
2421
2422   Printf(copyToR->def, "CopyToR%s = function(value, obj = new(\"%s\"))\n{\n",
2423          mangledName, name);
2424   Printf(copyToC->def, "CopyToC%s = function(value, obj)\n{\n",
2425          mangledName);
2426
2427   Node *c = firstChild(n);
2428
2429   for(; c; c = nextSibling(c)) {
2430     String *elName = Getattr(c, "name");
2431     if (!Len(elName)) {
2432       continue;
2433     }
2434     String *elKind = Getattr(c, "kind");
2435     if (Strcmp(elKind, "variable") != 0) {
2436       Delete(elKind);
2437       continue;
2438     }
2439
2440     String *tp = Swig_typemap_lookup("rtype", c, "", 0);
2441     if(!tp) {
2442       continue;
2443     }
2444     if (Strstr(tp, "R_class")) {
2445       continue;
2446     }
2447     if (Strcmp(tp, "character") &&
2448         Strstr(Getattr(c, "decl"), "p.")) {
2449       continue;
2450     }
2451
2452
2453     /* The S functions to get and set the member value. */
2454     String *elNameT = replaceInitialDash(elName);
2455     Printf(copyToR->code, "obj@%s = value$%s\n", elNameT, elNameT);
2456     Printf(copyToC->code, "obj$%s = value@%s\n", elNameT, elNameT);
2457     Delete(elNameT);
2458   }
2459   Printf(copyToR->code, "obj\n}\n\n");
2460   String *rclassName = getRClassNameCopyStruct(type, 0); // without the Ref.
2461   Printf(sfile, "# Start definition of copy functions & methods for %s\n", rclassName);
2462
2463   Wrapper_print(copyToR, sfile);
2464   Printf(copyToC->code, "obj\n}\n\n");
2465   Wrapper_print(copyToC, sfile);
2466
2467
2468   Printf(sfile, "# Start definition of copy methods for %s\n", rclassName);
2469   Printf(sfile, "setMethod('copyToR', '_p_%s', CopyToR%s)\n", rclassName,
2470          mangledName);
2471   Printf(sfile, "setMethod('copyToC', '%s', CopyToC%s)\n\n", rclassName,
2472          mangledName);
2473
2474   Printf(sfile, "# End definition of copy methods for %s\n", rclassName);
2475   Printf(sfile, "# End definition of copy functions & methods for %s\n", rclassName);
2476
2477   String *m = NewStringf("%sCopyToR", name);
2478   addNamespaceMethod(m);
2479   char *tt = Char(m);  tt[Len(m)-1] = 'C';
2480   addNamespaceMethod(m);
2481   Delete(m);
2482   Delete(rclassName);
2483   Delete(mangledName);
2484   DelWrapper(copyToR);
2485   DelWrapper(copyToC);
2486
2487   return SWIG_OK;
2488 }
2489
2490
2491
2492 /*****
2493       Called when there is a typedef to be invoked.
2494
2495       XXX Needs to be enhanced or split to handle the case where we have a
2496       typedef within a classDeclaration emission because the struct/union/etc.
2497       is anonymous.
2498 ******/
2499 int R::typedefHandler(Node *n) {
2500   SwigType *tp = Getattr(n, "type");
2501   String *type = Getattr(n, "type");
2502   if (debugMode)
2503     Printf(stderr, "<typedefHandler> %s\n", Getattr(n, "name"));
2504
2505   processType(tp, n);
2506
2507   if(Strncmp(type, "struct ", 7) == 0) {
2508     String *name = Getattr(n, "name");
2509     char *trueName = Char(type);
2510     trueName += 7;
2511     if (debugMode)
2512       Printf(stderr, "<typedefHandler> Defining S class %s\n", trueName);
2513     Printf(s_classes, "setClass('_p%s', contains = 'ExternalReference')\n",
2514            SwigType_manglestr(name));
2515   }
2516
2517   return Language::typedefHandler(n);
2518 }
2519
2520
2521
2522 /*********************
2523   Called when processing a field in a "class", i.e. struct, union or
2524   actual class.  We set a state variable so that we can correctly
2525   interpret the resulting functionWrapper() call and understand that
2526   it is for a field element.
2527 **********************/
2528 int R::membervariableHandler(Node *n) {
2529   SwigType *t = Getattr(n, "type");
2530   processType(t, n, NULL);
2531   processing_member_access_function = 1;
2532   member_name = Getattr(n,"sym:name");
2533   if (debugMode)
2534     Printf(stderr, "<membervariableHandler> name = %s, sym:name = %s\n",
2535            Getattr(n, "name"), member_name);
2536
2537   int status(Language::membervariableHandler(n));
2538
2539   if(opaqueClassDeclaration == NULL && debugMode)
2540     Printf(stderr, "<membervariableHandler> %s %s\n", Getattr(n, "name"), Getattr(n, "type"));
2541
2542   processing_member_access_function = 0;
2543   member_name = NULL;
2544
2545   return status;
2546 }
2547
2548
2549 /*
2550   This doesn't seem to get used so leave it out for the moment.
2551 */
2552 String * R::runtimeCode() {
2553   String *s = Swig_include_sys("rrun.swg");
2554   if (!s) {
2555     Printf(stderr, "*** Unable to open 'rrun.swg'\n");
2556     s = NewString("");
2557   }
2558   return s;
2559 }
2560
2561
2562 /**
2563    Called when SWIG wants to initialize this
2564    We initialize anythin we want here.
2565    Most importantly, tell SWIG where to find the files (e.g. r.swg) for this module.
2566    Use Swig_mark_arg() to tell SWIG that it is understood and not to throw an error.
2567 **/
2568 void R::main(int argc, char *argv[]) {
2569   bool cppcast = true;
2570   init();
2571   Preprocessor_define("SWIGR 1", 0);
2572   SWIG_library_directory("r");
2573   SWIG_config_file("r.swg");
2574   debugMode = false;
2575   copyStruct = true;
2576   memoryProfile = false;
2577   aggressiveGc = false;
2578   inCPlusMode = false;
2579   outputNamespaceInfo = false;
2580   noInitializationCode = false;
2581
2582   this->Argc = argc;
2583   this->Argv = argv;
2584
2585   allow_overloading();// can we support this?
2586
2587   for(int i = 0; i < argc; i++) {
2588     if(strcmp(argv[i], "-package") == 0) {
2589       Swig_mark_arg(i);
2590       i++;
2591       Swig_mark_arg(i);
2592       Rpackage = argv[i];
2593     } else if(strcmp(argv[i], "-dll") == 0) {
2594       Swig_mark_arg(i);
2595       i++;
2596       Swig_mark_arg(i);
2597       DllName = argv[i];
2598     } else if(strcmp(argv[i], "-help") == 0) {
2599       showUsage();
2600     } else if(strcmp(argv[i], "-namespace") == 0) {
2601       outputNamespaceInfo = true;
2602       Swig_mark_arg(i);
2603     } else if(!strcmp(argv[i], "-no-init-code")) {
2604       noInitializationCode = true;
2605       Swig_mark_arg(i);
2606     } else if(!strcmp(argv[i], "-c++")) {
2607       inCPlusMode = true;
2608       Swig_mark_arg(i);
2609       Printf(s_classes, "setClass('C++Reference', contains = 'ExternalReference')\n");
2610     } else if(!strcmp(argv[i], "-debug")) {
2611       debugMode = true;
2612       Swig_mark_arg(i);
2613     }  else if (!strcmp(argv[i],"-cppcast")) {
2614       cppcast = true;
2615       Swig_mark_arg(i);
2616     } else if (!strcmp(argv[i],"-nocppcast")) {
2617       cppcast = false;
2618       Swig_mark_arg(i);
2619     } else if (!strcmp(argv[i],"-copystruct")) {
2620       copyStruct = true;
2621       Swig_mark_arg(i);
2622     } else if (!strcmp(argv[i], "-nocopystruct")) {
2623       copyStruct = false;
2624       Swig_mark_arg(i);
2625     } else if (!strcmp(argv[i], "-memoryprof")) {
2626       memoryProfile = true;
2627       Swig_mark_arg(i);
2628     } else if (!strcmp(argv[i], "-nomemoryprof")) {
2629       memoryProfile = false;
2630       Swig_mark_arg(i);
2631     } else if (!strcmp(argv[i], "-aggressivegc")) {
2632       aggressiveGc = true;
2633       Swig_mark_arg(i);
2634     } else if (!strcmp(argv[i], "-noaggressivegc")) {
2635       aggressiveGc = false;
2636       Swig_mark_arg(i);
2637     }
2638
2639     if (cppcast) {
2640       Preprocessor_define((DOH *) "SWIG_CPLUSPLUS_CAST", 0);
2641     }
2642     /// copyToR copyToC functions.
2643
2644   }
2645 }
2646
2647 /*
2648   Could make this work for String or File and then just store the resulting string
2649   rather than the collection of arguments and argc.
2650 */
2651 int R::outputCommandLineArguments(File *out)
2652 {
2653   if(Argc < 1 || !Argv || !Argv[0])
2654     return(-1);
2655
2656   Printf(out, "\n##   Generated via the command line invocation:\n##\t");
2657   for(int i = 0; i < Argc ; i++) {
2658     Printf(out, " %s", Argv[i]);
2659   }
2660   Printf(out, "\n\n\n");
2661
2662   return Argc;
2663 }
2664
2665
2666
2667 /* How SWIG instantiates an object from this module.
2668    See swigmain.cxx */
2669 extern "C"
2670 Language *swig_r(void) {
2671   return new R();
2672 }
2673
2674
2675
2676 /*************************************************************************************/
2677
2678 /*
2679   Needs to be reworked.
2680 */
2681 String * R::processType(SwigType *t, Node *n, int *nargs) {
2682   //XXX Need to handle typedefs, e.g.
2683   //  a type which is a typedef  to a function pointer.
2684
2685   SwigType *tmp = Getattr(n, "tdname");
2686   if (debugMode)
2687     Printf(stderr, "processType %s (tdname = %s)\n", Getattr(n, "name"), tmp);
2688
2689   SwigType *td = t;
2690   if (expandTypedef(t) &&
2691       SwigType_istypedef(t)) {
2692     SwigType *resolved =
2693       SwigType_typedef_resolve_all(t);
2694     if (expandTypedef(resolved)) {
2695       td = Copy(resolved);
2696     }
2697   }
2698
2699   if(!td) {
2700     int count = 0;
2701     String *b = getRTypeName(t, &count);
2702     if(count && b && !Getattr(SClassDefs, b)) {
2703       if (debugMode)
2704         Printf(stderr, "<processType> Defining class %s\n",  b);
2705
2706       Printf(s_classes, "setClass('%s', contains = 'ExternalReference')\n", b);
2707       Setattr(SClassDefs, b, b);
2708     }
2709
2710   }
2711
2712
2713   if(td)
2714     t = td;
2715
2716   if(SwigType_isfunctionpointer(t)) {
2717     if (debugMode)
2718       Printf(stderr,
2719              "<processType> Defining pointer handler %s\n",  t);
2720
2721     String *tmp = createFunctionPointerHandler(t, n, nargs);
2722     return tmp;
2723   }
2724
2725 #if 0
2726   SwigType_isfunction(t) && SwigType_ispointer(t)
2727 #endif
2728
2729     return NULL;
2730 }
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740 /*************************************************************************************/
2741
2742
2743
2744
2745