PageRenderTime 192ms CodeModel.GetById 58ms app.highlight 84ms RepoModel.GetById 0ms app.codeStats 0ms

/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