/tags/rel-1-3-26/SWIG/Source/Modules/ocaml.cxx
C++ | 1965 lines | 1308 code | 263 blank | 394 comment | 211 complexity | 2b1ae9b4a3bb41e5a3e4676037b00d27 MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
Large files files are truncated, but you can click here to view the full file
1/****************************************************************************** 2 * Simplified Wrapper and Interface Generator (SWIG) 3 * 4 * Author : Art Yerkes 5 * Modified from mzscheme.cxx : David Beazley 6 * 7 * Please read the file LICENSE for the copyright and terms by which SWIG 8 * can be used and distributed. 9 *****************************************************************************/ 10 11char cvsroot_ocaml_cxx[] = "$Header$"; 12 13/*********************************************************************** 14 * $Header$ 15 * 16 * ocaml.cxx 17 * 18 * Definitions for adding functions to Ocaml 101 19 ***********************************************************************/ 20 21#include "swigmod.h" 22 23#include <ctype.h> 24 25static const char *usage = (char*) 26 ("Ocaml Options (available with -ocaml)\n" 27 "-prefix <name> - Set a prefix <name> to be prepended to all names\n" 28 "-where - Emit library location\n" 29 "-suffix <name> - Change .cxx to something else\n" 30 "-oldvarnames - old intermediary method names for variable wrappers\n" 31 "\n"); 32 33static int classmode = 0; 34static int in_constructor = 0, in_destructor = 0, in_copyconst = 0; 35static int const_enum = 0; 36static int static_member_function = 0; 37static int generate_sizeof = 0; 38static char *prefix=0; 39static char *ocaml_path=(char*)"ocaml"; 40static bool old_variable_names = false; 41static String *classname=0; 42static String *module=0; 43static String *init_func_def = 0; 44static String *f_classtemplate = 0; 45static String *name_qualifier = 0; 46 47static Hash *seen_enums = 0; 48static Hash *seen_enumvalues = 0; 49static Hash *seen_constructors = 0; 50 51static File *f_header = 0; 52static File *f_runtime = 0; 53static File *f_wrappers = 0; 54static File *f_directors = 0; 55static File *f_directors_h = 0; 56static File *f_init = 0; 57static File *f_mlout = 0; 58static File *f_mliout = 0; 59static File *f_mlbody = 0; 60static File *f_mlibody = 0; 61static File *f_mltail = 0; 62static File *f_mlitail = 0; 63static File *f_enumtypes_type = 0; 64static File *f_enumtypes_value = 0; 65static File *f_class_ctors = 0; 66static File *f_class_ctors_end = 0; 67static File *f_enum_to_int = 0; 68static File *f_int_to_enum = 0; 69 70class OCAML : public Language { 71public: 72 73 OCAML() 74 { 75 director_prot_ctor_code = NewString(""); 76 Printv(director_prot_ctor_code, 77 "if ( $comparison ) { /* subclassed */\n", 78 " $director_new \n", 79 "} else {\n", 80 " failwith(\"accessing abstract class or protected constructor\"); \n", 81 "}\n", NIL); 82 director_multiple_inheritance = 1; 83 director_language = 1; 84 } 85 86 87 String *Swig_class_name(Node *n) { 88 String *name; 89 name = Copy(Getattr(n, "sym:name")); 90 return name; 91 } 92 93 void PrintIncludeArg() { 94 Printv(stdout,SWIG_LIB,SWIG_FILE_DELIMETER,ocaml_path, 95 "\n",NIL); 96 } 97 98 /* ------------------------------------------------------------ 99 * main() 100 * ------------------------------------------------------------ */ 101 102 virtual void main (int argc, char *argv[]) { 103 int i; 104 105 prefix = 0; 106 107 SWIG_library_directory(ocaml_path); 108 109 // Look for certain command line options 110 for (i = 1; i < argc; i++) { 111 if (argv[i]) { 112 if (strcmp (argv[i], "-help") == 0) { 113 fputs (usage, stdout); 114 SWIG_exit (0); 115 } else if (strcmp (argv[i], "-where") == 0) { 116 PrintIncludeArg(); 117 SWIG_exit (0); 118 } else if (strcmp (argv[i], "-prefix") == 0) { 119 if (argv[i + 1]) { 120 prefix = new char[strlen(argv[i + 1]) + 2]; 121 strcpy(prefix, argv[i + 1]); 122 Swig_mark_arg (i); 123 Swig_mark_arg (i + 1); 124 i++; 125 } else { 126 Swig_arg_error(); 127 } 128 } else if (strcmp (argv[i], "-suffix") == 0) { 129 if (argv[i + 1]) { 130 SWIG_config_cppext( argv[i+1] ); 131 Swig_mark_arg (i); 132 Swig_mark_arg (i+1); 133 i++; 134 } else 135 Swig_arg_error(); 136 } else if (strcmp(argv[i],"-oldvarnames") == 0) { 137 Swig_mark_arg(i); 138 old_variable_names = true; 139 } 140 } 141 } 142 143 // If a prefix has been specified make sure it ends in a '_' 144 145 if (prefix) { 146 if (prefix[strlen (prefix)] != '_') { 147 prefix[strlen (prefix) + 1] = 0; 148 prefix[strlen (prefix)] = '_'; 149 } 150 } else 151 prefix = (char*)"swig_"; 152 153 // Add a symbol for this module 154 155 Preprocessor_define ("SWIGOCAML 1",0); 156 // Set name of typemaps 157 158 SWIG_typemap_lang("ocaml"); 159 160 // Read in default typemaps */ 161 SWIG_config_file("ocaml.i"); 162 allow_overloading(); 163 164 } 165 166 /* Swig_director_declaration() 167 * 168 * Generate the full director class declaration, complete with base classes. 169 * e.g. "class SwigDirector_myclass : public myclass, public Swig::Director {" 170 * 171 */ 172 173 String *Swig_director_declaration(Node *n) { 174 String* classname = Swig_class_name(n); 175 String *directorname = NewStringf("SwigDirector_%s", classname); 176 String *base = Getattr(n, "classtype"); 177 String *declaration = Swig_class_declaration(n, directorname); 178 Printf(declaration, " : public %s, public Swig::Director {\n", base); 179 Delete(classname); 180 Delete(directorname); 181 return declaration; 182 } 183 184 /* ------------------------------------------------------------ 185 * top() 186 * 187 * Recognize the %module, and capture the module name. 188 * Create the default enum cases. 189 * Set up the named outputs: 190 * 191 * init 192 * ml 193 * mli 194 * wrapper 195 * header 196 * runtime 197 * directors 198 * directors_h 199 * ------------------------------------------------------------ */ 200 201 virtual int top(Node *n) { 202 /* Set comparison with none for ConstructorToFunction */ 203 setSubclassInstanceCheck(NewString("caml_list_nth(args,0) != Val_unit")); 204 205 /* check if directors are enabled for this module. note: this 206 * is a "master" switch, without which no director code will be 207 * emitted. %feature("director") statements are also required 208 * to enable directors for individual classes or methods. 209 * 210 * use %module(directors="1") modulename at the start of the 211 * interface file to enable director generation. 212 */ 213 { 214 Node *module = Getattr(n, "module"); 215 if (module) { 216 Node *options = Getattr(module, "options"); 217 if (options) { 218 if (Getattr(options, "directors")) { 219 allow_directors(); 220 } 221 if (Getattr(options, "dirprot")) { 222 allow_dirprot(); 223 } 224 if (Getattr(options, "sizeof")) { 225 generate_sizeof = 1; 226 } 227 } 228 } 229 } 230 231 /* Initialize all of the output files */ 232 String *outfile = Getattr(n,"outfile"); 233 234 f_runtime = NewFile(outfile,"w"); 235 if (!f_runtime) { 236 FileErrorDisplay(outfile); 237 SWIG_exit(EXIT_FAILURE); 238 } 239 f_init = NewString(""); 240 f_header = NewString(""); 241 f_wrappers = NewString(""); 242 f_directors = NewString(""); 243 f_directors_h = NewString(""); 244 f_enumtypes_type = NewString(""); 245 f_enumtypes_value = NewString(""); 246 init_func_def = NewString(""); 247 f_mlbody = NewString(""); 248 f_mlibody = NewString(""); 249 f_mltail = NewString(""); 250 f_mlitail = NewString(""); 251 f_class_ctors = NewString(""); 252 f_class_ctors_end = NewString(""); 253 f_enum_to_int = NewString(""); 254 f_int_to_enum = NewString(""); 255 f_classtemplate = NewString(""); 256 257 module = Getattr(n,"name"); 258 259 seen_constructors = NewHash(); 260 seen_enums = NewHash(); 261 seen_enumvalues = NewHash(); 262 263 /* Register file targets with the SWIG file handler */ 264 Swig_register_filebyname("init",init_func_def); 265 Swig_register_filebyname("header",f_header); 266 Swig_register_filebyname("wrapper",f_wrappers); 267 Swig_register_filebyname("runtime",f_runtime); 268 Swig_register_filebyname("mli",f_mlibody); 269 Swig_register_filebyname("ml",f_mlbody); 270 Swig_register_filebyname("mlitail",f_mlitail); 271 Swig_register_filebyname("mltail",f_mltail); 272 Swig_register_filebyname("director",f_directors); 273 Swig_register_filebyname("director_h",f_directors_h); 274 Swig_register_filebyname("classtemplate",f_classtemplate); 275 Swig_register_filebyname("class_ctors",f_class_ctors); 276 277 if (old_variable_names) { 278 Swig_name_register("set","%v__set__"); 279 Swig_name_register("get","%v__get__"); 280 } 281 282 Printf( f_runtime, 283 "/* -*- buffer-read-only: t -*- vi: set ro: */\n" ); 284 Printf( f_runtime, "#define SWIG_MODULE \"%s\"\n", module ); 285 /* Module name */ 286 Printf( f_mlbody, "let module_name = \"%s\"\n", module ); 287 Printf( f_mlibody, "val module_name : string\n" ); 288 Printf( f_enum_to_int, 289 "let enum_to_int x (v : c_obj) =\n" 290 " match v with\n" 291 " C_enum _y ->\n" 292 " (let y = _y in match (x : c_enum_type) with\n" 293 " `unknown -> " 294 " (match y with\n" 295 " `Int x -> (Swig.C_int x)\n" 296 " | _ -> raise (LabelNotFromThisEnum v))\n" ); 297 298 Printf( f_int_to_enum, 299 "let int_to_enum x y =\n" 300 " match (x : c_enum_type) with\n" 301 " `unknown -> C_enum (`Int y)\n" ); 302 303 Swig_banner (f_runtime); 304 305 if( directorsEnabled() ) { 306 Printf( f_runtime, "#define SWIG_DIRECTORS\n"); 307 Swig_insert_file("director.swg", f_directors_h); 308 } 309 310 /* Produce the enum_to_int and int_to_enum functions */ 311 312 Printf(f_enumtypes_type,"open Swig\n" 313 "type c_enum_type = [ \n `unknown\n" ); 314 Printf(f_enumtypes_value,"type c_enum_value = [ \n `Int of int\n" ); 315 String *mlfile = NewString(""); 316 String *mlifile = NewString(""); 317 318 Printv(mlfile,module,".ml",NIL); 319 Printv(mlifile,module,".mli",NIL); 320 321 String *mlfilen = NewStringf("%s%s", SWIG_output_directory(),mlfile); 322 if ((f_mlout = NewFile(mlfilen,"w")) == 0) { 323 FileErrorDisplay(mlfilen); 324 SWIG_exit (EXIT_FAILURE); 325 } 326 String *mlifilen = NewStringf("%s%s", SWIG_output_directory(),mlifile); 327 if ((f_mliout = NewFile(mlifilen,"w")) == 0) { 328 FileErrorDisplay(mlifilen); 329 SWIG_exit (EXIT_FAILURE); 330 } 331 332 Language::top(n); 333 334 Printf( f_enum_to_int, 335 ") | _ -> (C_int (get_int v))\n" 336 "let _ = Callback.register \"%s_enum_to_int\" enum_to_int\n", 337 module ); 338 Printf( f_mlibody, 339 "val enum_to_int : c_enum_type -> c_obj -> Swig.c_obj\n" ); 340 341 Printf( f_int_to_enum, 342 "let _ = Callback.register \"%s_int_to_enum\" int_to_enum\n", 343 module ); 344 Printf( f_mlibody, 345 "val int_to_enum : c_enum_type -> int -> c_obj\n" ); 346 Printf( f_init, 347 "#define SWIG_init f_%s_init\n" 348 "%s" 349 "}\n", 350 module, init_func_def ); 351 Printf( f_mlbody, 352 "external f_init : unit -> unit = \"f_%s_init\" ;;\n" 353 "let _ = f_init ()\n", 354 module, module ); 355 Printf( f_enumtypes_type, "]\n" ); 356 Printf( f_enumtypes_value, "]\n\n" 357 "type c_obj = c_enum_value c_obj_t\n" ); 358 359 SwigType_emit_type_table (f_runtime, f_wrappers); 360 /* Close all of the files */ 361 Dump(f_directors_h,f_header); 362 Dump(f_header,f_runtime); 363 Dump(f_directors,f_wrappers); 364 Dump(f_wrappers,f_runtime); 365 Wrapper_pretty_print(f_init,f_runtime); 366 Delete(f_header); 367 Delete(f_wrappers); 368 Delete(f_init); 369 Close(f_runtime); 370 Delete(f_runtime); 371 372 Dump(f_enumtypes_type,f_mlout); 373 Dump(f_enumtypes_value,f_mlout); 374 Dump(f_mlbody,f_mlout); 375 Dump(f_enum_to_int,f_mlout); 376 Dump(f_int_to_enum,f_mlout); 377 Delete(f_int_to_enum); 378 Delete(f_enum_to_int); 379 Dump(f_class_ctors,f_mlout); 380 Dump(f_class_ctors_end,f_mlout); 381 Dump(f_mltail,f_mlout); 382 Close(f_mlout); 383 Delete(f_mlout); 384 385 Dump(f_enumtypes_type,f_mliout); 386 Dump(f_enumtypes_value,f_mliout); 387 Dump(f_mlibody,f_mliout); 388 Dump(f_mlitail,f_mliout); 389 Close(f_mliout); 390 Delete(f_mliout); 391 392 return SWIG_OK; 393 } 394 395 /* Produce an error for the given type */ 396 void throw_unhandled_ocaml_type_error (SwigType *d, const char *types) { 397 Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number, 398 "Unable to handle type %s (%s).\n", SwigType_str(d,0), 399 types ); 400 } 401 402 /* Return true iff T is a pointer type */ 403 int 404 is_a_pointer (SwigType *t) { 405 return SwigType_ispointer(SwigType_typedef_resolve_all(t)); 406 } 407 408 /* 409 * Delete one reference from a given type. 410 */ 411 412 void oc_SwigType_del_reference(SwigType *t) { 413 char *c = Char(t); 414 if (strncmp(c,"q(",2) == 0) { 415 Delete(SwigType_pop(t)); 416 c = Char(t); 417 } 418 if (strncmp(c,"r.",2)) { 419 printf("Fatal error. SwigType_del_pointer applied to non-pointer.\n"); 420 abort(); 421 } 422 Replace(t,"r.","", DOH_REPLACE_ANY | DOH_REPLACE_FIRST); 423 } 424 425 void oc_SwigType_del_array(SwigType *t) { 426 char *c = Char(t); 427 if (strncmp(c,"q(",2) == 0) { 428 Delete(SwigType_pop(t)); 429 c = Char(t); 430 } 431 if (strncmp(c,"a(",2) == 0) { 432 Delete(SwigType_pop(t)); 433 } 434 } 435 436 /* 437 * Return true iff T is a reference type 438 */ 439 440 int 441 is_a_reference (SwigType *t) { 442 return SwigType_isreference(SwigType_typedef_resolve_all(t)); 443 } 444 445 int 446 is_an_array (SwigType *t) { 447 return SwigType_isarray(SwigType_typedef_resolve_all(t)); 448 } 449 450 /* ------------------------------------------------------------ 451 * functionWrapper() 452 * Create a function declaration and register it with the interpreter. 453 * ------------------------------------------------------------ */ 454 455 virtual int functionWrapper(Node *n) { 456 char *iname = GetChar(n,"sym:name"); 457 SwigType *d = Getattr(n,"type"); 458 String *return_type_normalized = normalizeTemplatedClassName(d); 459 ParmList *l = Getattr(n,"parms"); 460 Parm *p; 461 462 Wrapper *f = NewWrapper(); 463 String *proc_name = NewString(""); 464 String *source = NewString(""); 465 String *target = NewString(""); 466 String *arg = NewString(""); 467 String *cleanup = NewString(""); 468 String *outarg = NewString(""); 469 String *build = NewString(""); 470 String *tm; 471 int argout_set = 0; 472 int i = 0; 473 int numargs; 474 int numreq; 475 int newobj = GetFlag(n,"feature:new"); 476 String *nodeType = Getattr(n, "nodeType"); 477 int constructor = !Cmp(nodeType, "constructor"); 478 int destructor = (!Cmp(nodeType, "destructor")); 479 String *storage = Getattr(n,"storage"); 480 int isVirtual = !Cmp(storage,"virtual"); 481 String *overname = 0; 482 bool isOverloaded = Getattr(n,"sym:overloaded") ? true : false; 483 484 // Make a wrapper name for this 485 String *wname = Swig_name_wrapper(iname); 486 if (isOverloaded) { 487 overname = Getattr(n,"sym:overname"); 488 } else { 489 if (!addSymbol(iname,n)) return SWIG_ERROR; 490 } 491 if (overname) { 492 Append(wname, overname); 493 } 494 /* Do this to disambiguate functions emitted from different modules */ 495 Append(wname, module); 496 497 Setattr(n,"wrap:name",wname); 498 499 // Build the name for Scheme. 500 Printv(proc_name,"_",iname,NIL); 501 String *mangled_name = mangleNameForCaml(proc_name); 502 503 if( classmode && in_constructor ) { // Emit constructor for object 504 String *mangled_name_nounder = 505 NewString((char *)(Char(mangled_name))+1); 506 Printf( f_class_ctors_end, 507 "let %s clst = _%s clst\n", 508 mangled_name_nounder, mangled_name_nounder ); 509 Printf(f_mlibody, 510 "val %s : c_obj -> c_obj\n", 511 mangled_name_nounder ); 512 Delete(mangled_name_nounder); 513 } else if( classmode && in_destructor ) { 514 Printf(f_class_ctors, 515 " \"~\", %s ;\n", mangled_name ); 516 } else if( classmode && !in_constructor && !in_destructor && 517 !static_member_function ) { 518 String *opname = Copy(Getattr(n,"name")); 519 520 Replaceall(opname,"operator ",""); 521 522 if( strstr( Char(mangled_name), "__get__" ) ) { 523 String *set_name = Copy(mangled_name); 524 if( !GetFlag(n,"feature:immutable") ) { 525 Replaceall(set_name,"__get__","__set__"); 526 Printf(f_class_ctors, 527 " \"%s\", (fun args -> " 528 "if args = (C_list [ raw_ptr ]) then %s args else %s args) ;\n", 529 opname, mangled_name, set_name ); 530 Delete(set_name); 531 } else { 532 Printf(f_class_ctors, 533 " \"%s\", (fun args -> " 534 "if args = (C_list [ raw_ptr ]) then %s args else C_void) ;\n", 535 opname, mangled_name ); 536 } 537 } else if( strstr( Char(mangled_name), "__set__" ) ) { 538 ; /* Nothing ... handled by the case above */ 539 } else { 540 Printf(f_class_ctors, 541 " \"%s\", %s ;\n", 542 opname, mangled_name); 543 } 544 545 Delete(opname); 546 } 547 548 if( classmode && in_constructor ) { 549 Setattr(seen_constructors,mangled_name,"true"); 550 } 551 552 // writing the function wrapper function 553 Printv(f->def, 554 "SWIGEXT CAML_VALUE ", wname, " (", NIL); 555 Printv(f->def, "CAML_VALUE args", NIL); 556 Printv(f->def, ")\n{", NIL); 557 558 /* Define the scheme name in C. This define is used by several 559 macros. */ 560 //Printv(f->def, "#define FUNC_NAME \"", mangled_name, "\"", NIL); 561 562 // adds local variables 563 Wrapper_add_local(f, "args", "CAMLparam1(args)"); 564 Wrapper_add_local(f, "ret" , "SWIG_CAMLlocal2(swig_result,rv)"); 565 Wrapper_add_local(f, "_v" , "int _v = 0"); 566 if( isOverloaded ) { 567 Wrapper_add_local(f, "i" , "int i"); 568 Wrapper_add_local(f, "argc", "int argc = caml_list_length(args)"); 569 Wrapper_add_local(f, "argv", "CAML_VALUE *argv"); 570 571 Printv( f->code, 572 "argv = (CAML_VALUE *)malloc( argc * sizeof( CAML_VALUE ) );\n" 573 "for( i = 0; i < argc; i++ ) {\n" 574 " argv[i] = caml_list_nth(args,i);\n" 575 "}\n", NIL ); 576 } 577 578 // Declare return variable and arguments 579 // number of parameters 580 // they are called arg0, arg1, ... 581 // the return value is called result 582 583 d = SwigType_typedef_qualified(d); 584 emit_args(d, l, f); 585 586 /* Attach the standard typemaps */ 587 emit_attach_parmmaps(l,f); 588 Setattr(n,"wrap:parms",l); 589 590 numargs = emit_num_arguments(l); 591 numreq = emit_num_required(l); 592 593 Printf(f->code,"swig_result = Val_unit;\n" ); 594 595 // Now write code to extract the parameters (this is super ugly) 596 597 for (i = 0, p = l; i < numargs; i++) { 598 /* Skip ignored arguments */ 599 while (checkAttribute(p,"tmap:in:numinputs","0")) { 600 p = Getattr(p,"tmap:in:next"); 601 } 602 603 SwigType *pt = Getattr(p,"type"); 604 String *ln = Getattr(p,"lname"); 605 pt = SwigType_typedef_qualified(pt); 606 607 // Produce names of source and target 608 Clear(source); 609 Clear(target); 610 Clear(arg); 611 Printf(source, "caml_list_nth(args,%d)", i); 612 Printf(target, "%s",ln); 613 Printv(arg, Getattr(p,"name"),NIL); 614 615 if (i >= numreq) { 616 Printf(f->code,"if (caml_list_length(args) > %d) {\n",i); 617 } 618 // Handle parameter types. 619 if ((tm = Getattr(p,"tmap:in"))) { 620 Replaceall(tm,"$source",source); 621 Replaceall(tm,"$target",target); 622 Replaceall(tm,"$input",source); 623 Setattr(p,"emit:input",source); 624 Printv(f->code, tm, "\n", NIL); 625 p = Getattr(p,"tmap:in:next"); 626 } else { 627 // no typemap found 628 // check if typedef and resolve 629 throw_unhandled_ocaml_type_error (pt,"in"); 630 p = nextSibling(p); 631 } 632 if (i >= numreq) { 633 Printf(f->code,"}\n"); 634 } 635 } 636 637 /* Insert constraint checking code */ 638 for (p = l; p;) { 639 if ((tm = Getattr(p,"tmap:check"))) { 640 Replaceall(tm,"$target",Getattr(p,"lname")); 641 Printv(f->code,tm,"\n",NIL); 642 p = Getattr(p,"tmap:check:next"); 643 } else { 644 p = nextSibling(p); 645 } 646 } 647 648 // Pass output arguments back to the caller. 649 650 for (p = l; p;) { 651 if ((tm = Getattr(p,"tmap:argout"))) { 652 Replaceall(tm,"$source",Getattr(p,"emit:input")); /* Deprecated */ 653 Replaceall(tm,"$target",Getattr(p,"lname")); /* Deprecated */ 654 Replaceall(tm,"$arg",Getattr(p,"emit:input")); 655 Replaceall(tm,"$input",Getattr(p,"emit:input")); 656 Replaceall(tm,"$ntype", 657 normalizeTemplatedClassName(Getattr(p,"type"))); 658 Printv(outarg,tm,"\n",NIL); 659 p = Getattr(p,"tmap:argout:next"); 660 argout_set = 1; 661 } else { 662 p = nextSibling(p); 663 } 664 } 665 666 // Free up any memory allocated for the arguments. 667 668 /* Insert cleanup code */ 669 for (p = l; p;) { 670 if ((tm = Getattr(p,"tmap:freearg"))) { 671 Replaceall(tm,"$target",Getattr(p,"lname")); 672 Printv(cleanup,tm,"\n",NIL); 673 p = Getattr(p,"tmap:freearg:next"); 674 } else { 675 p = nextSibling(p); 676 } 677 } 678 679 /* if the object is a director, and the method call originated from its 680 * underlying python object, resolve the call by going up the c++ 681 * inheritance chain. otherwise try to resolve the method in python. 682 * without this check an infinite loop is set up between the director and 683 * shadow class method calls. 684 */ 685 686 // NOTE: this code should only be inserted if this class is the 687 // base class of a director class. however, in general we haven't 688 // yet analyzed all classes derived from this one to see if they are 689 // directors. furthermore, this class may be used as the base of 690 // a director class defined in a completely different module at a 691 // later time, so this test must be included whether or not directorbase 692 // is true. we do skip this code if directors have not been enabled 693 // at the command line to preserve source-level compatibility with 694 // non-polymorphic swig. also, if this wrapper is for a smart-pointer 695 // method, there is no need to perform the test since the calling object 696 // (the smart-pointer) and the director object (the "pointee") are 697 // distinct. 698 699 if (directorsEnabled()) { 700 if (!is_smart_pointer()) { 701 if (/*directorbase &&*/ !constructor && !destructor 702 && isVirtual && !Getattr(n,"feature:nodirector")) { 703 Wrapper_add_local(f, "director", "Swig::Director *director = 0"); 704 Printf(f->code, "director = dynamic_cast<Swig::Director *>(arg1);\n"); 705 706 Printf(f->code, 707 "if (director && !director->swig_get_up(false))" 708 "director->swig_set_up();\n"); 709 } 710 } 711 } 712 713 // Now write code to make the function call 714 715 emit_action(n,f); 716 717 // Now have return value, figure out what to do with it. 718 719 if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) { 720 Replaceall(tm,"$source","swig_result"); 721 Replaceall(tm,"$target","rv"); 722 Replaceall(tm,"$result","rv"); 723 Replaceall(tm,"$ntype",return_type_normalized); 724 Printv(f->code, tm, "\n",NIL); 725 } else { 726 throw_unhandled_ocaml_type_error (d, "out"); 727 } 728 729 // Dump the argument output code 730 Printv(f->code, Char(outarg),NIL); 731 732 // Dump the argument cleanup code 733 Printv(f->code, Char(cleanup),NIL); 734 735 // Look for any remaining cleanup 736 737 if (GetFlag(n,"feature:new")) { 738 if ((tm = Swig_typemap_lookup_new("newfree",n,"result",0))) { 739 Replaceall(tm,"$source","swig_result"); 740 Printv(f->code, tm, "\n",NIL); 741 } 742 } 743 744 // Free any memory allocated by the function being wrapped.. 745 746 if ((tm = Swig_typemap_lookup_new("swig_result",n,"result",0))) { 747 Replaceall(tm,"$source","result"); 748 Printv(f->code, tm, "\n",NIL); 749 } 750 751 // Wrap things up (in a manner of speaking) 752 753 Printv(f->code, 754 tab4, "swig_result = caml_list_append(swig_result,rv);\n", NIL); 755 if( isOverloaded ) 756 Printv(f->code, "free(argv);\n", NIL); 757 Printv(f->code, 758 tab4, "CAMLreturn(swig_result);\n", NIL ); 759 Printv(f->code, "}\n",NIL); 760 761 Wrapper_print(f, f_wrappers); 762 763 if( isOverloaded ) { 764 if( !Getattr(n,"sym:nextSibling") ) { 765 int maxargs; 766 Wrapper *df = NewWrapper(); 767 String *dispatch = 768 Swig_overload_dispatch(n, 769 "free(argv);\n" 770 "CAMLreturn(%s(args));\n", 771 &maxargs); 772 773 Wrapper_add_local(df, "_v", "int _v = 0"); 774 Wrapper_add_local(df, "argv", "CAML_VALUE *argv"); 775 776 /* Undifferentiate name .. this is the dispatch function */ 777 wname = Swig_name_wrapper(iname); 778 /* Do this to disambiguate functions emitted from different 779 * modules */ 780 Append(wname, module); 781 782 Printv(df->def, 783 "SWIGEXT CAML_VALUE ",wname,"(CAML_VALUE args) {\n" 784 " CAMLparam1(args);\n" 785 " int i;\n" 786 " int argc = caml_list_length(args);\n",NIL); 787 Printv( df->code, 788 "argv = (CAML_VALUE *)malloc( argc * sizeof( CAML_VALUE ) );\n" 789 "for( i = 0; i < argc; i++ ) {\n" 790 " argv[i] = caml_list_nth(args,i);\n" 791 "}\n", NIL ); 792 Printv(df->code,dispatch,"\n",NIL); 793 Printf(df->code,"failwith(\"No matching function for overloaded '%s'\");\n", iname); 794 Printv(df->code,"}\n",NIL); 795 Wrapper_print(df,f_wrappers); 796 797 DelWrapper(df); 798 Delete(dispatch); 799 } 800 } 801 802 Printf(f_mlbody, 803 "external %s_f : c_obj list -> c_obj list = \"%s\" ;;\n" 804 "let %s arg = match %s_f (fnhelper arg) with\n" 805 " [] -> C_void\n" 806 "| [x] -> (if %s then Gc.finalise \n" 807 " (fun x -> ignore ((invoke x) \"~\" C_void)) x) ; x\n" 808 "| lst -> C_list lst ;;\n", 809 mangled_name, wname, 810 mangled_name, mangled_name, newobj ? "true" : "false"); 811 812 if( !classmode || in_constructor || in_destructor || 813 static_member_function ) 814 Printf(f_mlibody, 815 "val %s : c_obj -> c_obj\n", mangled_name ); 816 817 Delete(proc_name); 818 Delete(source); 819 Delete(target); 820 Delete(arg); 821 Delete(outarg); 822 Delete(cleanup); 823 Delete(build); 824 DelWrapper(f); 825 return SWIG_OK; 826 } 827 828 /* ------------------------------------------------------------ 829 * variableWrapper() 830 * 831 * Create a link to a C variable. 832 * This creates a single function _wrap_swig_var_varname(). 833 * This function takes a single optional argument. If supplied, it means 834 * we are setting this variable to some value. If omitted, it means we are 835 * simply evaluating this variable. In the set case we return C_void. 836 * 837 * symname is the name of the variable with respect to C. This 838 * may need to differ from the original name in the case of enums. 839 * enumvname is the name of the variable with respect to ocaml. This 840 * will vary if the variable has been renamed. 841 * ------------------------------------------------------------ */ 842 843 virtual int variableWrapper(Node *n) { 844 char *name = GetChar(n,"feature:symname"); 845 String *iname = Getattr(n,"feature:enumvname"); 846 String *mname = mangleNameForCaml(iname); 847 SwigType *t = Getattr(n,"type"); 848 849 String *proc_name = NewString(""); 850 char var_name[256]; 851 String *tm; 852 String *tm2 = NewString("");; 853 String *argnum = NewString("0"); 854 String *arg = NewString("SWIG_Field(args,0)"); 855 Wrapper *f; 856 857 if( !name ) { 858 name = GetChar(n,"name"); 859 } 860 861 if( !iname ) { 862 iname = Getattr(n,"sym:name"); 863 mname = mangleNameForCaml(NewString(iname)); 864 } 865 866 if (!iname || !addSymbol(iname,n)) return SWIG_ERROR; 867 868 f = NewWrapper(); 869 870 // evaluation function names 871 strcpy(var_name, Char(Swig_name_wrapper(iname))); 872 873 // Build the name for scheme. 874 Printv(proc_name, iname, NIL); 875 876 Printf (f->def, 877 "SWIGEXT CAML_VALUE %s(CAML_VALUE args) {\n", var_name); 878 // Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL); 879 880 Wrapper_add_local (f, "swig_result", "CAML_VALUE swig_result"); 881 882 if (!GetFlag(n,"feature:immutable")) { 883 /* Check for a setting of the variable value */ 884 Printf (f->code, "if (args != Val_int(0)) {\n"); 885 if ((tm = Swig_typemap_lookup_new("varin",n,name,0))) { 886 Replaceall(tm,"$source","args"); 887 Replaceall(tm,"$target",name); 888 Replaceall(tm,"$input","args"); 889 Printv(f->code, tm, "\n",NIL); 890 } else if ((tm = Swig_typemap_lookup_new("in",n,name,0))) { 891 Replaceall(tm,"$source","args"); 892 Replaceall(tm,"$target",name); 893 Replaceall(tm,"$input","args"); 894 Printv(f->code, tm, "\n",NIL); 895 } else { 896 throw_unhandled_ocaml_type_error (t, "varin/in"); 897 } 898 Printf (f->code, "}\n"); 899 } 900 901 // Now return the value of the variable (regardless 902 // of evaluating or setting) 903 904 if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) { 905 Replaceall(tm,"$source",name); 906 Replaceall(tm,"$target","swig_result"); 907 Replaceall(tm,"$result","swig_result"); 908 Printf (f->code, "%s\n", tm); 909 } else if ((tm = Swig_typemap_lookup_new("out",n,name,0))) { 910 Replaceall(tm,"$source",name); 911 Replaceall(tm,"$target","swig_result"); 912 Replaceall(tm,"$result","swig_result"); 913 Printf (f->code, "%s\n", tm); 914 915 } else { 916 throw_unhandled_ocaml_type_error (t, "varout/out"); 917 } 918 919 Printf (f->code, "\nreturn swig_result;\n"); 920 Printf (f->code, "}\n"); 921 922 Wrapper_print (f, f_wrappers); 923 924 // Now add symbol to the Ocaml interpreter 925 926 if( GetFlag( n, "feature:immutable" ) ) { 927 Printf( f_mlbody, 928 "external _%s : c_obj -> Swig.c_obj = \"%s\" \n", 929 mname, var_name ); 930 Printf( f_mlibody, "val _%s : c_obj -> Swig.c_obj\n", iname ); 931 if( const_enum ) { 932 Printf( f_enum_to_int, 933 " | `%s -> _%s C_void\n", 934 mname, mname ); 935 Printf( f_int_to_enum, 936 " if y = (get_int (_%s C_void)) then `%s else\n", 937 mname, mname ); 938 } 939 } else { 940 Printf( f_mlbody, "external _%s : c_obj -> c_obj = \"%s\"\n", 941 mname, var_name ); 942 Printf( f_mlibody, "external _%s : c_obj -> c_obj = \"%s\"\n", 943 mname, var_name ); 944 } 945 946 Delete(proc_name); 947 Delete(argnum); 948 Delete(arg); 949 Delete(tm2); 950 DelWrapper(f); 951 return SWIG_OK; 952 } 953 954 /* ------------------------------------------------------------ 955 * staticmemberfunctionHandler -- 956 * Overridden to set static_member_function 957 * ------------------------------------------------------------ */ 958 959 virtual int staticmemberfunctionHandler( Node *n ) { 960 int rv; 961 static_member_function = 1; 962 rv = Language::staticmemberfunctionHandler( n ); 963 static_member_function = 0; 964 return SWIG_OK; 965 } 966 967 /* ------------------------------------------------------------ 968 * constantWrapper() 969 * 970 * The one trick here is that we have to make sure we rename the 971 * constant to something useful that doesn't collide with the 972 * original if any exists. 973 * ------------------------------------------------------------ */ 974 975 virtual int constantWrapper(Node *n) { 976 String *name = Getattr(n,"feature:symname"); 977 SwigType *type = Getattr(n,"type"); 978 String *value = Getattr(n,"value"); 979 String *qvalue = Getattr(n,"qualified:value"); 980 String *rvalue = NewString(""); 981 String *temp = 0; 982 983 if( qvalue ) value = qvalue; 984 985 if( !name ) { 986 name = mangleNameForCaml(Getattr(n,"name")); 987 Insert(name,0,"_swig_wrap_"); 988 Setattr(n,"feature:symname",name); 989 } 990 991 // See if there's a typemap 992 993 Printv(rvalue, value,NIL); 994 if ((SwigType_type(type) == T_CHAR) && (is_a_pointer(type) == 1)) { 995 temp = Copy(rvalue); 996 Clear(rvalue); 997 Printv(rvalue, "\"", temp, "\"",NIL); 998 Delete(temp); 999 } 1000 if ((SwigType_type(type) == T_CHAR) && (is_a_pointer(type) == 0)) { 1001 temp = Copy(rvalue); 1002 Clear(rvalue); 1003 Printv(rvalue, "'", temp, "'",NIL); 1004 Delete(temp); 1005 } 1006 1007 // Create variable and assign it a value 1008 1009 Printf (f_header, "static %s = ", SwigType_lstr(type,name)); 1010 if ((SwigType_type(type) == T_STRING)) { 1011 Printf (f_header, "\"%s\";\n", value); 1012 } else if (SwigType_type(type) == T_CHAR) { 1013 Printf (f_header, "\'%s\';\n", value); 1014 } else { 1015 Printf (f_header, "%s;\n", value); 1016 } 1017 1018 SetFlag(n,"feature:immutable"); 1019 variableWrapper(n); 1020 return SWIG_OK; 1021 } 1022 1023 int constructorHandler(Node *n) { 1024 int ret; 1025 1026 in_constructor = 1; 1027 ret = Language::constructorHandler(n); 1028 in_constructor = 0; 1029 1030 return ret; 1031 } 1032 1033 /* destructorHandler: 1034 * Turn on destructor flag to inform decisions in functionWrapper 1035 */ 1036 1037 int destructorHandler(Node *n) { 1038 int ret; 1039 1040 in_destructor = 1; 1041 ret = Language::destructorHandler(n); 1042 in_destructor = 0; 1043 1044 return ret; 1045 } 1046 1047 /* copyconstructorHandler: 1048 * Turn on constructor and copyconstructor flags for functionWrapper 1049 */ 1050 1051 int copyconstructorHandler(Node *n) { 1052 int ret; 1053 1054 in_copyconst = 1; 1055 in_constructor = 1; 1056 ret = Language::copyconstructorHandler(n); 1057 in_constructor = 0; 1058 in_copyconst = 0; 1059 1060 return ret; 1061 } 1062 1063 /** 1064 * A simple, somewhat general purpose function for writing to multiple 1065 * streams from a source template. This allows the user to define the 1066 * class definition in ways different from the one I have here if they 1067 * want to. It will also make the class definition system easier to 1068 * fiddle with when I want to change methods, etc. 1069 */ 1070 1071 void Multiwrite( String *s ) { 1072 char *find_marker = strstr(Char(s),"(*Stream:"); 1073 while( find_marker ) { 1074 char *next = strstr(find_marker,"*)"); 1075 find_marker += strlen("(*Stream:"); 1076 1077 if( next ) { 1078 int num_chars = next - find_marker; 1079 String *stream_name = NewString(find_marker); 1080 Delslice(stream_name,num_chars,Len(stream_name)); 1081 File *fout = Swig_filebyname(stream_name); 1082 if( fout ) { 1083 next += strlen("*)"); 1084 char *following = strstr(next,"(*Stream:"); 1085 find_marker = following; 1086 if( !following ) following = next + strlen(next); 1087 String *chunk = NewString(next); 1088 Delslice(chunk,following-next,Len(chunk)); 1089 Printv(fout,chunk,NIL); 1090 } 1091 } 1092 } 1093 } 1094 1095 bool isSimpleType( String *name ) { 1096 char *ch = Char(name); 1097 1098 return 1099 !(strchr(ch,'(') || strchr(ch,'<') || 1100 strchr(ch,')') || strchr(ch,'>')); 1101 } 1102 1103 /* We accept all chars in identifiers because we use strings to index 1104 * them. */ 1105 int validIdentifier( String *name ) { 1106 return Len(name) > 0 ? 1 : 0; 1107 } 1108 1109 /* classHandler 1110 * 1111 * Create a "class" definition for ocaml. I thought quite a bit about 1112 * how I should do this part of it, and arrived here, using a function 1113 * invocation to select a method, and dispatch. This can obviously be 1114 * done better, but I can't see how, given that I want to support 1115 * overloaded methods, out parameters, and operators. 1116 * 1117 * I needed a system that would do this: 1118 * 1119 * a Be able to call these methods: 1120 * int foo( int x ); 1121 * float foo( int x, int &out ); 1122 * 1123 * b Be typeable, even in the presence of mutually dependent classes. 1124 * 1125 * c Support some form of operator invocation. 1126 * 1127 * (c) I chose strings for the method names so that "+=" would be a 1128 * valid method name, and the somewhat natural << (invoke x) "+=" y >> 1129 * would work. 1130 * 1131 * (a) (b) Since the c_obj type exists, it's easy to return C_int in one 1132 * case and C_list [ C_float ; C_int ] in the other. This makes tricky 1133 * problems with out parameters disappear; they're simply appended to the 1134 * return list. 1135 * 1136 * (b) Since every item that comes from C++ is the same type, there is no 1137 * problem with the following: 1138 * 1139 * class Foo; 1140 * class Bar { Foo *toFoo(); } 1141 * class Foo { Bar *toBar(); } 1142 * 1143 * Since the Objective caml types of Foo and Bar are the same. Now that 1144 * I correctly incorporate SWIG's typechecking, this isn't a big deal. 1145 * 1146 * The class is in the form of a function returning a c_obj. The c_obj 1147 * is a C_obj containing a function which invokes a method on the 1148 * underlying object given its type. 1149 * 1150 * The name emitted here is normalized before being sent to 1151 * Callback.register, because we need this string to look up properly 1152 * when the typemap passes the descriptor string. I've been considering 1153 * some, possibly more forgiving method that would do some transformations 1154 * on the $descriptor in order to find a potential match. This is for 1155 * later. 1156 * 1157 * Important things to note: 1158 * 1159 * We rely on exception handling (BadMethodName) in order to call an 1160 * ancestor. This can be improved. 1161 * 1162 * The method used to get :classof could be improved to look at the type 1163 * info that the base pointer contains. It's really an error to have a 1164 * SWIG-generated object that does not contain type info, since the 1165 * existence of the object means that SWIG knows the type. 1166 * 1167 * :parents could use :classof to tell what class it is and make a better 1168 * decision. This could be nice, (i.e. provide a run-time graph of C++ 1169 * classes represented);. 1170 * 1171 * I can't think of a more elegant way of converting a C_obj fun to a 1172 * pointer than "operator &"... 1173 * 1174 * Added a 'sizeof' that will allow you to do the expected thing. 1175 * This should help users to fill buffer structs and the like (as is 1176 * typical in windows-styled code). It's only enabled if you give 1177 * %feature(sizeof) and then, only for simple types. 1178 * 1179 * Overall, carrying the list of methods and base classes has worked well. 1180 * It allows me to give the Ocaml user introspection over their objects. 1181 */ 1182 1183 int classHandler( Node *n ) { 1184 String *name = Getattr(n,"name"); 1185 String *mangled_sym_name = mangleNameForCaml(name); 1186 String *this_class_def = NewString( f_classtemplate ); 1187 String *name_normalized = normalizeTemplatedClassName(name); 1188 String *old_class_ctors = f_class_ctors; 1189 String *base_classes = NewString(""); 1190 f_class_ctors = NewString(""); 1191 bool sizeof_feature = generate_sizeof && isSimpleType(name); 1192 1193 if( !name ) return SWIG_OK; 1194 1195 classname = mangled_sym_name; 1196 classmode = true; 1197 int rv = Language::classHandler(n); 1198 classmode = false; 1199 1200 if( sizeof_feature ) { 1201 Printf( f_wrappers, 1202 "SWIGEXT CAML_VALUE _wrap_%s_sizeof( CAML_VALUE args ) {\n" 1203 " CAMLparam1(args);\n" 1204 " CAMLreturn(Val_int(sizeof(%s)));\n" 1205 "}\n", 1206 mangled_sym_name, name_normalized ); 1207 1208 Printf( f_mlbody, "external __%s_sizeof : unit -> int = " 1209 "\"_wrap_%s_sizeof\"\n", 1210 classname, mangled_sym_name ); 1211 } 1212 1213 1214 /* Insert sizeof operator for concrete classes */ 1215 if( sizeof_feature ) { 1216 Printv(f_class_ctors, "\"sizeof\" , (fun args -> C_int (__", 1217 classname, "_sizeof ())) ;\n", NIL); 1218 } 1219 /* Handle up-casts in a nice way */ 1220 List *baselist = Getattr(n,"bases"); 1221 if (baselist && Len(baselist)) { 1222 Iterator b; 1223 b = First(baselist); 1224 while (b.item) { 1225 String *bname = Getattr(b.item, "name"); 1226 if (bname) { 1227 String *base_create = NewString(""); 1228 Printv(base_create,"(create_class \"",bname,"\")",NIL); 1229 Printv(f_class_ctors, 1230 " \"::",bname,"\", (fun args -> ", 1231 base_create," args) ;\n",NIL); 1232 Printv( base_classes, base_create, " ;\n", NIL ); 1233 } 1234 b = Next(b); 1235 } 1236 } 1237 1238 Replaceall(this_class_def,"$classname",classname); 1239 Replaceall(this_class_def,"$normalized",name_normalized); 1240 Replaceall(this_class_def,"$realname",name); 1241 Replaceall(this_class_def,"$baselist",base_classes); 1242 Replaceall(this_class_def,"$classbody",f_class_ctors); 1243 1244 Delete(f_class_ctors); 1245 f_class_ctors = old_class_ctors; 1246 1247 // Actually write out the class definition 1248 1249 Multiwrite( this_class_def ); 1250 1251 Setattr(n,"ocaml:ctor",classname); 1252 1253 return rv; 1254 } 1255 1256 String *normalizeTemplatedClassName( String *name ) { 1257 String *name_normalized = SwigType_typedef_resolve_all(name); 1258 bool took_action; 1259 1260 do { 1261 took_action = false; 1262 1263 if( is_a_pointer(name_normalized) ) { 1264 SwigType_del_pointer( name_normalized ); 1265 took_action = true; 1266 } 1267 1268 if( is_a_reference(name_normalized) ) { 1269 oc_SwigType_del_reference( name_normalized ); 1270 took_action = true; 1271 } 1272 1273 if( is_an_array(name_normalized) ) { 1274 oc_SwigType_del_array( name_normalized ); 1275 took_action = true; 1276 } 1277 } while( took_action ); 1278 1279 return SwigType_str(name_normalized,0); 1280 } 1281 1282 /* 1283 * Produce the symbol name that ocaml will use when referring to the 1284 * target item. I wonder if there's a better way to do this: 1285 * 1286 * I shudder to think about doing it with a hash lookup, but that would 1287 * make a couple of things easier: 1288 */ 1289 1290 String *mangleNameForCaml( String *s ) { 1291 String *out = Copy(s); 1292 Replaceall(out," ","_xx"); 1293 Replaceall(out,"::","_xx"); 1294 Replaceall(out,",","_x"); 1295 Replaceall(out,"+","_xx_plus"); 1296 Replaceall(out,"-","_xx_minus"); 1297 Replaceall(out,"<","_xx_ldbrace"); 1298 Replaceall(out,">","_xx_rdbrace"); 1299 Replaceall(out,"!","_xx_not"); 1300 Replaceall(out,"%","_xx_mod"); 1301 Replaceall(out,"^","_xx_xor"); 1302 Replaceall(out,"*","_xx_star"); 1303 Replaceall(out,"&","_xx_amp"); 1304 Replaceall(out,"|","_xx_or"); 1305 Replaceall(out,"(","_xx_lparen"); 1306 Replaceall(out,")","_xx_rparen"); 1307 Replaceall(out,"[","_xx_lbrace"); 1308 Replaceall(out,"]","_xx_rbrace"); 1309 Replaceall(out,"~","_xx_bnot"); 1310 Replaceall(out,"=","_xx_equals"); 1311 Replaceall(out,"/","_xx_slash"); 1312 Replaceall(out,".","_xx_dot"); 1313 return out; 1314 } 1315 1316 String *fully_qualify_enum_name( Node *n, String *name ) { 1317 Node *parent = 0; 1318 String *qualification = NewString(""); 1319 String *fully_qualified_name = NewString(""); 1320 String *parent_type = 0; 1321 String *normalized_name; 1322 1323 parent = parentNode(n); 1324 while( parent ) { 1325 parent_type = nodeType(parent); 1326 if( Getattr(parent,"name") ) { 1327 String *parent_copy = 1328 NewStringf("%s::",Getattr(parent,"name")); 1329 if( !Cmp(parent_type,"class") || 1330 !Cmp(parent_type,"namespace") ) 1331 Insert(qualification,0,parent_copy); 1332 Delete(parent_copy); 1333 } 1334 if( !Cmp( parent_type, "class" ) ) break; 1335 parent = parentNode(parent); 1336 } 1337 1338 Printf( fully_qualified_name, "%s%s", qualification, name ); 1339 1340 normalized_name = normalizeTemplatedClassName(fully_qualified_name); 1341 if( !strncmp(Char(normalized_name),"enum ",5) ) { 1342 Insert(normalized_name,5,qualification); 1343 } 1344 1345 return normalized_name; 1346 } 1347 1348 /* Benedikt Grundmann inspired --> Enum wrap styles */ 1349 1350 int enumvalueDeclaration(Node *n) { 1351 String *name = Getattr(n,"name"); 1352 String *qvalue = 0; 1353 1354 if( name_qualifier ) { 1355 qvalue = Copy(name_qualifier); 1356 Printv( qvalue, name, NIL ); 1357 } 1358 1359 if( const_enum && name && !Getattr(seen_enumvalues,name) ) { 1360 Setattr(seen_enumvalues,name,"true"); 1361 SetFlag(n,"feature:immutable"); 1362 Setattr(n,"feature:enumvalue","1"); // this does not appear to be used 1363 1364 if( qvalue ) 1365 Setattr(n,"qualified:value",qvalue); 1366 1367 String *evname = SwigType_manglestr(qvalue); 1368 Insert( evname, 0, "SWIG_ENUM_" ); 1369 1370 Setattr(n,"feature:enumvname",name); 1371 Setattr(n,"feature:symname",evname); 1372 Delete( evname ); 1373 Printf( f_enumtypes_value, "| `%s\n", name ); 1374 1375 return Language::enumvalueDeclaration(n); 1376 } else return SWIG_OK; 1377 } 1378 1379 /* ------------------------------------------------------------------- 1380 * This function is a bit uglier than it deserves. 1381 * 1382 * I used to direct lookup the name of the enum. Now that certain fixes 1383 * have been made in other places, the names of enums are now fully 1384 * qualified, which is a good thing, overall, but requires me to do 1385 * some legwork. 1386 * 1387 * The other thing that uglifies this function is the varying way that 1388 * typedef enum and enum are handled. I need to produce consistent names, 1389 * which means looking up and registering by typedef and enum name. */ 1390 int enumDeclaration(Node *n) { 1391 String *name = Getattr(n,"name"); 1392 String *oname = name ? NewString(name) : NULL; 1393 /* name is now fully qualified */ 1394 String *fully_qualified_name = NewString(name); 1395 bool seen_enum = false; 1396 if( name_qualifier ) 1397 Delete(name_qualifier); 1398 char *strip_position; 1399 name_qualifier = fully_qualify_enum_name(n,NewString("")); 1400 1401 /* Recent changes have distrubed enum and template naming again. 1402 * Will try to keep it consistent by can't guarantee much given 1403 * that these things move around a lot. 1404 * 1405 * I need to figure out a way to isolate this module better. 1406 */ 1407 if( oname ) { 1408 strip_position = strstr(Char(oname),"::"); 1409 1410 while( strip_position ) { 1411 strip_position += 2; 1412 oname = NewString( strip_position ); 1413 strip_position = strstr( Char(oname), "::" ); 1414 } 1415 } 1416 1417 seen_enum = oname ? 1418 (Getattr(seen_enums,fully_qualified_name) ? true : false) : false; 1419 1420 if( oname && !seen_enum ) { 1421 const_enum = true; 1422 Printf( f_enum_to_int, "| `%s -> (match y with\n", oname ); 1423 Printf( f_int_to_enum, "| `%s -> C_enum (\n", oname ); 1424 /* * * * A note about enum name resolution * * * * 1425 * This code should now work, but I think we can do a bit better. 1426 * The problem I'm having is that swig isn't very precise about 1427 * typedef name resolution. My opinion is that SwigType_typedef 1428 * resolve_all should *always* return the enum tag if one exists, 1429 * rather than the admittedly friendlier enclosing typedef. 1430 * 1431 * This would make one of the cases below unnecessary. 1432 * * * */ 1433 Printf( f_mlbody, 1434 "let _ = Callback.register \"%s_marker\" (`%s)\n", 1435 fully_qualified_name, oname ); 1436 if( !strncmp(Char(fully_qualified_name),"enum ",5) ) { 1437 String *fq_noenum = NewString(Char(fully_qualified_name) + 5); 1438 Printf( f_mlbody, 1439 "let _ = Callback.register \"%s_marker\" (`%s)\n" 1440 "let _ = Callback.register \"%s_marker\" (`%s)\n", 1441 fq_noenum, oname, 1442 fq_noenum, name ); 1443 } 1444 1445 Printf( f_enumtypes_type,"| `%s\n", oname ); 1446 Insert(fully_qualified_name,0,"enum "); 1447 Setattr(seen_enums,fully_qualified_name,n); 1448 } 1449 1450 int ret = Language::enumDeclaration(n); 1451 1452 if( const_enum ) { 1453 Printf( f_int_to_enum, "`Int y)\n" ); 1454 Printf( f_enum_to_int, 1455 "| `Int x -> Swig.C_int x\n" 1456 "| _ -> raise (LabelNotFromThisEnum v))\n" ); 1457 } 1458 1459 const_enum = false; 1460 1461 return ret; 1462 } 1463 1464 /*************************************************************************** 1465 * BEGIN C++ Director Class modifications 1466 ***************************************************************************/ 1467 1468 /* 1469 * Modified polymorphism code for Ocaml language module. 1470 * Original: 1471 * C++/Python polymorphism demo code, copyright (C) 2002 Mark Rose 1472 * <mrose@stm.lbl.gov> 1473 * 1474 * TODO 1475 * 1476 * Move some boilerplate code generation to Swig_...() functions. 1477 * 1478 */ 1479 1480 /* --------------------------------------------------------------- 1481 * classDirectorMethod() 1482 * 1483 * Emit a virtual director method to pass a method call on to the 1484 * underlying Python object. 1485 * 1486 * --------------------------------------------------------------- */ 1487 1488 int classDirectorMethod(Node *n, Node *parent, String *super) { 1489 int is_void = 0; 1490 int is_pointer = 0; 1491 String *storage; 1492 String *value; 1493 String *decl; 1494 String *type; 1495 String *name; 1496 String *classname; 1497 String *declaration; 1498 ParmList *l; 1499 Wrapper *w; 1500 String *tm; 1501 String *wrap_args; 1502 String *return_type; 1503 int status = SWIG_OK; 1504 int idx; 1505 bool pure_virtual = false; 1506 1507 storage = Getattr(n, "storage"); 1508 value = Getattr(n, "value"); 1509 classname = Getattr(parent, "sym:name"); 1510 type = Getattr(n, "type"); 1511 name = Getattr(n, "name"); 1512 1513 if (Cmp(storage,"virtual") == 0) { 1514 if (Cmp(value,"0") == 0) { 1515 pure_virtual = true; 1516 } 1517 } 1518 1519 w = NewWrapper(); 1520 declaration = NewString(""); 1521 Wrapper_add_local(w,"swig_result", 1522 "CAMLparam0();\n" 1523 "SWIG_CAMLlocal2(swig_result,args)"); 1524 1525 /* determine if the method returns a pointer */ 1526 decl = Getattr(n, "decl"); 1527 is_pointer = SwigType_ispointer_return(decl); 1528 is_void = (!Cmp(type, "void") && !is_pointer); 1529 1530 /* form complete return type */ 1531 return_type = Copy(type); 1532 { 1533 SwigType *t = Copy(decl); 1534 SwigType *f = 0; 1535 f = SwigType_pop_function(t); 1536 SwigType_push(return_type, t); 1537 Delete(f); 1538 Delete(t); 1539 } 1540 1541 /* virtual method definition */ 1542 l = Getattr(n, "parms"); 1543 String *target; 1544 String *pclassname = NewStringf("SwigDirector_%s", classname); 1545 String *qualified_name = NewStringf("%s::%s", pclassname, name); 1546 target = Swig_method_decl(decl, qualified_name, l, 0, 0); 1547 String *rtype = SwigType_str(type, 0); 1548 Printf(w->def, "%s %s {", rtype, target); 1549 Delete(qualified_name); 1550 Delete(target); 1551 /* header declaration */ 1552 target = Swig_method_decl(decl, name, l, 0, 1); 1553 Printf(declaration, " virtual %s %s;\n", rtype, target); 1554 Delete(target); 1555 1556 /* attach typemaps to arguments (C/C++ -> Ocaml) */ 1557 String *arglist = NewString(""); 1558 1559 Swig_typemap_attach_parms("in", l, 0); 1560 Swig_typemap_attach_parms("directorin", l, 0); 1561 Swig_typemap_attach_parms("directorargout", l, w); 1562 1563 Parm* p; 1564 int num_arguments = emit_num_arguments(l); 1565 int i; 1566 char source[256]; 1567 1568 wrap_args = NewString(""); 1569 int outputs = 0; 1570 if (!is_void) outputs++; 1571 1572 /* build argument list and type conversion string */ 1573 for (i=0, idx=0, p = l; i < num_arguments; i++) { 1574 1575 while (Getattr(p, "tmap:ignore")) { 1576 p = Getattr(p, "tmap:ignore:next"); 1577 } 1578 1579 if (Getattr(p, "tmap:directorargout") != 0) outputs++; 1580 1581 String* pname = Getattr(p, "name"); 1582 String* ptype = Getattr(p, "type"); 1583 1584 Putc(',',arglist); 1585 if ((tm = Getattr(p, "tmap:directorin")) != 0) { 1586 Replaceall(tm, "$input", pname); 1587 Replaceall(tm, "$owner", "0"); 1588 if (Len(tm) == 0) Append(tm, pname); 1589 Printv(wrap_args, tm, "\n", NIL); 1590 p = Getattr(p, "tmap:directorin:next"); 1591 continue; 1592 } else 1593 if (Cmp(ptype, "void")) { 1594 /* special handling for pointers to other C++ director classes. 1595 * ideally this would be left to a typemap, but there is currently no 1596 * way to selectively apply the dynamic_cast<> to classes that have 1597 * directors. in other words, the type "SwigDirector_$1_lname" only exists 1598 * for classes with directors. we avoid the problem here by checking 1599 * module.wrap::directormap, but it's not clear how to get a typemap to 1600 * do something similar. perhaps a new default typemap (in addition 1601 * to SWIGTYPE) called DIRECTORTYPE? 1602 */ 1603 if (SwigType_ispointer(ptype) || SwigType_isreference(ptype)) { 1604 Node *module = Getattr(parent, "module"); 1605 Node *target = Swig_directormap(module, ptype); 1606 sprintf(source, "obj%d", idx++); 1607 String *nonconst = 0; 1608 /* strip pointer/reference --- should move to Swig/stype.c */ 1609 String *nptype = NewString(Char(ptype)+2); 1610 /* name as pointer */ 1611 String *ppname = Copy(pname); 1612 if (SwigType_isreference(ptype)) { 1613 Insert(ppname,0,"&"); 1614 } 1615 /* if necessary, cast away const since Python doesn't support it! */ 1616 if (SwigType_isconst(nptype)) { 1617 nonconst = NewStringf("nc_tmp_%s", pname); 1618 String *nonconst_i = NewStringf("= const_cast<%s>(%s)", SwigType_lstr(ptype, 0), ppname); 1619 Wrapper_add_localv(w, nonconst, SwigType_lstr(ptype, 0), nonconst, nonconst_i, NIL); 1620 Delete(nonconst_i); 1621 Swig_warning(WARN_LANG_DISCARD_CONST, input_file, line_number, 1622 "Target language argument '%s' discards const in director method %s::%s.\n", SwigType_str(ptype, pname), classname, name); 1623 } else { 1624 nonconst = Copy(ppname); 1625 } 1626 Delete(nptype); 1627 Delete(ppname); 1628 String *mangle = SwigType_manglestr(ptype); 1629 if (target) { 1630 String *director = NewStringf("director_%s", mangle); 1631 Wrapper_add_localv(w, director, "Swig::Director *", director, "= 0", NIL); 1632 …
Large files files are truncated, but you can click here to view the full file