Added to typemaps: reference type in/out

Strings <=> std::string by value
std::wstring accessible from Ocaml.  The string example converts a multibyte
japanese EUC sequence to a single wchar_t sequence if you have the ja_JP.EUC-JP
locale, or similar.
Better handling of reference in types
Corrected problems with & * mismatch in type verifier.
Type verifier now really functional.  No more type errors in places they
wouldn't be allowed in C++, unless you work at it.
Added argout_ref example for argout_ref.
Init code now effective (called from let _ = f_<module>_init ())


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

Doc/Manual/Ocaml.html

@@ -25,11 +25,12 @@
 <li><a href="#n12">Enums</a>
 <li><a href="#n13">C++ Classes</a>
 <ul>
-<li><a href="#n14">C++ Class Example</a>
+<li><a href="#n14">STL vector and string Example</a>
-<li><a href="#n15">Compiling the example</a>
+<li><a href="#n15">C++ Class Example</a>
-<li><a href="#n16">Sample Session</a>
+<li><a href="#n16">Compiling the example</a>
+<li><a href="#n17">Sample Session</a>
 </ul>
-<li><a href="#n17">Exceptions</a>
+<li><a href="#n18">Exceptions</a>
 </ul>
 </ul>
 <!-- INDEX -->
@@ -428,7 +429,70 @@ Note that this string belongs to the wrapper object, and not
 the underlying pointer, so using create_[x]_from_ptr alters the
 returned value for the same object.
 <p>
-<a name="n14"></a><H4>16.2.3.1 C++ Class Example</H4>
+<a name="n14"></a><H4>16.2.3.1 STL vector and string Example</H4>
+
+
+Standard typemaps are now provided for STL vector and string.  More are in
+the works.  STL strings are passed just like normal strings, and returned
+as strings.  STL string references don't mutate the original string, (which
+might be surprising), because Ocaml strings are mutable but have fixed
+length.  Instead, use multiple returns, as in the argout_ref example.
+
+<table border="1" bgcolor="#dddddd"><tr><th><center>example.i</center></th></tr>
+<tr><td><pre>
+%module example
+%{
+#include "example.h"
+%}
+
+%include stl.i
+
+namespace std {
+        %template(StringVector) std::vector<string>;
+};
+
+%include example.h
+</pre></td></tr>
+<tr><td><font size="-1"><i>This example is in Examples/ocaml/stl
+</i></font></td></tr>
+</table><p>
+
+Since there's a makefile in that directory, the example is easy to build.<p>
+Here's a sample transcript of an interactive session using a string vector
+after making a toplevel like this:
+<pre>ocamlmktop -custom -cclib -g -ccopt -g -g \
+   example_wrap.o example.cmo -o example_top -cclib -lstdc++
+</pre><p>
+<blockquote><pre>
+bash-2.05a$ ./example_top 
+        Objective Caml version 3.06
+
+# open Example ;;
+# let x = new_StringVector C_void ;;
+val x : Example.c_obj = C_obj <fun>
+# (invoke x) ":methods" C_void ;;
+- : Example.c_obj =
+C_list
+ [C_string "nop"; C_string "size"; C_string "empty"; C_string "clear";
+  C_string "push_back"; C_string "[]"; C_string "="; C_string "set";
+  C_string "~"; C_string "&"; C_string ":parents"; C_string ":classof";
+  C_string ":methods"]
+# (invoke x) "push_back" (C_string "foo") ;;
+- : Example.c_obj = C_void
+# (invoke x) "push_back" (C_string "bar") ;;
+- : Example.c_obj = C_void
+# (invoke x) "push_back" (C_string "baz") ;;
+- : Example.c_obj = C_void
+# (invoke x) "[]" (C_int 1) ;;
+- : Example.c_obj = C_string "bar"
+# (invoke x) "set" (C_list [ C_int 1 ; C_string "spam" ]) ;;
+- : Example.c_obj = C_void
+# (invoke x) "[]" (C_int 1) ;;
+- : Example.c_obj = C_string "spam"
+# 
+</pre></blockquote>
+
+<a name="n15"></a><H4>16.2.3.2 C++ Class Example</H4>
 
 
 Here's a simple example using Trolltech's Qt Library:
