+%module example
+%{
+#include "example.h"
+%}
+
+%include stl.i
+
+namespace std {
+ %template(StringVector) std::vector |
| This example is in Examples/ocaml/stl + |
+ +Since there's a makefile in that directory, the example is easy to build.
+Here's a sample transcript of an interactive session using a string vector +after making a toplevel like this: +
ocamlmktop -custom -cclib -g -ccopt -g -g \ + example_wrap.o example.cmo -o example_top -cclib -lstdc++ +
+
+ ++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+# (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" +# +
-@@ -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
@@ -512,7 +576,7 @@ val hello : Qt.c_obj = C_objIn either case, assuming you have a working installation of QT, you will see a window containing the string "hi" in a button. - 16.2.4 Exceptions
+16.2.4 Exceptions
Catching exceptions is now supported using SWIG's %exception feature. A simple diff --git a/Examples/ocaml/check.list b/Examples/ocaml/check.list index 3786c26b2..47c82ad3a 100644 --- a/Examples/ocaml/check.list +++ b/Examples/ocaml/check.list @@ -3,3 +3,4 @@ simple std_string std_vector stl +argout_ref diff --git a/Examples/ocaml/std_string/runme.ml b/Examples/ocaml/std_string/runme.ml index 110e01bc6..d6a933a1c 100644 --- a/Examples/ocaml/std_string/runme.ml +++ b/Examples/ocaml/std_string/runme.ml @@ -2,13 +2,13 @@ open Example -let y = new_string (C_string "\205\177") -let z = _to_wstring_with_locale (C_list [ y ; new_string (C_string Sys.argv.(1)) ]) +let y = "\205\177" +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 " ; diff --git a/Lib/ocaml/ocaml.i b/Lib/ocaml/ocaml.i index d081e8d15..8e72c73e1 100644 --- a/Lib/ocaml/ocaml.i +++ b/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*/ diff --git a/Lib/ocaml/ocaml.swg b/Lib/ocaml/ocaml.swg index 396539a99..58743b0c1 100644 --- a/Lib/ocaml/ocaml.swg +++ b/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 : "", + dest_type ? dest_type->str : " " ); +#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 : " " ); +#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, - outptr, outtype); + return SWIG_Cast(inptr, intype, + 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; diff --git a/Lib/ocaml/ocamldec.swg b/Lib/ocaml/ocamldec.swg index 038c6773f..d06b32864 100644 --- a/Lib/ocaml/ocamldec.swg +++ b/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_len( char *str, int len ); + static value caml_val_string( const char *str ); + 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 ); diff --git a/Lib/ocaml/std_string.i b/Lib/ocaml/std_string.i index 5b32bba56..d789f5161 100644 --- a/Lib/ocaml/std_string.i +++ b/Lib/ocaml/std_string.i @@ -70,9 +70,10 @@ namespace std { %template(string) basic_string ; %template(wstring) basic_string ; + typedef basic_string string; + typedef basic_string 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 string; - typedef basic_string wstring; } diff --git a/Lib/ocaml/std_vector.i b/Lib/ocaml/std_vector.i index 1d244dff4..42e8a5a29 100644 --- a/Lib/ocaml/std_vector.i +++ b/Lib/ocaml/std_vector.i @@ -53,7 +53,8 @@ namespace std { T operator [] ( int f ); vector &operator = ( vector &other ); %extend { - void set( int i, T x ) { + void set( int i, const T &x ) { + self->resize(i+1); (*self)[i] = x; } }; diff --git a/Lib/ocaml/typemaps.i b/Lib/ocaml/typemaps.i index 88eaa139d..f63f16568 100644 --- a/Lib/ocaml/typemaps.i +++ b/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 diff --git a/Source/Modules/ocaml.cxx b/Source/Modules/ocaml.cxx index 24893b4a0..905e8bba7 100755 --- a/Source/Modules/ocaml.cxx +++ b/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); - if ((f_mlout = NewFile(mlfilen,"w")) == 0) { - Printf(stderr,"Unable to open %s\n", mlfilen); - SWIG_exit (EXIT_FAILURE); - } - String *mlifilen = NewStringf("%s%s", Swig_file_dirname(outfile),mlifile); - if ((f_mliout = NewFile(mlifilen,"w")) == 0) { - Printf(stderr,"Unable to open %s\n", mlifilen); - SWIG_exit (EXIT_FAILURE); - } - + + String *mlfilen = NewStringf("%s%s", Swig_file_dirname(outfile),mlfile); + if ((f_mlout = NewFile(mlfilen,"w")) == 0) { + Printf(stderr,"Unable to open %s\n", mlfilen); + SWIG_exit (EXIT_FAILURE); + } + String *mlifilen = NewStringf("%s%s", Swig_file_dirname(outfile),mlifile); + if ((f_mliout = NewFile(mlifilen,"w")) == 0) { + Printf(stderr,"Unable to open %s\n", mlifilen); + 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); - //Replaceall(proc_name, "_", "-"); + Printv(proc_name, iname, NIL); if ((SwigType_type(t) != T_USER) || (is_a_pointer(t))) {