Small fix of accidental breakage during some recent editing.

git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@4698 626c5289-ae23-0410-ae9c-e8d60b6d4f22

Source/Modules/ocaml.cxx

@@ -1,4 +1,3 @@
-/* -*- c-indentation-style: gnu -*- */
 /******************************************************************************
  * Simplified Wrapper and Interface Generator  (SWIG)
  *
@@ -359,6 +358,19 @@ public:
   
     /* ------------------------------------------------------------
      * top()
+     *
+     * Recognize the %module, and capture the module name.
+     * Create the default enum cases.
+     * Set up the named outputs:
+     *
+     *  init
+     *  ml
+     *  mli
+     *  wrapper
+     *  header
+     *  runtime
+     *  directors
+     *  directors_h
      * ------------------------------------------------------------ */
 
     virtual int top(Node *n) {
@@ -534,17 +546,16 @@ public:
 	return SWIG_OK;
     }
   
-  void throw_unhandled_ocaml_type_error (SwigType *d)
+    /* Produce an error for the given type */
-  {
+    void throw_unhandled_ocaml_type_error (SwigType *d, const char *types) {
 	Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
-		 "Unable to handle type %s.\n", SwigType_str(d,0));
+		     "Unable to handle type %s (%s).\n", SwigType_str(d,0),
+		     types );
     }
 
     /* Return true iff T is a pointer type */
-
     int
-  is_a_pointer (SwigType *t)
+    is_a_pointer (SwigType *t) {
-  {
 	return SwigType_ispointer(SwigType_typedef_resolve_all(t));
     }
 
@@ -765,7 +776,7 @@ public:
 	    } else {
 		// no typemap found
 		// check if typedef and resolve
-	throw_unhandled_ocaml_type_error (pt);
+		throw_unhandled_ocaml_type_error (pt,"in");
 		p = nextSibling(p);
 	    }
 	    if (i >= numreq) {
@@ -857,7 +868,7 @@ public:
 	    Replaceall(tm,"$ntype",return_type_normalized);
 	    Printv(f->code, tm, "\n",NIL);
 	} else {
-      throw_unhandled_ocaml_type_error (d);
+	    throw_unhandled_ocaml_type_error (d, "out");
 	}
     
 	// Dump the argument output code
@@ -974,14 +985,17 @@ public:
      * This creates a single function _wrap_swig_var_varname().
      * This function takes a single optional argument.   If supplied, it means
      * we are setting this variable to some value.  If omitted, it means we are
-   * simply evaluating this variable.  Either way, we return the variables
+     * simply evaluating this variable.  In the set case we return C_void.
-   * value.
+     *
+     * symname is the name of the variable with respect to C.  This 
+     * may need to differ from the original name in the case of enums.
+     * enumvname is the name of the variable with respect to ocaml.  This
+     * will vary if the variable has been renamed.
      * ------------------------------------------------------------ */
 
     virtual int variableWrapper(Node *n)  {
-	
+	char *name  = GetChar(n,"feature:symname");
-    char *name  = GetChar(n,"name");
+	String *iname = Getattr(n,"feature:enumvname");
-    String *iname = Getattr(n,"sym:name");
 	String *mname = mangleNameForCaml(iname);
 	SwigType *t = Getattr(n,"type");
 	
@@ -993,6 +1007,15 @@ public:
 	String *arg = NewString("SWIG_Field(args,0)");
 	Wrapper *f;
 
+	if( !name ) {
+	    name = GetChar(n,"name");
+	}
+
+	if( !iname ) {
+	    iname = Getattr(n,"sym:name");
+	    mname = mangleNameForCaml(NewString(iname));
+	}
+
 	if (!iname || !addSymbol(iname,n)) return SWIG_ERROR;
 	
 	f = NewWrapper();
@@ -1019,8 +1042,13 @@ public:
 		    Replaceall(tm,"$target",name);
 		    Replaceall(tm,"$input","args");
 		    Printv(f->code, tm, "\n",NIL);
+		} else if ((tm = Swig_typemap_lookup_new("in",n,name,0))) {
+		    Replaceall(tm,"$source","args");
+		    Replaceall(tm,"$target",name);
+		    Replaceall(tm,"$input","args");
+		    Printv(f->code, tm, "\n",NIL);
 		} else {
-	  throw_unhandled_ocaml_type_error (t);
+		    throw_unhandled_ocaml_type_error (t, "varin/in");
 		}
 		Printf (f->code, "}\n");
 	    }
