From ade9d25284319d7634d0fac9010eaf964179bb71 Mon Sep 17 00:00:00 2001 From: Art Yerkes Date: Sat, 8 Mar 2003 20:14:31 +0000 Subject: [PATCH] Director: added disown. It now mutates the reference held by the object. mlheading and mliheading: Added C_director_core, which holds the state needed by the director to disown. std_string and std_vector: Added specific support for the common case of a zero-terminated char **. typemaps.i: Withdraw default argout for SWIGTYPE & git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@4481 626c5289-ae23-0410-ae9c-e8d60b6d4f22 --- Lib/ocaml/director.swg | 33 +++++++++++++++++++++++++++++++++ Lib/ocaml/mlheading.swg | 12 ++++++++++++ Lib/ocaml/mliheading.swg | 1 + Lib/ocaml/ocaml.swg | 23 +++++++++++++++++++---- Lib/ocaml/std_string.i | 32 ++++++++++++++++++++++++++++++++ Lib/ocaml/std_vector.i | 30 ++++++++++++++++++++++++++++++ Lib/ocaml/typemaps.i | 4 ++++ 7 files changed, 131 insertions(+), 4 deletions(-) diff --git a/Lib/ocaml/director.swg b/Lib/ocaml/director.swg index f01796930..ca190a25f 100644 --- a/Lib/ocaml/director.swg +++ b/Lib/ocaml/director.swg @@ -95,6 +95,9 @@ public: /* discard our reference at destruction */ virtual ~__DIRECTOR__() { + __disown(); + // Disown is safe here because we're just divorcing a reference that + // points to us. } /* return a pointer to the wrapped ocaml object */ @@ -146,6 +149,7 @@ public: assert(_self); if (!_disown) { _disown=1; + callback(*caml_named_value("caml_obj_disown"),_self); } } }; @@ -162,3 +166,32 @@ int __DIRECTOR__::_mutex_active = 0; %} +%insert(mli) %{ + val new_derived_object: + (c_obj -> c_obj) -> + (c_obj -> string -> c_obj -> c_obj) -> + c_obj -> c_obj +%} + +%insert(ml) %{ +let new_derived_object cfun x_class args = + begin + let get_object ob = + match !ob with + None -> + raise (NotObject C_void) + | Some o -> o in + let class_fun class_f ob_r = + (fun meth args -> class_f (get_object ob_r) meth args) in + let ob_ref = ref None in + let new_class = class_fun x_class ob_ref in + let obj = + cfun (match args with + C_list argl -> + (C_list ((C_obj new_class) :: argl)) + | a -> (C_list [ C_director_core + (C_obj new_class,ob_ref) ; a ])) in + ob_ref := Some obj ; + obj + end +%} diff --git a/Lib/ocaml/mlheading.swg b/Lib/ocaml/mlheading.swg index 75d573ec1..791aed716 100644 --- a/Lib/ocaml/mlheading.swg +++ b/Lib/ocaml/mlheading.swg @@ -21,6 +21,7 @@ type c_obj = | C_obj of (string -> c_obj -> c_obj) | C_string of string | C_enum of c_enum_tag + | C_director_core of c_obj * c_obj option ref exception BadArgs of string exception BadMethodName of c_obj * string * string exception NotObject of c_obj @@ -85,6 +86,17 @@ let rec get_bool x = | _ -> (try if get_int x != 0 then true else false with _ -> raise (Failure "Can't convert to bool")) + +let disown_object obj = + match obj with + C_director_core (o,r) -> r := None + | _ -> raise (Failure "Not a director core object") +let _ = Callback.register "caml_obj_disown" disown_object +let director_get_self obj = + match obj with + C_director_core (self,r) -> self + | _ -> raise (Failure "Not a director core object") +let _ = Callback.register "caml_director_get_self" director_get_self let addr_of obj = (invoke obj) "&" C_void let _ = Callback.register "caml_obj_ptr" addr_of diff --git a/Lib/ocaml/mliheading.swg b/Lib/ocaml/mliheading.swg index 1eba962e8..29066e9c7 100644 --- a/Lib/ocaml/mliheading.swg +++ b/Lib/ocaml/mliheading.swg @@ -18,6 +18,7 @@ type c_obj = | C_obj of (string -> c_obj -> c_obj) | C_string of string | C_enum of c_enum_tag + | C_director_core of c_obj * c_obj option ref exception BadArgs of string exception BadMethodName of c_obj * string * string exception NotObject of c_obj diff --git a/Lib/ocaml/ocaml.swg b/Lib/ocaml/ocaml.swg index eedfc6fe5..f455e5099 100644 --- a/Lib/ocaml/ocaml.swg +++ b/Lib/ocaml/ocaml.swg @@ -23,6 +23,7 @@ extern "C" { #define C_obj 14 #define C_string 15 #define C_enum 16 +#define C_director_core 17 /* Cast a pointer if possible; returns 1 if successful */ @@ -114,8 +115,15 @@ extern "C" { break; case C_ptr: - fprintf( stderr, "PTR(%p) ", caml_ptr_val(v,0) ); - break; + { + void *vout = 0; + caml_ptr_val_internal(v,&vout,0); + swig_type_info *ty = (swig_type_info *)Int64_val(Field(v,1)); + fprintf( stderr, "PTR(%p,%s) ", + vout, + ty ? ty->name : "(null)" ); + } + break; case C_array: { unsigned int i; @@ -130,8 +138,12 @@ extern "C" { fprintf( stderr, "OBJ(%p) ", (void *)Field(v,0) ); break; case C_string: - fprintf( stderr, "'%s' ", (char *)caml_ptr_val(v,0) ); - break; + { + void *cout; + caml_ptr_val_internal(v,&cout,0); + fprintf( stderr, "'%s' ", (char *)cout ); + } + break; } } @@ -444,6 +456,9 @@ extern "C" { SWIGSTATIC void *caml_ptr_val( value v, swig_type_info *descriptor ) { CAMLparam0(); +#ifdef TYPE_CAST_VERBOSE + caml_print_val( v ); +#endif void *out = NULL; if( !caml_ptr_val_internal( v, &out, descriptor ) ) CAMLreturn(out); diff --git a/Lib/ocaml/std_string.i b/Lib/ocaml/std_string.i index d789f5161..becdb2b29 100644 --- a/Lib/ocaml/std_string.i +++ b/Lib/ocaml/std_string.i @@ -17,8 +17,11 @@ %{ #include +#include %} +%include std_vector.i + namespace std { template class basic_string { public: @@ -113,3 +116,32 @@ namespace std { } } +%template (StringVector) std::vector; + +char **c_charptr_array( const std::vector &str_v ); + +%{ + SWIGEXT char **c_charptr_array( const std::vector &str_v ) { + char **out = new char *[str_v.size() + 1]; + out[str_v.size()] = 0; + for( int i = 0; i < str_v.size(); i++ ) { + out[i] = (char *)str_v[i].c_str(); + } + return out; + } +%} + +%insert(ml) %{ + (* Some STL convenience items *) + + let string_array_to_vector sa = + let nv = _new_StringVector C_void in + array_to_vector nv (fun x -> C_string x) sa ; nv + + let c_string_array ar = + _c_charptr_array (string_array_to_vector ar) +%} + +%insert(mli) %{ + val c_string_array: string array -> c_obj +%} diff --git a/Lib/ocaml/std_vector.i b/Lib/ocaml/std_vector.i index 42e8a5a29..72bc581a6 100644 --- a/Lib/ocaml/std_vector.i +++ b/Lib/ocaml/std_vector.i @@ -58,5 +58,35 @@ namespace std { (*self)[i] = x; } }; + %extend { + T *to_array() { + T *array = new T[self->size() + 1]; + array[self->size()] = T(); + for( int i = 0; i < self->size(); i++ ) + array[i] = (*self)[i]; + return array; + } + }; }; }; + +%insert(ml) %{ + + let array_to_vector v argcons array = + for i = 0 to (Array.length array) - 1 do + (invoke v) "set" (C_list [ C_int i ; (argcons array.(i)) ]) + done ; + v + + let vector_to_array v argcons array = + for i = 0; to (get_int ((invoke v) "size" C_void)) - 1 do + array.(i) <- argcons ((invoke v) "[]" (C_int i)) + done ; + v + +%} + +%insert(mli) %{ + val array_to_vector : c_obj -> ('a -> c_obj) -> 'a array -> c_obj + val vector_to_array : c_obj -> (c_obj -> 'a) -> 'a array -> c_obj +%} diff --git a/Lib/ocaml/typemaps.i b/Lib/ocaml/typemaps.i index a828cb09a..d7e43b2bd 100644 --- a/Lib/ocaml/typemaps.i +++ b/Lib/ocaml/typemaps.i @@ -86,6 +86,7 @@ } } +#if 0 %typemap(ocaml,argout) SWIGTYPE & { value *fromval = caml_named_value("create_$ntype_from_ptr"); if( fromval ) { @@ -99,6 +100,9 @@ caml_val_ptr ((void *) $1,$1_descriptor)); } } +#endif + +%typemap(ocaml,argout) const SWIGTYPE & { } %typemap(ocaml,in) SWIGTYPE { $1 = *(($&1_ltype) caml_ptr_val($input,$&1_descriptor)) ;