@@ -455,7 +519,7 @@ public:
 };
 </pre></td></tr></table><p>
 
-<a name="n15"></a><H4>16.2.3.2 Compiling the example</H4>
+<a name="n16"></a><H4>16.2.3.3 Compiling the example</H4>
 
 
 <blockquote><pre>
@@ -468,7 +532,7 @@ bash-2.05a$ ocamlc -c qt.ml
 bash-2.05a$ ocamlmktop -custom qt_wrap.o qt.cmo -o qt_top -cclib -L$QTPATH/lib -cclib -lqt
 </pre></blockquote>
 
-<a name="n16"></a><H4>16.2.3.3 Sample Session</H4>
+<a name="n17"></a><H4>16.2.3.4 Sample Session</H4>
 
 
 <blockquote><pre>
@@ -512,7 +576,7 @@ val hello : Qt.c_obj = C_obj <fun>
 In either case, assuming you have a working installation of QT, you will
 see a window containing the string "hi" in a button.  
 
-<a name="n17"></a><H3>16.2.4 Exceptions</H3>
+<a name="n18"></a><H3>16.2.4 Exceptions</H3>
 
 
 Catching exceptions is now supported using SWIG's %exception feature.  A simple

Examples/ocaml/check.list

@@ -3,3 +3,4 @@ simple
 std_string
 std_vector
 stl
+argout_ref

Examples/ocaml/std_string/runme.ml

@@ -2,13 +2,13 @@
 
 open Example
 
-let y = new_string (C_string "\205\177")
+let y = "\205\177"
-let z = _to_wstring_with_locale (C_list [ y ; new_string (C_string Sys.argv.(1)) ])
+let z = _to_wstring_with_locale (C_list [ C_string y ; C_string Sys.argv.(1) ])
 
 let _ = 
   begin
     print_string "the original string contains " ;
-    print_int (get_int ((invoke y) "size" C_void)) ;
+    print_int (String.length y) ;
     print_newline () ;
     
     print_string "the new string contains " ;

Lib/ocaml/ocaml.i

@@ -13,6 +13,9 @@
 /* Include headers */
 %insert(runtime) "ocamldec.swg"
 
+/* Type registration */
+%insert(init) "typeregister.swg"
+
 /*#ifndef SWIG_NOINCLUDE*/
 %insert(runtime) "ocaml.swg"
 /*#endif*/

Lib/ocaml/ocaml.swg