@@ -1033,8 +1061,14 @@ public:
 		Replaceall(tm,"$target","swig_result");
 		Replaceall(tm,"$result","swig_result");
 		Printf (f->code, "%s\n", tm);
+	    } else if ((tm   = Swig_typemap_lookup_new("out",n,name,0))) {
+		Replaceall(tm,"$source",name);
+		Replaceall(tm,"$target","swig_result");
+		Replaceall(tm,"$result","swig_result");
+		Printf (f->code, "%s\n", tm);
+		
 	    } else {
-	throw_unhandled_ocaml_type_error (t);
+		throw_unhandled_ocaml_type_error (t, "varout/out");
 	    }
 	    
 	    Printf (f->code, "\nreturn swig_result;\n");
@@ -1047,7 +1081,7 @@ public:
 	    
 	    if( Getattr( n, "feature:immutable" ) ) {
 		Printf( f_mlbody, 
-		"external __%s : c_obj -> c_obj = \"%s\" ;;\n"
+			"external __%s : c_obj -> c_obj = \"%s\" \n"
 			"let _%s = __%s C_void\n",
 			mname, var_name, mname, mname );
 		Printf( f_mlibody, "val _%s : c_obj\n", iname );
@@ -1060,9 +1094,9 @@ public:
 			    mname, mname );
 		}
 	    } else {
-	Printf( f_mlbody, "external _%s : c_obj -> c_obj = \"%s\" ;;\n",
+		Printf( f_mlbody, "external _%s : c_obj -> c_obj = \"%s\"\n",
 			mname, var_name );
-	Printf( f_mlibody, "external _%s : c_obj -> c_obj = \"%s\" ;;\n",
+		Printf( f_mlibody, "external _%s : c_obj -> c_obj = \"%s\"\n",
 			mname, var_name );
 	    }
 	} else {
@@ -1093,34 +1127,30 @@ public:
 
     /* ------------------------------------------------------------
      * constantWrapper()
+     *
+     * The one trick here is that we have to make sure we rename the
+     * constant to something useful that doesn't collide with the
+     * original if any exists.
      * ------------------------------------------------------------ */
 
     virtual int constantWrapper(Node *n) {
-    char *name      = GetChar(n,"name");
+	String *name    = Getattr(n,"feature:symname");
-    char *iname     = GetChar(n,"sym:name");
+	String *iname   = Getattr(n,"sym:name");
 	SwigType *type  = Getattr(n,"type");
 	String   *value = Getattr(n,"value");
-    
-    String *var_name = NewString("");
-    String *proc_name = NewString("");
 	String   *rvalue = NewString("");
-    String *temp = NewString("");
+	String   *temp = 0;
 	String  *tm;
+	int     have_tm = 0;
 	
-    // Make a static variable;
+	if( !name ) {
-
+	    name = mangleNameForCaml(Getattr(n,"name"));
-    Printf (var_name, "_wrap_const_%s", Swig_name_mangle(iname));
+	    Insert(name,0,"_swig_wrap_");
-    
+	    Setattr(n,"feature:symname",name);
-    // Build the name for scheme.
-    Printv(proc_name, iname,NIL);
-    //Replaceall(proc_name, "_", "-");
-    
-    if ((SwigType_type(type) == T_USER) && (!is_a_pointer(type))) {
-      Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number,
-		   "Unsupported constant value.\n");
-      return SWIG_NOWRAP;
 	}
 
+	String *wname = Swig_name_wrapper(iname);
+	
 	// See if there's a typemap
 	
 	Printv(rvalue, value,NIL);
@@ -1128,22 +1158,18 @@ public:
 	    temp = Copy(rvalue);
 	    Clear(rvalue);
 	    Printv(rvalue, "\"", temp, "\"",NIL);
+	    Delete(temp);
 	}
 	if ((SwigType_type(type) == T_CHAR) && (is_a_pointer(type) == 0)) {
-      Delete(temp);
 	    temp = Copy(rvalue);
 	    Clear(rvalue);
 	    Printv(rvalue, "'", temp, "'",NIL);
+	    Delete(temp);
 	}
-    if ((tm = Swig_typemap_lookup_new("constant",n,name,0))) {
+
-      Replaceall(tm,"$source",rvalue);
-      Replaceall(tm,"$value",rvalue);
-      Replaceall(tm,"$target",name);
-      Printf (f_init, "%s\n", tm);
-    } else {
 	// Create variable and assign it a value
 	
-      Printf (f_header, "static %s = ", SwigType_lstr(type,var_name));
+	Printf (f_header, "static %s = ", SwigType_lstr(type,name));
 	if ((SwigType_type(type) == T_STRING)) {
 	    Printf (f_header, "\"%s\";\n", value);
 	} else if (SwigType_type(type) == T_CHAR) {
@@ -1152,20 +1178,8 @@ public:
 	    Printf (f_header, "%s;\n", value);
 	}
 
-      {
-	/* Hack alert: will cleanup later -- Dave */
-	Node *n = NewHash();
-	Setattr(n,"name",var_name);
-	Setattr(n,"sym:name",iname);
-	Setattr(n,"type", type);
 	Setattr(n,"feature:immutable","1");
 	variableWrapper(n);
-	Delete(n);
-      }
-    }
-    Delete(proc_name);
-    Delete(rvalue);
-    Delete(temp);
 	return SWIG_OK;
     }
 	
@@ -1179,6 +1193,10 @@ public:
 	return ret;
     }
 
