PageRenderTime 137ms CodeModel.GetById 13ms app.highlight 108ms RepoModel.GetById 1ms app.codeStats 1ms

/trunk/Source/Modules/r.cxx

#
C++ | 2303 lines | 1619 code | 393 blank | 291 comment | 356 complexity | 0cca9d9c96a54dc3a1036496592ca751 MD5 | raw file

Large files files are truncated, but you can click here to view the full file

   1/* -----------------------------------------------------------------------------
   2 * This file is part of SWIG, which is licensed as a whole under version 3 
   3 * (or any later version) of the GNU General Public License. Some additional
   4 * terms also apply to certain portions of SWIG. The full details of the SWIG
   5 * license and copyrights can be found in the LICENSE and COPYRIGHT files
   6 * included with the SWIG source code as distributed by the SWIG developers
   7 * and at http://www.swig.org/legal.html.
   8 *
   9 * r.cxx
  10 *
  11 * R language module for SWIG.
  12 * ----------------------------------------------------------------------------- */
  13
  14char cvsroot_r_cxx[] = "$Id: r.cxx 12937 2012-03-18 17:11:02Z drjoe $";
  15
  16#include "swigmod.h"
  17
  18static const double DEFAULT_NUMBER = .0000123456712312312323;
  19static const int MAX_OVERLOAD_ARGS = 5;
  20
  21static String* replaceInitialDash(const String *name)
  22{
  23  String *retval;
  24  if (!Strncmp(name, "_", 1)) {
  25    retval = Copy(name);
  26    Insert(retval, 0, "s");
  27  } else {
  28    retval = Copy(name);
  29  }
  30  return retval;
  31}
  32
  33static String * getRTypeName(SwigType *t, int *outCount = NULL) {
  34  String *b = SwigType_base(t);
  35  List *els = SwigType_split(t);
  36  int count = 0;
  37  int i;
  38  
  39  if(Strncmp(b, "struct ", 7) == 0) 
  40    Replace(b, "struct ", "", DOH_REPLACE_FIRST);
  41  
  42  /* Printf(stdout, "<getRTypeName> %s,base = %s\n", t, b);
  43     for(i = 0; i < Len(els); i++) 
  44     Printf(stdout, "%d) %s, ", i, Getitem(els,i));
  45     Printf(stdout, "\n"); */
  46  
  47  for(i = 0; i < Len(els); i++) {
  48    String *el = Getitem(els, i);
  49    if(Strcmp(el, "p.") == 0 || Strncmp(el, "a(", 2) == 0) {
  50      count++;
  51      Append(b, "Ref");
  52    }
  53  }
  54  if(outCount)
  55    *outCount = count;
  56  
  57  String *tmp = NewString("");
  58  char *retName = Char(SwigType_manglestr(t));
  59  Insert(tmp, 0, retName);
  60  return tmp;
  61  
  62  /*
  63  if(count)
  64    return(b);
  65  
  66  Delete(b);
  67  return(NewString(""));
  68  */
  69}
  70
  71/*********************
  72 Tries to get the name of the R class corresponding  to the given type
  73  e.g. struct A * is ARef,  struct A**  is  ARefRef.
  74  Now handles arrays, i.e. struct A[2]
  75****************/
  76
  77static String *getRClassName(String *retType, int /*addRef*/ = 1, int upRef=0) {
  78  String *tmp = NewString("");
  79  SwigType *resolved = SwigType_typedef_resolve_all(retType);
  80  char *retName = Char(SwigType_manglestr(resolved));
  81  if (upRef) {
  82    Printf(tmp, "_p%s", retName);
  83  } else{
  84    Insert(tmp, 0, retName);
  85  }
  86  
  87  return tmp;
  88/*
  89#if 1
  90  List *l = SwigType_split(retType);
  91  int n = Len(l);
  92  if(!l || n == 0) {
  93#ifdef R_SWIG_VERBOSE
  94    if (debugMode)
  95      Printf(stdout, "SwigType_split return an empty list for %s\n", 
  96	     retType);
  97#endif
  98    return(tmp);
  99  }
 100  
 101  
 102  String *el = Getitem(l, n-1);
 103  char *ptr = Char(el);
 104  if(strncmp(ptr, "struct ", 7) == 0)
 105    ptr += 7;
 106  
 107  Printf(tmp, "%s", ptr);
 108  
 109  if(addRef) {
 110    for(int i = 0; i < n; i++) {
 111      if(Strcmp(Getitem(l, i), "p.") == 0 || 
 112	 Strncmp(Getitem(l, i), "a(", 2) == 0)
 113	Printf(tmp, "Ref");
 114    }
 115  }
 116  
 117#else
 118  char *retName = Char(SwigType_manglestr(retType));
 119  if(!retName)
 120    return(tmp);
 121  
 122  if(addRef) {
 123    while(retName && strlen(retName) > 1 && strncmp(retName, "_p", 2) == 0)  {
 124      retName += 2;
 125      Printf(tmp, "Ref");
 126    }
 127  }
 128  if(retName[0] == '_')
 129    retName ++;
 130  Insert(tmp, 0, retName);
 131#endif
 132  
 133  return tmp;
 134*/
 135}
 136
 137/*********************
 138 Tries to get the name of the R class corresponding  to the given type
 139  e.g. struct A * is ARef,  struct A**  is  ARefRef.
 140  Now handles arrays, i.e. struct A[2]
 141****************/
 142
 143static String * getRClassNameCopyStruct(String *retType, int addRef) {
 144  String *tmp = NewString("");
 145  
 146#if 1
 147  List *l = SwigType_split(retType);
 148  int n = Len(l);
 149  if(!l || n == 0) {
 150#ifdef R_SWIG_VERBOSE
 151    Printf(stdout, "SwigType_split return an empty list for %s\n", retType);
 152#endif
 153    return(tmp);
 154  }
 155  
 156  
 157  String *el = Getitem(l, n-1);
 158  char *ptr = Char(el);
 159  if(strncmp(ptr, "struct ", 7) == 0)
 160    ptr += 7;
 161  
 162  Printf(tmp, "%s", ptr);
 163  
 164  if(addRef) {
 165    for(int i = 0; i < n; i++) {
 166      if(Strcmp(Getitem(l, i), "p.") == 0 || 
 167	 Strncmp(Getitem(l, i), "a(", 2) == 0)
 168	Printf(tmp, "Ref");
 169    }
 170  }
 171  
 172#else
 173  char *retName = Char(SwigType_manglestr(retType));
 174  if(!retName)
 175    return(tmp);
 176  
 177  if(addRef) {
 178    while(retName && strlen(retName) > 1 && 
 179	  strncmp(retName, "_p", 2) == 0)  {
 180      retName += 2;
 181      Printf(tmp, "Ref");
 182    }
 183  }
 184  
 185  if(retName[0] == '_')
 186    retName ++;
 187  Insert(tmp, 0, retName);
 188#endif
 189
 190  return tmp;
 191}
 192
 193
 194/*********************************
 195  Write the elements of a list to the File*, one element per line.
 196  If quote  is true, surround the element with "element".
 197  This takes care of inserting a tab in front of each line and also
 198  a comma after each element, except the last one.
 199**********************************/
 200
 201static void writeListByLine(List *l, File *out, bool quote = 0) {
 202  int i, n = Len(l);
 203  for(i = 0; i < n; i++) 
 204    Printf(out, "%s%s%s%s%s\n", tab8, 
 205	   quote ? "\"" :"",  
 206	   Getitem(l, i), 
 207	   quote ? "\"" :"", i < n-1 ? "," : "");
 208}
 209
 210
 211static const char *usage = (char *)"\
 212R Options (available with -r)\n\
 213     -copystruct      - Emit R code to copy C structs (on by default)\n\
 214     -cppcast         - Enable C++ casting operators (default) \n\
 215     -debug           - Output debug\n\
 216     -dll <name>      - Name of the DLL (without the .dll or .so suffix).\n\
 217                        Default is the module name.\n\
 218     -gc              - Aggressive garbage collection\n\
 219     -memoryprof      - Add memory profile\n\
 220     -namespace       - Output NAMESPACE file\n\
 221     -no-init-code    - Turn off the generation of the R_init_<pkgname> code\n\
 222                        (registration information still generated)\n\
 223     -package <name>  - Package name for the PACKAGE argument of the R .Call()\n\
 224                        invocations. Default is the module name.\n\
 225";
 226
 227
 228
 229/************
 230 Display the help for this module on the screen/console.
 231*************/
 232static void showUsage() {
 233  fputs(usage, stdout);
 234}
 235
 236static bool expandTypedef(SwigType *t) {
 237  if (SwigType_isenum(t)) return false;
 238  String *prefix = SwigType_prefix(t);
 239  if (Strncmp(prefix, "f", 1)) return false;
 240  if (Strncmp(prefix, "p.f", 3)) return false;
 241  return true;
 242}
 243
 244
 245/*****
 246      Determine whether  we should add a .copy argument to the S function
 247      that wraps/interfaces to the routine that returns the given type.
 248*****/
 249static int addCopyParameter(SwigType *type) {
 250  int ok = 0;
 251  ok = Strncmp(type, "struct ", 7) == 0 || Strncmp(type, "p.struct ", 9) == 0;
 252  if(!ok) {
 253    ok = Strncmp(type, "p.", 2);
 254  }
 255
 256  return(ok);
 257}
 258
 259static void replaceRClass(String *tm, SwigType *type) {
 260  String *tmp = getRClassName(type);
 261  String *tmp_base = getRClassName(type, 0);
 262  String *tmp_ref = getRClassName(type, 1, 1);
 263  Replaceall(tm, "$R_class", tmp);
 264  Replaceall(tm, "$*R_class", tmp_base);
 265  Replaceall(tm, "$&R_class", tmp_ref);
 266  Delete(tmp); Delete(tmp_base); Delete(tmp_ref);
 267}
 268
 269static double getNumber(String *value) {
 270  double d = DEFAULT_NUMBER;
 271  if(Char(value)) {
 272    if(sscanf(Char(value), "%lf", &d) != 1)
 273      return(DEFAULT_NUMBER);
 274  }
 275  return(d);
 276}
 277
 278class R : public Language {
 279public:
 280  R();
 281  void registerClass(Node *n);
 282  void main(int argc, char *argv[]);
 283  int top(Node *n);
 284  
 285  void dispatchFunction(Node *n);
 286  int functionWrapper(Node *n);
 287  int variableWrapper(Node *n);
 288
 289  int classDeclaration(Node *n);
 290  int enumDeclaration(Node *n);
 291
 292  int membervariableHandler(Node *n);
 293
 294  int typedefHandler(Node *n);
 295  static List *Swig_overload_rank(Node *n,
 296			   bool script_lang_wrapping);
 297
 298  int memberfunctionHandler(Node *n) {
 299    if (debugMode)
 300      Printf(stdout, "<memberfunctionHandler> %s %s\n", 
 301	     Getattr(n, "name"),
 302	     Getattr(n, "type"));
 303    member_name = Getattr(n, "sym:name");
 304    processing_class_member_function = 1;
 305    int status = Language::memberfunctionHandler(n);    
 306    processing_class_member_function = 0;
 307    return status;
 308  }
 309
 310  /* Grab the name of the current class being processed so that we can 
 311     deal with members of that class. */
 312  int classHandler(Node *n){
 313    if(!ClassMemberTable) 
 314      ClassMemberTable = NewHash();
 315    
 316    class_name = Getattr(n, "name");
 317    int status = Language::classHandler(n);
 318    
 319    class_name = NULL;
 320    return status;
 321  }
 322
 323  // Not used:
 324  String *runtimeCode();
 325  
 326protected:
 327  int addRegistrationRoutine(String *rname, int nargs);
 328  int outputRegistrationRoutines(File *out);
 329  
 330  int outputCommandLineArguments(File *out);
 331  int generateCopyRoutines(Node *n); 
 332  int DumpCode(Node *n);
 333  
 334  int OutputMemberReferenceMethod(String *className, int isSet, List *el, File *out);
 335  int OutputArrayMethod(String *className, List *el, File *out);
 336  int OutputClassMemberTable(Hash *tb, File *out);
 337  int OutputClassMethodsTable(File *out);
 338  int OutputClassAccessInfo(Hash *tb, File *out);
 339  
 340  int defineArrayAccessors(SwigType *type);
 341  
 342  void addNamespaceFunction(String *name) {
 343    if(!namespaceFunctions)
 344      namespaceFunctions = NewList();
 345    Append(namespaceFunctions, name);
 346  }
 347
 348  void addNamespaceMethod(String *name) {
 349    if(!namespaceMethods)
 350      namespaceMethods = NewList();
 351    Append(namespaceMethods, name);
 352  }
 353  
 354  String* processType(SwigType *t, Node *n, int *nargs = NULL);
 355  String *createFunctionPointerHandler(SwigType *t, Node *n, int *nargs);
 356  int addFunctionPointerProxy(String *name, Node *n, SwigType *t, String *s_paramTypes) {
 357    /*XXX Do we need to put the t in there to get the return type later. */
 358    if(!functionPointerProxyTable) 
 359      functionPointerProxyTable = NewHash();
 360    
 361    Setattr(functionPointerProxyTable, name, n);
 362    
 363    Setattr(SClassDefs, name, name);
 364    Printv(s_classes, "setClass('", 
 365	   name,
 366	   "',\n", tab8, 
 367	   "prototype = list(parameterTypes = c(", s_paramTypes, "),\n",
 368	   tab8, tab8, tab8,
 369	   "returnType = '", SwigType_manglestr(t), "'),\n", tab8, 
 370	   "contains = 'CRoutinePointer')\n\n##\n", NIL);
 371    
 372    return SWIG_OK;
 373  }
 374  
 375
 376  void addSMethodInfo(String *name, 
 377		      String *argType, int nargs);
 378  // Simple initialization such as constant strings that can be reused. 
 379  void init(); 
 380  
 381  
 382  void addAccessor(String *memberName, Wrapper *f, 
 383		   String *name, int isSet = -1);
 384  
 385  static int getFunctionPointerNumArgs(Node *n, SwigType *tt);
 386
 387protected: 
 388  bool copyStruct;
 389  bool memoryProfile;
 390  bool aggressiveGc;
 391
 392  // Strings into which we cumulate the generated code that is to be written
 393  //vto the files.
 394  String *sfile;
 395  String *f_init;
 396  String *s_classes;
 397  String *f_begin;
 398  String *f_runtime;
 399  String *f_wrapper;
 400  String *s_header;
 401  String *f_wrappers;
 402  String *s_init;
 403  String *s_init_routine;
 404  String *s_namespace;
 405  
 406  // State variables that carry information across calls to functionWrapper() 
 407  // from  member accessors and class declarations. 
 408  String *opaqueClassDeclaration;
 409  int processing_variable;
 410  int processing_member_access_function;
 411  String *member_name;
 412  String *class_name;
 413  
 414  
 415  int processing_class_member_function;
 416  List *class_member_functions;
 417  List *class_member_set_functions;
 418  
 419  /* */
 420  Hash *ClassMemberTable;
 421  Hash *ClassMethodsTable;
 422  Hash *SClassDefs;
 423  Hash *SMethodInfo;
 424  
 425  // Information about routines that are generated and to be registered with 
 426  // R for dynamic lookup. 
 427  Hash *registrationTable;
 428  Hash *functionPointerProxyTable;
 429  
 430  List *namespaceFunctions;
 431  List *namespaceMethods;
 432  List *namespaceClasses; // Probably can do this from ClassMemberTable.
 433  
 434  
 435  // Store a copy of the command line. 
 436  // Need only keep a string that has it formatted. 
 437  char **Argv;
 438  int    Argc;
 439  bool inCPlusMode;
 440  
 441  // State variables that we remember from the command line settings
 442  // potentially that govern the code we generate.
 443  String *DllName;
 444  String *Rpackage;
 445  bool    noInitializationCode;
 446  bool    outputNamespaceInfo;
 447  
 448  String *UnProtectWrapupCode;
 449
 450  // Static members
 451  static bool debugMode;
 452};
 453
 454R::R() :
 455  copyStruct(false),
 456  memoryProfile(false),
 457  aggressiveGc(false),
 458  sfile(0),
 459  f_init(0),
 460  s_classes(0),
 461  f_begin(0),
 462  f_runtime(0),
 463  f_wrapper(0),
 464  s_header(0),
 465  f_wrappers(0),
 466  s_init(0),
 467  s_init_routine(0),
 468  s_namespace(0),
 469  opaqueClassDeclaration(0),
 470  processing_variable(0),
 471  processing_member_access_function(0),
 472  member_name(0),
 473  class_name(0),
 474  processing_class_member_function(0),
 475  class_member_functions(0),
 476  class_member_set_functions(0),
 477  ClassMemberTable(0),
 478  ClassMethodsTable(0),
 479  SClassDefs(0),
 480  SMethodInfo(0),
 481  registrationTable(0),
 482  functionPointerProxyTable(0),
 483  namespaceFunctions(0),
 484  namespaceMethods(0),
 485  namespaceClasses(0),
 486  Argv(0),
 487  Argc(0),
 488  inCPlusMode(false),
 489  DllName(0),
 490  Rpackage(0),
 491  noInitializationCode(false),
 492  outputNamespaceInfo(false),
 493  UnProtectWrapupCode(0) {
 494}
 495
 496bool R::debugMode = false;
 497
 498int R::getFunctionPointerNumArgs(Node *n, SwigType *tt) {
 499  (void) tt;
 500  n = Getattr(n, "type");
 501  if (debugMode)
 502    Printf(stdout, "type: %s\n", n);
 503
 504  ParmList *parms = Getattr(n, "parms");
 505  if (debugMode)
 506    Printf(stdout, "parms = %p\n", parms);
 507  return ParmList_len(parms);
 508}
 509
 510
 511void R::addSMethodInfo(String *name, String *argType, int nargs) {
 512  (void) argType;
 513  
 514  if(!SMethodInfo)
 515    SMethodInfo = NewHash();
 516  if (debugMode)
 517    Printf(stdout, "[addMethodInfo] %s\n", name);
 518
 519  Hash *tb = Getattr(SMethodInfo, name);
 520
 521  if(!tb) {
 522    tb = NewHash();
 523    Setattr(SMethodInfo, name, tb);
 524  }
 525
 526  String *str = Getattr(tb, "max");
 527  int max = -1;
 528  if(str)
 529    max = atoi(Char(str));
 530  if(max < nargs) {
 531    if(str)  Delete(str);
 532    str = NewStringf("%d", max);
 533    Setattr(tb, "max", str);
 534  }
 535}
 536 
 537/*
 538Returns the name of the new routine.
 539*/
 540String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) {
 541  String *funName = SwigType_manglestr(t);
 542  
 543  /* See if we have already processed this one. */
 544  if(functionPointerProxyTable && Getattr(functionPointerProxyTable, funName))
 545    return funName;
 546  
 547  if (debugMode)
 548    Printf(stdout, "<createFunctionPointerHandler> Defining %s\n",  t);
 549  
 550  SwigType *rettype = Copy(Getattr(n, "type"));
 551  SwigType *funcparams = SwigType_functionpointer_decompose(rettype);
 552  String *rtype = SwigType_str(rettype, 0);
 553
 554  //   ParmList *parms = Getattr(n, "parms");
 555  // memory leak
 556  ParmList *parms = SwigType_function_parms(SwigType_del_pointer(Copy(t)), n);
 557
 558
 559  if (debugMode) {
 560    Printf(stdout, "Type: %s\n", t);
 561    Printf(stdout, "Return type: %s\n", SwigType_base(t));
 562  }
 563  
 564  bool isVoidType = Strcmp(rettype, "void") == 0;
 565  if (debugMode)
 566    Printf(stdout, "%s is void ? %s  (%s)\n", funName, isVoidType ? "yes" : "no", rettype);
 567  
 568  Wrapper *f = NewWrapper();
 569  
 570  /* Go through argument list, attach lnames for arguments */
 571  int i = 0;
 572  Parm *p = parms;
 573  for (i = 0; p; p = nextSibling(p), ++i) {
 574    String *arg = Getattr(p, "name");
 575    String *lname = NewString("");
 576
 577    if (!arg && Cmp(Getattr(p, "type"), "void")) {
 578      lname = NewStringf("s_arg%d", i+1);
 579      Setattr(p, "name", lname);
 580    } else
 581      lname = arg;
 582
 583    Setattr(p, "lname", lname);
 584  }
 585  
 586  Swig_typemap_attach_parms("out", parms, f);
 587  Swig_typemap_attach_parms("scoerceout", parms, f);
 588  Swig_typemap_attach_parms("scheck", parms, f);
 589
 590  Printf(f->def, "%s %s(", rtype, funName);
 591
 592  emit_parameter_variables(parms, f);
 593  emit_return_variable(n, rettype, f);
 594//  emit_attach_parmmaps(parms,f);
 595
 596  /*  Using weird name and struct to avoid potential conflicts. */
 597  Wrapper_add_local(f, "r_swig_cb_data", "RCallbackFunctionData *r_swig_cb_data = R_SWIG_getCallbackFunctionData()");
 598  String *lvar = NewString("r_swig_cb_data");
 599
 600  Wrapper_add_local(f, "r_tmp", "SEXP r_tmp"); // for use in converting arguments to R objects for call.
 601  Wrapper_add_local(f, "r_nprotect", "int r_nprotect = 0"); // for use in converting arguments to R objects for call.
 602  Wrapper_add_local(f, "r_vmax", "char * r_vmax= 0"); // for use in converting arguments to R objects for call.
 603
 604  // Add local for error code in return value.  This is not in emit_return_variable because that assumes an out typemap
 605  // whereas the type makes are reverse
 606  Wrapper_add_local(f, "ecode", "int ecode = 0");
 607
 608  p = parms;
 609  int nargs = ParmList_len(parms);
 610  if(numArgs) {
 611    *numArgs = nargs;
 612    if (debugMode)
 613      Printf(stdout, "Setting number of parameters to %d\n", *numArgs);
 614  } 
 615  String *setExprElements = NewString("");
 616  
 617  String *s_paramTypes = NewString("");
 618  for(i = 0; p; i++) {
 619    SwigType *tt = Getattr(p, "type");
 620    SwigType *name = Getattr(p, "name");
 621    String *tm = Getattr(p, "tmap:out");
 622    Printf(f->def,  "%s %s", SwigType_str(tt, 0), name);
 623     if(tm) {
 624      Replaceall(tm, "$1", name);
 625      if (SwigType_isreference(tt)) {
 626	String *tmp = NewString("");
 627        Append(tmp, "*");
 628	Append(tmp, name);
 629	Replaceall(tm, tmp, name);
 630      }
 631      Replaceall(tm, "$result", "r_tmp");
 632      replaceRClass(tm, Getattr(p,"type"));
 633      Replaceall(tm,"$owner", "R_SWIG_EXTERNAL");
 634    } 
 635    
 636    Printf(setExprElements, "%s\n", tm);
 637    Printf(setExprElements, "SETCAR(r_swig_cb_data->el, %s);\n", "r_tmp");
 638    Printf(setExprElements, "r_swig_cb_data->el = CDR(r_swig_cb_data->el);\n\n");
 639    
 640    Printf(s_paramTypes, "'%s'", SwigType_manglestr(tt));
 641    
 642    
 643    p = nextSibling(p);
 644    if(p) {
 645      Printf(f->def, ", ");
 646      Printf(s_paramTypes, ", ");
 647    }
 648  }
 649  
 650  Printf(f->def,  ") {\n");
 651  
 652  Printf(f->code, "Rf_protect(%s->expr = Rf_allocVector(LANGSXP, %d));\n", lvar, nargs + 1);
 653  Printf(f->code, "r_nprotect++;\n");
 654  Printf(f->code, "r_swig_cb_data->el = r_swig_cb_data->expr;\n\n");
 655  
 656  Printf(f->code, "SETCAR(r_swig_cb_data->el, r_swig_cb_data->fun);\n");
 657  Printf(f->code, "r_swig_cb_data->el = CDR(r_swig_cb_data->el);\n\n");
 658  
 659  Printf(f->code, "%s\n\n", setExprElements);
 660  
 661  Printv(f->code, "r_swig_cb_data->retValue = R_tryEval(", 
 662	 "r_swig_cb_data->expr,",
 663	 " R_GlobalEnv,",
 664	 " &r_swig_cb_data->errorOccurred",
 665	 ");\n", 
 666	 NIL);
 667  
 668  Printv(f->code, "\n",
 669	 "if(r_swig_cb_data->errorOccurred) {\n",
 670	 "R_SWIG_popCallbackFunctionData(1);\n",
 671	 "Rf_error(\"error in calling R function as a function pointer (",
 672	 funName,
 673	 ")\");\n",
 674	 "}\n",
 675	 NIL);
 676   
 677   
 678   
 679  if(!isVoidType) {
 680    /* Need to deal with the return type of the function pointer, not the function pointer itself. 
 681       So build a new node that has the relevant pieces.
 682       XXX  Have to be a little more clever so that we can deal with struct A * - the * is getting lost.
 683       Is this still true? If so, will a SwigType_push() solve things?
 684    */
 685    Parm *bbase = NewParm(rettype, Swig_cresult_name(), n);
 686    String *returnTM = Swig_typemap_lookup("in", bbase, Swig_cresult_name(), f);
 687    if(returnTM) {
 688      String *tm = returnTM;
 689      Replaceall(tm,"$input", "r_swig_cb_data->retValue");
 690      Replaceall(tm,"$target", Swig_cresult_name());
 691      replaceRClass(tm, rettype);
 692      Replaceall(tm,"$owner", "R_SWIG_EXTERNAL");
 693      Replaceall(tm,"$disown","0");
 694      Printf(f->code, "%s\n", tm);
 695    }
 696    Delete(bbase);
 697  }
 698  
 699  Printv(f->code, "R_SWIG_popCallbackFunctionData(1);\n", NIL);
 700  Printv(f->code, "\n", UnProtectWrapupCode, NIL);
 701
 702  if (SwigType_isreference(rettype)) {  
 703    Printv(f->code,  "return *", Swig_cresult_name(), ";\n", NIL);
 704  } else if(!isVoidType)
 705    Printv(f->code,  "return ", Swig_cresult_name(), ";\n", NIL);
 706  
 707  Printv(f->code, "\n}\n", NIL);
 708  Replaceall(f->code, "SWIG_exception_fail", "SWIG_exception_noreturn");
 709  
 710  /* To coerce correctly in S, we really want to have an extra/intermediate
 711     function that handles the scoerceout. 
 712     We need to check if any of the argument types have an entry in
 713     that map. If none do, the ignore and call the function straight.
 714     Otherwise, generate the a marshalling function.
 715     Need to be able to find it in S. Or use an entirely generic one
 716     that evaluates the expressions.
 717     Handle errors in the evaluation of the function by restoring
 718     the stack, if there is one in use for this function (i.e. no 
 719     userData).
 720  */
 721  
 722  Wrapper_print(f, f_wrapper);
 723  
 724  addFunctionPointerProxy(funName, n, t, s_paramTypes);
 725  Delete(s_paramTypes);
 726  Delete(rtype);
 727  Delete(rettype);
 728  Delete(funcparams);
 729  
 730  return funName;
 731}
 732
 733void R::init() {
 734  UnProtectWrapupCode =  
 735    NewStringf("%s", "vmaxset(r_vmax);\nif(r_nprotect)  Rf_unprotect(r_nprotect);\n\n");
 736  
 737  SClassDefs = NewHash();
 738  
 739  sfile = NewString("");
 740  f_init = NewString("");
 741  s_header = NewString("");
 742  f_begin = NewString("");
 743  f_runtime = NewString("");
 744  f_wrapper = NewString("");
 745  s_classes = NewString("");
 746  s_init = NewString("");
 747  s_init_routine = NewString("");
 748}
 749
 750
 751
 752#if 0
 753int R::cDeclaration(Node *n) {
 754  SwigType *t = Getattr(n, "type");
 755  SwigType *name = Getattr(n, "name");
 756  if (debugMode)
 757    Printf(stdout, "cDeclaration (%s): %s\n", name, SwigType_lstr(t, 0));
 758  return Language::cDeclaration(n);
 759}
 760#endif
 761
 762
 763/**
 764   Method from Language that is called to start the entire
 765   processing off, i.e. the generation of the code. 
 766   It is called after the input has been read and parsed.
 767   Here we open the output streams and generate the code.
 768***/
 769int R::top(Node *n) {
 770  String *module = Getattr(n, "name");
 771  if(!Rpackage) 
 772    Rpackage = Copy(module);
 773  if(!DllName)
 774    DllName = Copy(module);
 775
 776  if(outputNamespaceInfo) {
 777    s_namespace = NewString("");
 778    Swig_register_filebyname("snamespace", s_namespace);
 779    Printf(s_namespace, "useDynLib(%s)\n", DllName);
 780  }
 781
 782  /* Associate the different streams with names so that they can be used in %insert directives by the
 783     typemap code. */
 784  Swig_register_filebyname("sinit", s_init);
 785  Swig_register_filebyname("sinitroutine", s_init_routine);
 786
 787  Swig_register_filebyname("begin", f_begin);
 788  Swig_register_filebyname("runtime", f_runtime);
 789  Swig_register_filebyname("init", f_init);
 790  Swig_register_filebyname("header", s_header);
 791  Swig_register_filebyname("wrapper", f_wrapper);
 792  Swig_register_filebyname("s", sfile);
 793  Swig_register_filebyname("sclasses", s_classes);
 794
 795  Swig_banner(f_begin);
 796
 797  Printf(f_runtime, "\n");
 798  Printf(f_runtime, "#define SWIGR\n");
 799  Printf(f_runtime, "\n");
 800
 801  
 802  Swig_banner_target_lang(s_init, "#");
 803  outputCommandLineArguments(s_init);
 804
 805  Printf(f_wrapper, "#ifdef __cplusplus\n");
 806  Printf(f_wrapper, "extern \"C\" {\n");
 807  Printf(f_wrapper, "#endif\n\n");
 808
 809  Language::top(n);
 810
 811  Printf(f_wrapper, "#ifdef __cplusplus\n");
 812  Printf(f_wrapper, "}\n");
 813  Printf(f_wrapper, "#endif\n");
 814
 815  String *type_table = NewString("");
 816  SwigType_emit_type_table(f_runtime,f_wrapper);
 817  Delete(type_table);
 818
 819  if(ClassMemberTable) {
 820    //XXX OutputClassAccessInfo(ClassMemberTable, sfile);
 821    Delete(ClassMemberTable);
 822    ClassMemberTable = NULL;
 823  }
 824
 825  Printf(f_init,"}\n");
 826  if(registrationTable)
 827    outputRegistrationRoutines(f_init);
 828
 829  /* Now arrange to write the 2 files - .S and .c. */
 830
 831  DumpCode(n);
 832
 833  Delete(sfile);
 834  Delete(s_classes);
 835  Delete(s_init);
 836  Delete(f_wrapper);
 837  Delete(f_init);
 838
 839  Delete(s_header);
 840  Close(f_begin);
 841  Delete(f_runtime);
 842  Delete(f_begin);
 843
 844  return SWIG_OK;
 845}
 846
 847
 848/*****************************************************
 849  Write the generated code  to the .S and the .c files.
 850****************************************************/
 851int R::DumpCode(Node *n) {
 852  String *output_filename = NewString("");
 853  
 854  
 855  /* The name of the file in which we will generate the S code. */
 856  Printf(output_filename, "%s%s.R", SWIG_output_directory(), Rpackage);
 857  
 858#ifdef R_SWIG_VERBOSE
 859  Printf(stdout, "Writing S code to %s\n", output_filename);
 860#endif
 861  
 862  File *scode = NewFile(output_filename, "w", SWIG_output_files());
 863  if (!scode) {
 864    FileErrorDisplay(output_filename);
 865    SWIG_exit(EXIT_FAILURE);
 866  }
 867  Delete(output_filename);
 868  
 869  
 870  Printf(scode, "%s\n\n", s_init);
 871  Printf(scode, "%s\n\n", s_classes);
 872  Printf(scode, "%s\n", sfile);
 873  
 874  Close(scode);
 875  //  Delete(scode);
 876  String *outfile = Getattr(n,"outfile");
 877  File *runtime = NewFile(outfile,"w", SWIG_output_files());
 878  if (!runtime) {
 879    FileErrorDisplay(outfile);
 880    SWIG_exit(EXIT_FAILURE);
 881  }
 882  
 883  Printf(runtime, "%s", f_begin);
 884  Printf(runtime, "%s\n", f_runtime);
 885  Printf(runtime, "%s\n", s_header);
 886  Printf(runtime, "%s\n", f_wrapper);
 887  Printf(runtime, "%s\n", f_init);
 888
 889  Close(runtime);
 890  Delete(runtime);
 891
 892  if(outputNamespaceInfo) {
 893    output_filename = NewString("");
 894    Printf(output_filename, "%sNAMESPACE", SWIG_output_directory());
 895    File *ns = NewFile(output_filename, "w", SWIG_output_files());
 896    if (!ns) {
 897      FileErrorDisplay(output_filename);
 898      SWIG_exit(EXIT_FAILURE);
 899    }
 900    Delete(output_filename);
 901   
 902    Printf(ns, "%s\n", s_namespace);
 903
 904    Printf(ns, "\nexport(\n");
 905    writeListByLine(namespaceFunctions, ns);
 906    Printf(ns, ")\n");
 907    Printf(ns, "\nexportMethods(\n");
 908    writeListByLine(namespaceFunctions, ns, 1);
 909    Printf(ns, ")\n");
 910    Close(ns);
 911    Delete(ns);
 912    Delete(s_namespace);
 913  }
 914
 915  return SWIG_OK;
 916}
 917
 918
 919
 920/*
 921  We may need to do more.... so this is left as a 
 922  stub for the moment.
 923*/
 924int R::OutputClassAccessInfo(Hash *tb, File *out) {
 925  int n = OutputClassMemberTable(tb, out);
 926  OutputClassMethodsTable(out);
 927  return n;
 928}
 929
 930/************************************************************************
 931  Currently this just writes the information collected about the
 932  different methods of the C++ classes that have been processed
 933  to the console. 
 934  This will be used later to define S4 generics and methods.
 935**************************************************************************/
 936int R::OutputClassMethodsTable(File *) {
 937  Hash *tb = ClassMethodsTable;
 938  
 939  if(!tb)
 940    return SWIG_OK;
 941  
 942  List *keys = Keys(tb);
 943  String *key;
 944  int i, n = Len(keys);
 945  if (debugMode) {
 946    for(i = 0; i < n ; i++ ) {
 947      key = Getitem(keys, i);
 948      Printf(stdout, "%d) %s\n", i, key);
 949      List *els = Getattr(tb, key);
 950      int nels = Len(els);
 951      Printf(stdout, "\t");
 952      for(int j = 0; j < nels; j+=2) {
 953	Printf(stdout, "%s%s", Getitem(els, j), j < nels - 1 ? ", " : "");
 954	Printf(stdout, "%s\n", Getitem(els, j+1));
 955      }
 956      Printf(stdout, "\n");
 957    }
 958  }
 959
 960  return SWIG_OK;
 961}
 962
 963
 964/*
 965  Iterate over the <class name>_set and <>_get 
 966  elements and generate the $ and $<- functions
 967  that provide constrained access to the member
 968  fields in these elements.
 969
 970  tb - a hash table that is built up in functionWrapper
 971  as we process each membervalueHandler.
 972  The entries are indexed by <class name>_set and 
 973  <class_name>_get. Each entry is a List *.
 974   
 975  out - the stram where the code is to be written. This is the S
 976  code stream as we generate only S code here..
 977*/
 978int R::OutputClassMemberTable(Hash *tb, File *out) {
 979  List *keys = Keys(tb), *el;
 980  
 981  String *key;
 982  int i, n = Len(keys);
 983  /* Loop over all the  <Class>_set and <Class>_get entries in the table. */
 984  
 985  if(n && outputNamespaceInfo) {
 986    Printf(s_namespace, "exportClasses(");
 987  }
 988  for(i = 0; i < n; i++) {
 989    key = Getitem(keys, i);
 990    el = Getattr(tb, key);
 991    
 992    String *className = Getitem(el, 0);
 993    char *ptr = Char(key);
 994    ptr = &ptr[Len(key) - 3];
 995    int isSet = strcmp(ptr, "set") == 0;
 996    
 997    //        OutputArrayMethod(className, el, out);        
 998    OutputMemberReferenceMethod(className, isSet, el, out);
 999    
1000    if(outputNamespaceInfo) 
1001      Printf(s_namespace, "\"%s\"%s", className, i < n-1 ? "," : "");
1002  }
1003  if(n && outputNamespaceInfo) { 
1004    Printf(s_namespace, ")\n");
1005  }
1006  
1007  return n;
1008}
1009
1010/*******************************************************************
1011 Write the methods for $ or $<- for accessing a member field in an 
1012 struct or union (or class).
1013 className - the name of the struct or union (e.g. Bar for struct Bar)
1014 isSet - a logical value indicating whether the method is for 
1015           modifying ($<-) or accessing ($) the member field.
1016 el - a list of length  2 * # accessible member elements  + 1.
1017      The first element is the name of the class. 
1018      The other pairs are  member name and the name of the R function to access it.
1019 out - the stream where we write the code.
1020********************************************************************/
1021int R::OutputMemberReferenceMethod(String *className, int isSet, 
1022				   List *el, File *out) {
1023  int numMems = Len(el), j;
1024  int varaccessor = 0;
1025  if (numMems == 0) 
1026    return SWIG_OK;
1027  
1028  Wrapper *f = NewWrapper(), *attr = NewWrapper();
1029  
1030  Printf(f->def, "function(x, name%s)", isSet ? ", value" : "");
1031  Printf(attr->def, "function(x, i, j, ...%s)", isSet ? ", value" : "");
1032  
1033  Printf(f->code, "{\n");
1034  Printf(f->code, "%saccessorFuns = list(", tab8);
1035
1036  Node *itemList = NewHash();
1037  bool has_prev = false;
1038  for(j = 0; j < numMems; j+=3) {
1039    String *item = Getitem(el, j);
1040    if (Getattr(itemList, item)) 
1041      continue;
1042    Setattr(itemList, item, "1");
1043    
1044    String *dup = Getitem(el, j + 1);
1045    char *ptr = Char(dup);
1046    ptr = &ptr[Len(dup) - 3];
1047    
1048    if (!strcmp(ptr, "get"))
1049      varaccessor++;
1050
1051    String *pitem;
1052    if (!Strcmp(item, "operator ()")) {
1053      pitem = NewString("call");
1054    } else if (!Strcmp(item, "operator ->")) {
1055      pitem = NewString("deref");
1056    } else if (!Strcmp(item, "operator +")) {
1057      pitem = NewString("add");
1058    } else if (!Strcmp(item, "operator -")) {
1059      pitem = NewString("sub");
1060    } else {
1061      pitem = Copy(item);
1062    }
1063    if (has_prev) 
1064      Printf(f->code, ", ");
1065    Printf(f->code, "'%s' = %s", pitem, dup);
1066    has_prev = true;
1067    Delete(pitem);
1068  }
1069  Delete(itemList);
1070  Printf(f->code, ");\n");
1071  
1072  if (!isSet && varaccessor > 0) {
1073    Printf(f->code, "%svaccessors = c(", tab8);
1074    int vcount = 0;
1075    for(j = 0; j < numMems; j+=3) {
1076      String *item = Getitem(el, j);
1077      String *dup = Getitem(el, j + 1);
1078      char *ptr = Char(dup);
1079      ptr = &ptr[Len(dup) - 3];
1080      
1081      if (!strcmp(ptr, "get")) {
1082	vcount++;
1083	Printf(f->code, "'%s'%s", item, vcount < varaccessor ? ", " : "");
1084      }
1085    }
1086    Printf(f->code, ");\n");
1087  }
1088  
1089  
1090  /*    Printv(f->code, tab8,
1091	"idx = pmatch(name, names(accessorFuns))\n",
1092	tab8,
1093	"if(is.na(idx)) {\n",
1094	tab8, tab4, 
1095	"stop(\"No ", (isSet ? "modifiable" : "accessible"), " field named \", name, \" in ", className,
1096	": fields are \", paste(names(accessorFuns), sep = \", \")", 
1097	")", "\n}\n", NIL); */
1098  Printv(f->code, ";", tab8,
1099	 "idx = pmatch(name, names(accessorFuns));\n",
1100	 tab8,
1101	 "if(is.na(idx)) \n",
1102	 tab8, tab4, NIL);
1103  Printf(f->code, "return(callNextMethod(x, name%s));\n",
1104	 isSet ? ", value" : "");
1105  Printv(f->code, tab8, "f = accessorFuns[[idx]];\n", NIL);
1106  if(isSet) {
1107    Printv(f->code, tab8, "f(x, value);\n", NIL);
1108    Printv(f->code, tab8, "x;\n", NIL); // make certain to return the S value.
1109  } else {
1110    if (varaccessor) {
1111      Printv(f->code, tab8,
1112	     "if (is.na(match(name, vaccessors))) function(...){f(x, ...)} else f(x);\n", NIL);
1113    } else {
1114      Printv(f->code, tab8, "function(...){f(x, ...)};\n", NIL);
1115    }
1116  }
1117  Printf(f->code, "}\n");
1118  
1119  
1120  Printf(out, "# Start of accessor method for %s\n", className);
1121  Printf(out, "setMethod('$%s', '_p%s', ",
1122	 isSet ? "<-" : "", 
1123	 getRClassName(className)); 
1124  Wrapper_print(f, out);
1125  Printf(out, ");\n");
1126  
1127  if(isSet) {
1128    Printf(out, "setMethod('[[<-', c('_p%s', 'character'),", 
1129	   getRClassName(className)); 
1130    Insert(f->code, 2, "name = i;\n");
1131    Printf(attr->code, "%s", f->code);
1132    Wrapper_print(attr, out);
1133    Printf(out, ");\n");
1134  }
1135  
1136  DelWrapper(attr);
1137  DelWrapper(f);
1138  
1139  Printf(out, "# end of accessor method for %s\n", className);
1140  
1141  return SWIG_OK;
1142}
1143
1144/*******************************************************************
1145 Write the methods for [ or [<- for accessing a member field in an 
1146 struct or union (or class).
1147 className - the name of the struct or union (e.g. Bar for struct Bar)
1148 el - a list of length  2 * # accessible member elements  + 1.
1149      The first element is the name of the class. 
1150      The other pairs are  member name and the name of the R function to access it.
1151 out - the stream where we write the code.
1152********************************************************************/
1153int R::OutputArrayMethod(String *className, List *el, File *out) {
1154  int numMems = Len(el), j;
1155  
1156  if(!el || numMems == 0)
1157    return(0);
1158  
1159  Printf(out, "# start of array methods for %s\n", className);
1160  for(j = 0; j < numMems; j+=3) {
1161    String *item = Getitem(el, j);
1162    String *dup = Getitem(el, j + 1);
1163    if (!Strcmp(item, "__getitem__")) {
1164      Printf(out, 
1165	     "setMethod('[', '_p%s', function(x, i, j, ..., drop =TRUE) ", 
1166	     getRClassName(className));
1167      Printf(out, "  sapply(i, function (n)  %s(x, as.integer(n-1))))\n\n", dup);
1168    }
1169    if (!Strcmp(item, "__setitem__")) {
1170      Printf(out, "setMethod('[<-', '_p%s', function(x, i, j, ..., value)", 
1171	     getRClassName(className));
1172      Printf(out, "  sapply(1:length(i), function(n) %s(x, as.integer(i[n]-1), value[n])))\n\n", dup);
1173    }
1174    
1175  }
1176  
1177  Printf(out, "# end of array methods for %s\n", className);
1178  
1179  return SWIG_OK;
1180}
1181
1182
1183/************************************************************
1184 Called when a enumeration is to be processed.
1185 We want to call the R function defineEnumeration().
1186 tdname is the typedef of the enumeration, i.e. giving its name.
1187*************************************************************/
1188int R::enumDeclaration(Node *n) {
1189  String *name = Getattr(n, "name");
1190  String *tdname = Getattr(n, "tdname");
1191  
1192  /* Using name if tdname is empty. */
1193  
1194  if(Len(tdname) == 0)
1195    tdname = name;
1196
1197
1198  if(!tdname || Strcmp(tdname, "") == 0) {
1199    Language::enumDeclaration(n);
1200    return SWIG_OK;
1201  }
1202  
1203  String *mangled_tdname = SwigType_manglestr(tdname);
1204  String *scode = NewString("");
1205  
1206  Printv(scode, "defineEnumeration('", mangled_tdname, "'", 
1207	 ",\n",  tab8, tab8, tab4, ".values = c(\n", NIL);
1208  
1209  Node *c;
1210  int value = -1; // First number is zero
1211  for (c = firstChild(n); c; c = nextSibling(c)) {
1212    //      const char *tag = Char(nodeType(c));
1213    //      if (Strcmp(tag,"cdecl") == 0) {        
1214    name = Getattr(c, "name");
1215    String *val = Getattr(c, "enumvalue");
1216    if(val && Char(val)) {
1217      int inval = (int) getNumber(val);
1218      if(inval == DEFAULT_NUMBER) 
1219	value++;
1220      else 
1221	value = inval;
1222    } else
1223      value++;
1224    
1225    Printf(scode, "%s%s%s'%s' = %d%s\n", tab8, tab8, tab8, name, value,
1226	   nextSibling(c) ? ", " : "");
1227    //      }
1228  }
1229  
1230  Printv(scode, "))", NIL);
1231  Printf(sfile, "%s\n", scode);
1232  
1233  Delete(scode);
1234  Delete(mangled_tdname);
1235  
1236  return SWIG_OK;
1237}
1238
1239
1240/*************************************************************
1241**************************************************************/
1242int R::variableWrapper(Node *n) {
1243  String *name = Getattr(n, "sym:name");
1244  
1245  processing_variable = 1;
1246  Language::variableWrapper(n); // Force the emission of the _set and _get function wrappers.
1247  processing_variable = 0;
1248  
1249  
1250  SwigType *ty = Getattr(n, "type");
1251  int addCopyParam = addCopyParameter(ty);
1252  
1253  //XXX
1254  processType(ty, n);
1255  
1256  if(!SwigType_isconst(ty)) {
1257    Wrapper *f = NewWrapper();
1258    Printf(f->def, "%s = \nfunction(value%s)\n{\n", 
1259	   name, addCopyParam ? ", .copy = FALSE" : "");
1260    Printv(f->code, "if(missing(value)) {\n", 
1261	   name, "_get(", addCopyParam ? ".copy" : "", ")\n}", NIL);
1262    Printv(f->code, " else {\n", 
1263	   name, "_set(value)\n}\n}", NIL);
1264    
1265    Wrapper_print(f, sfile);
1266    DelWrapper(f);
1267  } else {
1268    Printf(sfile, "%s = %s_get\n", name, name);
1269  }
1270
1271  return SWIG_OK;
1272}
1273
1274
1275void R::addAccessor(String *memberName, Wrapper *wrapper, String *name, 
1276		    int isSet) {
1277  if(isSet < 0) {
1278    int n = Len(name);
1279    char *ptr = Char(name);
1280    isSet = Strcmp(NewString(&ptr[n-3]), "set") == 0;
1281  }
1282  
1283  List *l = isSet ? class_member_set_functions : class_member_functions;
1284  
1285  if(!l) {
1286    l = NewList();
1287    if(isSet)
1288      class_member_set_functions = l;
1289    else
1290      class_member_functions = l;
1291  }
1292  
1293  Append(l, memberName);
1294  Append(l, name);
1295  
1296  String *tmp = NewString("");
1297  Wrapper_print(wrapper, tmp);
1298  Append(l, tmp);
1299  // if we could put the wrapper in directly:       Append(l, Copy(sfun));
1300  if (debugMode)
1301    Printf(stdout, "Adding accessor: %s (%s) => %s\n", memberName, name, tmp);
1302}
1303
1304#define MAX_OVERLOAD 256
1305
1306struct Overloaded {
1307  Node      *n;          /* Node                               */
1308  int        argc;       /* Argument count                     */
1309  ParmList  *parms;      /* Parameters used for overload check */
1310  int        error;      /* Ambiguity error                    */
1311};
1312
1313
1314List * R::Swig_overload_rank(Node *n, 
1315				 bool script_lang_wrapping) {
1316  Overloaded  nodes[MAX_OVERLOAD];
1317  int         nnodes = 0;
1318  Node *o = Getattr(n,"sym:overloaded");
1319
1320
1321  if (!o) return 0;
1322
1323  Node *c = o;
1324  while (c) {
1325    if (Getattr(c,"error")) {
1326      c = Getattr(c,"sym:nextSibling");
1327      continue;
1328    }
1329    /*    if (SmartPointer && Getattr(c,"cplus:staticbase")) {
1330	  c = Getattr(c,"sym:nextSibling");
1331	  continue;
1332	  } */
1333
1334    /* Make a list of all the declarations (methods) that are overloaded with
1335     * this one particular method name */
1336
1337    if (Getattr(c,"wrap:name")) {
1338      nodes[nnodes].n = c;
1339      nodes[nnodes].parms = Getattr(c,"wrap:parms");
1340      nodes[nnodes].argc = emit_num_required(nodes[nnodes].parms);
1341      nodes[nnodes].error = 0;
1342      nnodes++;
1343    }
1344    c = Getattr(c,"sym:nextSibling");
1345  }
1346  
1347  /* Sort the declarations by required argument count */
1348  {
1349    int i,j;
1350    for (i = 0; i < nnodes; i++) {
1351      for (j = i+1; j < nnodes; j++) {
1352	if (nodes[i].argc > nodes[j].argc) {
1353	  Overloaded t = nodes[i];
1354	  nodes[i] = nodes[j];
1355	  nodes[j] = t;
1356	}
1357      }
1358    }
1359  }
1360
1361  /* Sort the declarations by argument types */
1362  {
1363    int i,j;
1364    for (i = 0; i < nnodes-1; i++) {
1365      if (nodes[i].argc == nodes[i+1].argc) {
1366	for (j = i+1; (j < nnodes) && (nodes[j].argc == nodes[i].argc); j++) {
1367	  Parm *p1 = nodes[i].parms;
1368	  Parm *p2 = nodes[j].parms;
1369	  int   differ = 0;
1370	  int   num_checked = 0;
1371	  while (p1 && p2 && (num_checked < nodes[i].argc)) {
1372	    if (debugMode) {
1373	      Printf(stdout,"p1 = '%s', p2 = '%s'\n", Getattr(p1,"type"), Getattr(p2,"type"));
1374	    }
1375	    if (checkAttribute(p1,"tmap:in:numinputs","0")) {
1376	      p1 = Getattr(p1,"tmap:in:next");
1377	      continue;
1378	    }
1379	    if (checkAttribute(p2,"tmap:in:numinputs","0")) {
1380	      p2 = Getattr(p2,"tmap:in:next");
1381	      continue;
1382	    }
1383	    String *t1 = Getattr(p1,"tmap:typecheck:precedence");
1384	    String *t2 = Getattr(p2,"tmap:typecheck:precedence");
1385	    if (debugMode) {
1386	      Printf(stdout,"t1 = '%s', t2 = '%s'\n", t1, t2);
1387	    }
1388	    if ((!t1) && (!nodes[i].error)) {
1389	      Swig_warning(WARN_TYPEMAP_TYPECHECK, Getfile(nodes[i].n), Getline(nodes[i].n),
1390			   "Overloaded method %s not supported (no type checking rule for '%s').\n",
1391			   Swig_name_decl(nodes[i].n), SwigType_str(Getattr(p1, "type"), 0));
1392	      nodes[i].error = 1;
1393	    } else if ((!t2) && (!nodes[j].error)) {
1394	      Swig_warning(WARN_TYPEMAP_TYPECHECK, Getfile(nodes[j].n), Getline(nodes[j].n),
1395			   "xx Overloaded method %s not supported (no type checking rule for '%s').\n",
1396			   Swig_name_decl(nodes[j].n), SwigType_str(Getattr(p2, "type"), 0));
1397	      nodes[j].error = 1;
1398	    }
1399	    if (t1 && t2) {
1400	      int t1v, t2v;
1401	      t1v = atoi(Char(t1));
1402	      t2v = atoi(Char(t2));
1403	      differ = t1v-t2v;
1404	    }
1405	    else if (!t1 && t2) differ = 1;
1406	    else if (t1 && !t2) differ = -1;
1407	    else if (!t1 && !t2) differ = -1;
1408	    num_checked++;
1409	    if (differ > 0) {
1410	      Overloaded t = nodes[i];
1411	      nodes[i] = nodes[j];
1412	      nodes[j] = t;
1413	      break;
1414	    } else if ((differ == 0) && (Strcmp(t1,"0") == 0)) {
1415	      t1 = Getattr(p1,"ltype");
1416	      if (!t1) {
1417		t1 = SwigType_ltype(Getattr(p1,"type"));
1418		if (Getattr(p1,"tmap:typecheck:SWIGTYPE")) {
1419		  SwigType_add_pointer(t1);
1420		}
1421		Setattr(p1,"ltype",t1);
1422	      }
1423	      t2 = Getattr(p2,"ltype");
1424	      if (!t2) {
1425		t2 = SwigType_ltype(Getattr(p2,"type"));
1426		if (Getattr(p2,"tmap:typecheck:SWIGTYPE")) {
1427		  SwigType_add_pointer(t2);
1428		}
1429		Setattr(p2,"ltype",t2);
1430	      }
1431
1432	      /* Need subtype check here.  If t2 is a subtype of t1, then we need to change the
1433                 order */
1434
1435	      if (SwigType_issubtype(t2,t1)) {
1436		Overloaded t = nodes[i];
1437		nodes[i] = nodes[j];
1438		nodes[j] = t;
1439	      }
1440
1441	      if (Strcmp(t1,t2) != 0) {
1442		differ = 1;
1443		break;
1444	      }
1445	    } else if (differ) {
1446	      break;
1447	    }
1448	    if (Getattr(p1,"tmap:in:next")) {
1449	      p1 = Getattr(p1,"tmap:in:next");
1450	    } else {
1451	      p1 = nextSibling(p1);
1452	    }
1453	    if (Getattr(p2,"tmap:in:next")) {
1454	      p2 = Getattr(p2,"tmap:in:next");
1455	    } else {
1456	      p2 = nextSibling(p2);
1457	    }
1458	  }
1459	  if (!differ) {
1460	    /* See if declarations differ by const only */
1461	    String *d1 = Getattr(nodes[i].n, "decl");
1462	    String *d2 = Getattr(nodes[j].n, "decl");
1463	    if (d1 && d2) {
1464	      String *dq1 = Copy(d1);
1465	      String *dq2 = Copy(d2);
1466	      if (SwigType_isconst(d1)) {
1467		Delete(SwigType_pop(dq1));
1468	      }
1469	      if (SwigType_isconst(d2)) {
1470		Delete(SwigType_pop(dq2));
1471	      }
1472	      if (Strcmp(dq1, dq2) == 0) {
1473
1474		if (SwigType_isconst(d1) && !SwigType_isconst(d2)) {
1475		  if (script_lang_wrapping) {
1476		    // Swap nodes so that the const method gets ignored (shadowed by the non-const method)
1477		    Overloaded t = nodes[i];
1478		    nodes[i] = nodes[j];
1479		    nodes[j] = t;
1480		  }
1481		  differ = 1;
1482		  if (!nodes[j].error) {
1483		    if (script_lang_wrapping) {
1484		      Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[j].n), Getline(nodes[j].n),
1485				   "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n));
1486		      Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[i].n), Getline(nodes[i].n),
1487				   "using non-const method %s instead.\n", Swig_name_decl(nodes[i].n));
1488		    } else {
1489		      if (!Getattr(nodes[j].n, "overload:ignore"))
1490			Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
1491				     "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n));
1492			Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[i].n), Getline(nodes[i].n),
1493				     "using %s instead.\n", Swig_name_decl(nodes[i].n));
1494		    }
1495		  }
1496		  nodes[j].error = 1;
1497		} else if (!SwigType_isconst(d1) && SwigType_isconst(d2)) {
1498		  differ = 1;
1499		  if (!nodes[j].error) {
1500		    if (script_lang_wrapping) {
1501		      Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[j].n), Getline(nodes[j].n),
1502				   "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n));
1503		      Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[i].n), Getline(nodes[i].n),
1504				   "using non-const method %s instead.\n", Swig_name_decl(nodes[i].n));
1505		    } else {
1506		      if (!Getattr(nodes[j].n, "overload:ignore"))
1507			Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
1508				     "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n));
1509			Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[i].n), Getline(nodes[i].n),
1510				     "using %s instead.\n", Swig_name_decl(nodes[i].n));
1511		    }
1512		  }
1513		  nodes[j].error = 1;
1514		}
1515	      }
1516	      Delete(dq1);
1517	      Delete(dq2);
1518	    }
1519	  }
1520	  if (!differ) {
1521	    if (!nodes[j].error) {
1522	      if (script_lang_wrapping) {
1523		Swig_warning(WARN_LANG_OVERLOAD_SHADOW, Getfile(nodes[j].n), Getline(nodes[j].n),
1524			     "Overloaded method %s effectively ignored,\n", Swig_name_decl(nodes[j].n));
1525		Swig_warning(WARN_LANG_OVERLOAD_SHADOW, Getfile(nodes[i].n), Getline(nodes[i].n),
1526			     "as it is shadowed by %s.\n", Swig_name_decl(nodes[i].n));
1527	      } else {
1528		if (!Getattr(nodes[j].n, "overload:ignore"))
1529		  Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
1530			       "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n));
1531		  Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[i].n), Getline(nodes[i].n),
1532			       "using %s instead.\n", Swig_name_decl(nodes[i].n));
1533	      }
1534	      nodes[j].error = 1;
1535	    }
1536	  }
1537	}
1538      }
1539    }
1540  }
1541  List *result = NewList();
1542  {
1543    int i;
1544    for (i = 0; i < nnodes; i++) {
1545      if (nodes[i].error)
1546        Setattr(nodes[i].n, "overload:ignore", "1");
1547      Append(result,nodes[i].n);
1548      //      Printf(stdout,"[ %d ] %s\n", i, ParmList_errorstr(nodes[i].parms));
1549      //      Swig_print_node(nodes[i].n);
1550    }
1551  }
1552  return result;
1553}
1554
1555void R::dispatchFunction(Node *n) {
1556  Wrapper *f = NewWrapper();
1557  String *symname = Getattr(n, "sym:name");
1558  String *nodeType = Getattr(n, "nodeType");
1559  bool constructor = (!Cmp(nodeType, "constructor")); 
1560
1561  String *sfname = NewString(symname);
1562
1563  if (constructor)
1564    Replace(sfname, "new_", "", DOH_REPLACE_FIRST);
1565
1566  Printf(f->def,
1567	 "`%s` <- function(...) {", sfname);
1568  if (debugMode) {
1569    Swig_print_node(n);
1570  }
1571  List *dispatch = Swig_overload_rank(n, true);
1572  int   nfunc = Len(dispatch);
1573  Printv(f->code, 
1574	 "argtypes <- mapply(class, list(...));\n",
1575	 "argv <- list(...);\n",
1576	 "argc <- length(argtypes);\n", NIL );
1577
1578  Printf(f->code, "# dispatch functions %d\n", nfunc);
1579  int cur_args = -1;
1580  bool first_compare = true;
1581  for (int i=0; i < nfunc; i++) {
1582    Node *ni = Getitem(dispatch,i);
1583    Parm *pi = Getattr(ni,"wrap:parms");
1584    int num_arguments = emit_num_arguments(pi);
1585
1586    String *overname = Getattr(ni,"sym:overname");      
1587    if (cur_args != num_arguments) {
1588      if (cur_args != -1) {
1589	Printv(f->code, "} else ", NIL);
1590      }
1591      Printf(f->code, "if (argc == %d) {", num_arguments);
1592      cur_args = num_arguments;
1593      first_compare = true;
1594    }
1595    Parm *p;
1596    int j;
1597    if (num_arguments > 0) {
1598      if (!first_compare) {
1599	Printv(f->code, " else ", NIL);
1600      } else {
1601	first_compare = false;
1602      }
1603      Printv(f->code, "if (", NIL);
1604      for (p =pi, j = 0 ; j < num_arguments ; j++) {
1605	if (debugMode) {
1606	  Swig_print_node(p);
1607	}
1608	String *tm = Swig_typemap_lookup("rtype", p, "", 0);
1609	if(tm) {
1610	  replaceRClass(tm, Getattr(p, "type"));
1611	}
1612
1613	String *tmcheck = Swig_typemap_lookup("rtypecheck", p, "", 0);
1614	if (tmcheck) {
1615
1616	  String *tmp = NewString("");
1617	  Printf(tmp, "argv[[%d]]", j+1);
1618	  Replaceall(tmcheck, "$arg", tmp);
1619	  Printf(tmp, "argtype[%d]", j+1);
1620	  Replaceall(tmcheck, "$argtype", tmp);
1621	  if (tm) {
1622	    Replaceall(tmcheck, "$rtype", tm);
1623	  }
1624	  if (debugMode) {
1625	    Printf(stdout, "<rtypecheck>%s\n", tmcheck);
1626	  }
1627	  Printf(f->code, "%s(%s)",
1628		 j == 0? "" : " && ",
1629		 tmcheck);
1630	  p = Getattr(p, "tmap:in:next");
1631	  continue;
1632	} 
1633	if (DohStrcmp(tm,"numeric")==0) {
1634	    Printf(f->code, "%sis.numeric(argv[[%d]])",
1635		   j == 0 ? "" : " && ",
1636		   j+1);
1637	  }
1638	  else if (DohStrcmp(tm,"integer")==0) {
1639	    Printf(f->code, "%s(is.integer(argv[[%d]]) || is.numeric(argv[[%d]]))",
1640		   j == 0 ? "" : " && ",
1641		   j+1, j+1);
1642	  }
1643	  else if (DohStrcmp(tm,"character")==0) {
1644	    Printf(f->code, "%sis.character(argv[[%d]])",
1645		   j == 0 ? "" : " && ",
1646		   j+1);
1647	  }
1648	  else {
1649	    Printf(f->code, "%sextends(argtypes[%d], '%s')",
1650		   j == 0 ? "" : " && ",
1651		   j+1,
1652		   tm);
1653	  }
1654	  if (!SwigType_ispointer(Getattr(p, "type"))) {
1655	    Printf(f->code, " && length(argv[[%d]]) == 1",
1656		   j+1);
1657	  }
1658	p = Getattr(p, "tmap:in:next");
1659      }
1660      Printf(f->code, ") { f <- %s%s; }\n", sfname, overname);
1661    } else {
1662      Printf(f->code, "f <- %s%s; ", sfname, overname);
1663    }
1664  }
1665  if (cur_args != -1) {
1666    Printf(f->code, "} else {\n"
1667	   "stop(\"cannot find overloaded function for %s with argtypes (\","
1668	   "toString(argtypes),\")\");\n"
1669	   "}", sfname);
1670  }
1671  Printv(f->code, ";\nf(...)", NIL);
1672  Printv(f->code, ";\n}", NIL);
1673  Wrapper_print(f, sfile);
1674  Printv(sfile, "# Dispatch function\n", NIL);
1675  DelWrapper(f);
1676}
1677
1678/******************************************************************
1679
1680*******************************************************************/
1681int R::functionWrapper(Node *n) {
1682  String *fname = Getattr(n, "name");
1683  String *iname = Getattr(n, "sym:name");
1684  String *type = Getattr(n, "type"); 
1685  
1686  if (debugMode) {
1687    Printf(stdout, 
1688	   "<functionWrapper> %s %s %s\n", fname, iname, type);
1689  }
1690  String *overname = 0;
1691  String *nodeType = Getattr(n, "nodeType");
1692  bool constructor = (!Cmp(nodeType, "constructor")); 
1693  bool destructor = (!Cmp(nodeType, "destructor")); 
1694  
1695  String *sfname = NewString(iname);
1696  
1697  if (constructor)
1698    Replace(sfname, "new_", "", DOH_REPLACE_FIRST);
1699  
1700  if (Getattr(n,"sym:overloaded")) {
1701    overname = Getattr(n,"sym:overname");      
1702    Append(sfname, overname);
1703  }
1704  
1705  if (debugMode) 
1706    Printf(stdout, 
1707	   "<functionWrapper> processing parameters\n");
1708  
1709  
1710  ParmList *l = Getattr(n, "parms");
1711  Parm *p;
1712  String *tm;
1713  
1714  p = l;
1715  while(p) {
1716    SwigType *resultType = Getattr(p, "type");
1717    if (expandTypedef(resultType) && 
1718	SwigType_istypedef(resultType)) {
1719      SwigType *resolved =
1720	SwigType_typedef_resolve_all(resultType);
1721      if (expandTypedef(resolved)) {
1722	Setattr(p, "type", Copy(resolved));
1723      }
1724    }
1725    p = nextSibling(p);
1726  } 
1727
1728  String *unresolved_return_type = 
1729    Copy(type);
1730  if (expandTypedef(type) &&
1731      SwigType_istypedef(type)) {
1732    SwigType *resolved = 
1733      SwigType_typedef_resolve_all(type);
1734    if (expandTypedef(resolved)) {
1735      type = Copy(resolved);
1736      Setattr(n, "type", type);
1737    }
1738  }
1739  if (debugMode) 
1740    Printf(stdout, "<functionWrapper> unresolved_return_type %s\n",
1741	   unresolved_return_type);
1742  if(processing_member_access_function) {
1743    if (debugMode)
1744      Printf(stdout, "<functionWrapper memberAccess> '%s' '%s' '%s' '%s'\n", 
1745	     fname, iname, member_name, class_name);
1746    
1747    if(opaqueClassDeclaration)
1748      return SWIG_OK;
1749      
1750      
1751    /* Add the name of this member to a list for this class_name. 
1752       We will dump all these at the end. */
1753    
1754    int n = Len(iname);
1755    char *ptr = Char(iname);
1756    bool isSet(Strcmp(NewString(&ptr[n-3]), "set") == 0);
1757    
1758    
1759    String *tmp = NewString("");
1760    Printf(tmp, "%s_%s", class_name, isSet

Large files files are truncated, but you can click here to view the full file