@@ -30,6 +30,11 @@ extern "C" {
     SWIG_Cast (void *source, swig_type_info *source_type,
 	       void **ptr, swig_type_info *dest_type)
     {
+#ifdef TYPE_CAST_VERBOSE
+	fprintf( stderr, "Trying to cast %s to %s\n", 
+		 source_type ? source_type->str : "<none>",
+		 dest_type ? dest_type->str : "<none>" );
+#endif
 	if (dest_type != source_type) {
 	    /* We have a type mismatch.  Will have to look through our type
 	       mapping table to figure out whether or not we can accept this
@@ -40,6 +45,10 @@ extern "C" {
 	    } else {
 		swig_type_info *tc = 
 		    SWIG_TypeCheck( (char *)source_type->name, dest_type );
+#ifdef TYPE_CAST_VERBOSE
+		fprintf( stderr, "Typecheck -> %s\n",
+			 tc ? tc->str : "<none>" );
+#endif
 		if( tc ) {
 		    *ptr = SWIG_TypeCast( tc, source );
 		    return 0;
@@ -56,10 +65,9 @@ extern "C" {
     SWIGSTATIC int
     SWIG_GetPtr(void *inptr, void **outptr, 
 		swig_type_info *intype, swig_type_info *outtype) {
-	CAMLparam0();
 	if (intype) {
-	    return !SWIG_Cast(inptr, intype,
+	    return SWIG_Cast(inptr, intype,
-			      outptr, outtype);
+			     outptr, outtype) == -1;
 	} else {
 	    *outptr = inptr;
 	    return 0;
@@ -295,7 +303,7 @@ extern "C" {
 	CAMLreturn(vv);
     }
 
-    SWIGSTATIC value caml_val_string( char *p ) {
+    SWIGSTATIC value caml_val_string( const char *p ) {
 	CAMLparam0();
 	CAMLlocal1(vv);
 	if( !p ) CAMLreturn(caml_val_ptr( (void *)p, 0 ));
@@ -304,7 +312,7 @@ extern "C" {
 	CAMLreturn(vv);
     }
 
-    SWIGSTATIC value caml_val_string_len( char *p, int len ) {
+    SWIGSTATIC value caml_val_string_len( const char *p, int len ) {
 	CAMLparam0();
 	CAMLlocal1(vv);
 	if( !p || len < 0 ) CAMLreturn(caml_val_ptr( (void *)p, 0 ));
@@ -387,7 +395,7 @@ extern "C" {
     }
 
     SWIGSTATIC int caml_ptr_val_internal( value v, void **out, 
-				      swig_type_info *descriptor ) {
+					  swig_type_info *descriptor ) {
 	CAMLparam1(v);
 	void *outptr = NULL;
         swig_type_info *outdescr = NULL;

Lib/ocaml/ocamldec.swg

@@ -33,6 +33,9 @@ extern "C" {
 
 #define __OCAML__SWIG__MAXVALUES 6
 
+    static swig_type_info *swig_types[];
+    static swig_type_info *swig_types_initial[];
+
     SWIGSTATIC int
     SWIG_GetPtr(void *source, void **result, swig_type_info *type, swig_type_info *result_type);
     
@@ -65,8 +68,8 @@ extern "C" {
 
     static value caml_val_ptr( void *p, swig_type_info *descriptor );
 
-    static value caml_val_string( char *str );
+    static value caml_val_string( const char *str );
-    static value caml_val_string_len( char *str, int len );
+    static value caml_val_string_len( const char *str, int len );
 
     static long caml_long_val( value v );
     static double caml_double_val( value v );

Lib/ocaml/std_string.i

@@ -70,9 +70,10 @@ namespace std {
 
     %template(string) basic_string<char>;
     %template(wstring) basic_string<wchar_t>;
+    typedef basic_string<char> string;
+    typedef basic_string<wchar_t> wstring;
 
     /* Overloading check */
-#if 0
     %typemap(in) string {
         if (caml_ptr_check($input))
             $1 = std::string((char *)caml_ptr_val($input,0));
@@ -89,16 +90,26 @@ namespace std {
         }
     }
 
+    %typemap(in) string & (std::string temp) {
+        if (caml_ptr_check($input)) {
+            temp = std::string((char *)caml_ptr_val($input,0));
+            $1 = &temp;
+        } else {
+            SWIG_exception(SWIG_TypeError, "string expected");
+        }
+    }
+
+    %typemap(argout) string & {
+	caml_list_append(swig_result,caml_val_string_len($1->c_str(),
+							 $1->size()));
+    }
+
     %typemap(out) string {
-        $result = caml_val_ptr((char *)$1.c_str(),0);
+        $result = caml_val_string_len($1.c_str(),$1.size());
     }
 
     %typemap(out) const string & {
-        $result = caml_val_ptr((char *)$1->c_str(),0);
+        $result = caml_val_string_len($1.c_str(),$1.size());
     }
-#endif
-
-    typedef basic_string<char> string;
-    typedef basic_string<wchar_t> wstring;
 }
 

Lib/ocaml/std_vector.i

@@ -53,7 +53,8 @@ namespace std {
 	T operator [] ( int f );
 	vector <T> &operator = ( vector <T> &other );
 	%extend {
-	    void set( int i, T x ) {
+	    void set( int i, const T &x ) {
+		self->resize(i+1);
 		(*self)[i] = x;
 	    }
 	};

Lib/ocaml/typemaps.i

@@ -44,28 +44,28 @@
 }
 
 %typemap(ocaml,in) SWIGTYPE * {
-    $1 = ($ltype)caml_ptr_val($input,$descriptor);
+    $1 = ($ltype)caml_ptr_val($input,$*1_descriptor);
 }
 
 %typemap(ocaml,out) SWIGTYPE * {
     value *fromval = caml_named_value("create_$ntype_from_ptr");
     if( fromval ) {
-	$result = callback(*fromval,caml_val_ptr((void *)$1,$descriptor));
+	$result = callback(*fromval,caml_val_ptr((void *)$1,$*1_descriptor));
     } else {
-	$result = caml_val_ptr ((void *)$1,$descriptor);
+	$result = caml_val_ptr ((void *)$1,$*1_descriptor);
     }
 }
 
 %typemap(ocaml,varin) SWIGTYPE * {
-    $1 = ($ltype)caml_ptr_val($input,$descriptor);
+    $1 = ($ltype)caml_ptr_val($input,$*1_descriptor);
 }
 
 %typemap(ocaml,varout) SWIGTYPE * {
     value *fromval = caml_named_value("create_$ntype_from_ptr");
     if( fromval ) {
-	$result = callback(*fromval,caml_val_ptr((void *)$1,$descriptor));
+	$result = callback(*fromval,caml_val_ptr((void *)$1,$*1_descriptor));
     } else {
-	$result = caml_val_ptr ((void *)$1,$descriptor);
+	$result = caml_val_ptr ((void *)$1,$*1_descriptor);
     }
 }
 
@@ -74,15 +74,29 @@
 #ifdef __cplusplus
 
 %typemap(ocaml,in) SWIGTYPE & {
-    $1 = ($ltype) caml_ptr_val($input,$descriptor);
+    $1 = ($ltype) caml_ptr_val($input,$*1_descriptor);
 }
 
 %typemap(ocaml,out) SWIGTYPE & {
     value *fromval = caml_named_value("create_$ntype_from_ptr");
     if( fromval ) {
-	$result = callback(*fromval,caml_val_ptr((void *) $1,$descriptor));
+	$result = callback(*fromval,caml_val_ptr((void *) $1,$*1_descriptor));
     } else {
-	$result = caml_val_ptr ((void *) $1,$descriptor);
+	$result = caml_val_ptr ((void *) $1,$*1_descriptor);
+    }
+}
+
+%typemap(ocaml,argout) SWIGTYPE & {
+    value *fromval = caml_named_value("create_$ntype_from_ptr");
+    if( fromval ) {
+	swig_result =
+	    caml_list_append(swig_result,
+			     callback(*fromval,caml_val_ptr((void *) $1,
+							    $*1_descriptor)));
+    } else {
+	swig_result =
+	    caml_list_append(swig_result,
+			     caml_val_ptr ((void *) $1,$*1_descriptor));
     }
 }
 
@@ -118,6 +132,8 @@
     }
 }
 
+%apply SWIGTYPE { const SWIGTYPE & };
+
 #endif
 
 /* Arrays */
@@ -158,7 +174,14 @@
     $1 = &temp;
 }
 %typemap(argout) C_NAME *OUTPUT {
-    caml_list_append(swig_result,(long)*$1);
+    swig_result = caml_list_append(swig_result,C_TO_MZ((long)*$1));
+}
+%typemap(in) C_NAME & (C_NAME temp) {
+    temp = (C_NAME) MZ_TO_C($input);
+    $1 = &temp;
+}
+%typemap(argout) C_NAME & {
+    swig_result = caml_list_append(swig_result,C_TO_MZ((long)*$1));
 }
 %enddef
 