+    /* destructorHandler:
+     * Turn on destructor flag to inform decisions in functionWrapper
+     */
+
     int destructorHandler(Node *n) {
 	int ret;
 
@@ -1189,6 +1207,10 @@ public:
 	return ret;
     }
 
+    /* copyconstructorHandler:
+     * Turn on constructor and copyconstructor flags for functionWrapper
+     */
+
     int copyconstructorHandler(Node *n) {
 	int ret;
 
@@ -1201,6 +1223,75 @@ public:
 	return ret;
     }
 
+    /* classHandler
+     * 
+     * Create a "class" definition for ocaml.  I thought quite a bit about
+     * how I should do this part of it, and arrived here, using a function
+     * invocation to select a method, and dispatch.  This can obviously be
+     * done better, but I can't see how, given that I want to support 
+     * overloaded methods, out parameters, and operators.
+     *
+     * I needed a system that would do this:
+     *
+     *  a Be able to call these methods:
+     *   int foo( int x );
+     *   float foo( int x, int &out );
+     *
+     *  b Be typeable, even in the presence of mutually dependent classes.
+     *
+     *  c Support some form of operator invocation.
+     *
+     * (c) I chose strings for the method names so that "+=" would be a
+     * valid method name, and the somewhat natural << (invoke x) "+=" y >>
+     * would work.
+     *
+     * (a) (b) Since the c_obj type exists, it's easy to return C_int in one
+     * case and C_list [ C_float ; C_int ] in the other.  This makes tricky
+     * problems with out parameters disappear; they're simply appended to the
+     * return list.
+     *
+     * (b) Since every item that comes from C++ is the same type, there is no
+     * problem with the following:
+     *
+     * class Foo;
+     * class Bar { Foo *toFoo(); }
+     * class Foo { Bar *toBar(); }
+     *
+     * Since the Objective caml types of Foo and Bar are the same.  Now that
+     * I correctly incorporate SWIG's typechecking, this isn't a big deal.
+     *
+     * The class is in the form of a function returning a c_obj.  The c_obj
+     * is a C_obj containing a function which invokes a method on the
+     * underlying object given its type.
+     *
+     * The name emitted here is normalized before being sent to
+     * Callback.register, because we need this string to look up properly
+     * when the typemap passes the descriptor string.  I've been considering
+     * some, possibly more forgiving method that would do some transformations
+     * on the $descriptor in order to find a potential match.  This is for
+     * later.
+     *
+     * Important things to note:
+     *
+     * We rely on exception handling (BadMethodName) in order to call an
+     * ancestor.  This can be improved.
+     *
+     * The method used to get :classof could be improved to look at the type
+     * info that the base pointer contains.  It's really an error to have a
+     * SWIG-generated object that does not contain type info, since the
+     * existence of the object means that SWIG knows the type.
+     *
+     * :parents could use :classof to tell what class it is and make a better
+     * decision.  This could be nice, (i.e. provide a run-time graph of C++
+     * classes represented);.
+     *
+     * I can't think of a more elegant way of converting a C_obj fun to a
+     * pointer than "operator &"... 
+     *
+     * Overall, carrying the list of methods and base classes has worked well.
+     * It allows me to give the Ocaml user introspection over their objects.
+     */
+
     int classHandler( Node *n ) {
 	String *name = Getattr(n,"name");
 	String *mangled_sym_name = mangleNameForCaml(name);
@@ -1219,6 +1310,8 @@ public:
 		"val create_%s_from_ptr : c_obj -> c_obj\n",
 		classname );
 
