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 10char 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 16static const double DEFAULT_NUMBER = .0000123456712312312323; 17static const int MAX_OVERLOAD_ARGS = 5; 18 19static 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 31static 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 70static 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 109static 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 175static 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 233static 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 243static const char *usage = (char *)"\ 244R 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*************/ 261static void showUsage() { 262 fputs(usage, stdout); 263} 264 265static 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*****/ 278static 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 288static 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 298static 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 310class R : public Language { 311public: 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 356protected: 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 417protected: 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 484R::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 526bool R::debugMode = false; 527 528int 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 546void 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/* 573Returns the name of the new routine. 574*/ 575String * 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 763void 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 783int 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***/ 799int 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****************************************************/ 881int 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*/ 954int 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**************************************************************************/ 966int 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*/ 1008int 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********************************************************************/ 1051int 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********************************************************************/ 1188int 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*************************************************************/ 1223int 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**************************************************************/ 1278int 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 1311void 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 1342struct 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 1350static 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 1588void 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*******************************************************************/ 1670int 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******************************************************/ 2175int 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******************************************************/ 2192int 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 2236void 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 2271int 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 2402int 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******/ 2499int 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**********************/ 2528int 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*/ 2552String * 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**/ 2568void 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*/ 2651int 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 */ 2669extern "C" 2670Language *swig_r(void) { 2671 return new R(); 2672} 2673 2674 2675 2676/*************************************************************************************/ 2677 2678/* 2679 Needs to be reworked. 2680*/ 2681String * 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 2746