Source/Modules/ocaml.cxx

@@ -205,18 +205,18 @@ public:
 
     Printv(mlfile,module,".ml",NIL);
     Printv(mlifile,module,".mli",NIL);
-
+    
-	String *mlfilen = NewStringf("%s%s", Swig_file_dirname(outfile),mlfile);
+    String *mlfilen = NewStringf("%s%s", Swig_file_dirname(outfile),mlfile);
-	if ((f_mlout = NewFile(mlfilen,"w")) == 0) {
+    if ((f_mlout = NewFile(mlfilen,"w")) == 0) {
-		Printf(stderr,"Unable to open %s\n", mlfilen);
+      Printf(stderr,"Unable to open %s\n", mlfilen);
-		SWIG_exit (EXIT_FAILURE);
+      SWIG_exit (EXIT_FAILURE);
-	}
+    }
-	String *mlifilen = NewStringf("%s%s", Swig_file_dirname(outfile),mlifile);
+    String *mlifilen = NewStringf("%s%s", Swig_file_dirname(outfile),mlifile);
-	if ((f_mliout = NewFile(mlifilen,"w")) == 0) {
+    if ((f_mliout = NewFile(mlifilen,"w")) == 0) {
-		Printf(stderr,"Unable to open %s\n", mlifilen);
+      Printf(stderr,"Unable to open %s\n", mlifilen);
-		SWIG_exit (EXIT_FAILURE);
+      SWIG_exit (EXIT_FAILURE);
-	}
+    }
-
+    
     Language::top(n);
 
     Printf( f_enum_to_int, 
@@ -231,6 +231,18 @@ public:
 	    module );
     Printf( f_mlibody,
 	    "val int_to_enum : c_enum_type -> int -> c_obj\n" );