+	// Actually write out the class definition
+
 	classmode = 1;
 	int rv = Language::classHandler(n);
 	classmode = 0;
@@ -1334,6 +1427,14 @@ public:
 	return name_normalized;
     }
 
+    /*
+     * Produce the symbol name that ocaml will use when referring to the 
+     * target item.  I wonder if there's a better way to do this:
+     *
+     * I shudder to think about doing it with a hash lookup, but that would
+     * make a couple of things easier:
+     */
+
     String *mangleNameForCaml( String *s ) {
 	String *out = Copy(s);
 	Replaceall(out," ","_");
@@ -1366,11 +1467,17 @@ public:
 	String *name = Getattr(n,"name");
 
 	if( const_enum && name && !Getattr(seen_enumvalues,name) ) {
-      Printf( f_enumtypes_value,"| `%s\n", name );
 	    Setattr(seen_enumvalues,name,"true");
 	    Setattr(n,"feature:immutable","1");
+	    Setattr(n,"feature:enumvalue","1");
+	    String *evname = NewString( name );
+	    Insert( evname, 0, "SWIG_ENUM_" );
+	    Setattr(n,"feature:enumvname",name);
+	    Setattr(n,"feature:symname",evname);
+	    Delete( evname );
+	    Printf( f_enumtypes_value, "| `%s\n", name );
 
-      return constantWrapper(n);
+	    return Language::enumvalueDeclaration(n);
 	} else return SWIG_OK;
     }
 
@@ -1514,18 +1621,10 @@ public:
       
 	    Putc(',',arglist);
 	    if ((tm = Getattr(p, "tmap:inv")) != 0) {
-	String* parse = Getattr(p, "tmap:inv:parse");
-	if (!parse) {
-	  Replaceall(tm, "$input", source);
-	  Replaceall(tm, "$owner", "0");
-	  Printv(wrap_args, tm, "\n", NIL);
-	  Printv(arglist, source, NIL);
-	} else {
 		Replaceall(tm, "$input", pname);
 		Replaceall(tm, "$owner", "0");
 		if (Len(tm) == 0) Append(tm, pname);
-	  Printf(arglist, "%s", tm);
+		Printv(wrap_args, tm, "\n", NIL);
-	}
 		p = Getattr(p, "tmap:inv:next");
 		continue;
 	    } else
@@ -1761,7 +1860,9 @@ public:
 	set_nextSibling(p, parms_in_declaration);
 	parms_in_declaration = p;
 
-    for (ip = parms_in_declaration; nextSibling(ip); ) ip = nextSibling(ip);
+	for (ip = parms_in_declaration; nextSibling(ip); ) 
+	    ip = nextSibling(ip);
+
 	p = NewParm(NewString("int"), NewString("__disown"));
 	Setattr(p, "CAML_VALUE", "1");
 	set_nextSibling(ip, p);
@@ -1833,9 +1934,6 @@ public:
 	Printf( f_directors_h, "};\n\n" );
 	return Language::classDirectorEnd( n );
     }
-
-  
-  
 };
 
 /* -------------------------------------------------------------------------