+    Printf( f_wrappers,
+	    "#ifdef __cplusplus\n"
+	    "extern \"C\"\n"
+	    "#endif\n"
+	    "void f_%s_init() {\n"
+	    "%s"
+	    "}\n",
+	    module, init_func_def );
+    Printf( f_mlbody,
+	    "external f_init : unit -> unit = \"f_%s_init\"\n"
+	    "let _ = f_init ()\n",
+	    module, module );
     Printf( f_enumtypes_type, "]\n" );
     Printf( f_enumtypes_value, "]\n" );
 
@@ -266,11 +278,6 @@ public:
     return SWIG_OK;
   }
   
-  /* ------------------------------------------------------------
-   * functionWrapper()
-   * Create a function declaration and register it with the interpreter.
-   * ------------------------------------------------------------ */
-
   void throw_unhandled_ocaml_type_error (SwigType *d)
   {
     Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
@@ -285,6 +292,10 @@ public:
     return SwigType_ispointer(SwigType_typedef_resolve_all(t));
   }
 
+  /*
+   * Delete one reference from a given type.
+   */
+
   void oc_SwigType_del_reference(SwigType *t) {
   char *c = Char(t);
   if (strncmp(c,"q(",2) == 0) {
@@ -298,12 +309,21 @@ public:
   Replace(t,"r.","", DOH_REPLACE_ANY | DOH_REPLACE_FIRST);
   }
 
+  /* 
+   * Return true iff T is a reference type 
+   */
+
   int
   is_a_reference (SwigType *t)
   {
     return SwigType_isreference(SwigType_typedef_resolve_all(t));
   }
 
+  /* ------------------------------------------------------------
+   * functionWrapper()
+   * Create a function declaration and register it with the interpreter.
+   * ------------------------------------------------------------ */
+
   virtual int functionWrapper(Node *n) {
     char *iname = GetChar(n,"sym:name");
     SwigType *d = Getattr(n,"type");
@@ -673,14 +693,12 @@ public:
     if (!iname || !addSymbol(iname,n)) return SWIG_ERROR;
 	
     f = NewWrapper();
-	
+
     // evaluation function names
-	
     strcpy(var_name, Char(Swig_name_wrapper(iname)));
 	
     // Build the name for scheme.
-    Printv(proc_name, iname,NIL);
+    Printv(proc_name, iname, NIL);
-    //Replaceall(proc_name, "_", "-");
 	
     if ((SwigType_type(t) != T_USER) || (is_a_pointer(t))) {