jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

shapes example: slight correction to depth map.

Browse source 
makedebugtop: include swig.cmo
Lib: factored out more common code, slightly reorganized class type.
     added director define and exceptions.
     std_string: length from the original ocaml string (no longer depends on
      null termination)
     ocamldec.swg/ocaml.swg: added caml_string_len
Examples/Makefile.in: quiet about checking out files.
Ocaml.cxx:
     Fixed abstract director test case.
     Include/exclude director.swg based on directors being enabled.
Final edits for 1.3.20, barring bugs being discovered.


git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@5477 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Art Yerkes 2003-12-04 06:15:07 +00:00
commit e0dca0ec65
15 changed files with 261 additions and 214 deletions
Download patch file Download diff file Expand all files Collapse all files

39
Lib/ocaml/class.swg
View file

@ -1,24 +1,7 @@
(*Stream:class_ctors*)
let create_$classname_from_ptr raw_ptr =
C_obj
(let rec method_table = [
"nop", (fun args -> C_void) ;
$classbody
"&", (fun args -> raw_ptr) ;
":parents",
(fun args ->
C_list
(List.map
(fun (x,y) ->
C_string (String.sub x 2 ((String.length x) - 2)))
(List.filter
(fun (x,y) ->
((String.length x) > 2)
&& x.[0] == ':' && x.[1] == ':') method_table))) ;
":classof", (fun args -> C_string "$realname") ;
":methods", (fun args -> C_list (List.map (fun (x,y) -> C_string x)
method_table)) ] in
(fun mth arg ->
(let rec invoke_inner raw_ptr mth arg =
try
let method_name,application =
List.hd
@ -47,7 +30,25 @@ let create_$classname_from_ptr raw_ptr =
| [] ->
raise (BadMethodName (raw_ptr,mth,"$realname"))
in try_parent parent_classes raw_ptr
end))
end
and method_table = [
"nop", (fun args -> C_void) ;
$classbody
"&", (fun args -> raw_ptr) ;
":parents",
(fun args ->
C_list
(List.map
(fun (x,y) ->
C_string (String.sub x 2 ((String.length x) - 2)))
(List.filter
(fun (x,y) ->
((String.length x) > 2)
&& x.[0] == ':' && x.[1] == ':') method_table))) ;
":classof", (fun args -> C_string "$realname") ;
":methods", (fun args -> C_list (List.map (fun (x,y) -> C_string x)
method_table)) ] in
(fun mth arg -> invoke_inner raw_ptr mth arg))
let _ = Callback.register
"create_$normalized_from_ptr"

101
Lib/ocaml/director.swg
View file

@ -9,13 +9,37 @@
* Original Author : Mark Rose (mrose@stm.lbl.gov)
************************************************************************/
%insert(runtime) %{
#ifdef __cplusplus
#include <string>
namespace Swig {
/* base class for director exceptions */
class DirectorException {
protected:
std::string swig_msg;
public:
DirectorException(const char* msg="") {
}
const char *getMessage() const {
return swig_msg.c_str();
}
virtual ~DirectorException() {}
};
/* type mismatch in the return value from a python method call */
class DirectorTypeMismatchException : public Swig::DirectorException {
public:
DirectorTypeMismatchException(const char* msg="") {
}
};
/* any python exception that occurs during a director method call */
class DirectorMethodException : public Swig::DirectorException {};
/* attempt to call a pure virtual method via a director method */
class DirectorPureVirtualException : public Swig::DirectorException {};
/* simple thread abstraction for pthreads on win32 */
#ifdef __THREAD__
#define __PTHREAD__
@ -37,8 +61,7 @@ namespace Swig {
CAML_VALUE swig_self;
/* flag indicating whether the object is owned by ocaml or c++ */
mutable bool swig_disown_flag;
/* shared flag for breaking recursive director calls */
static bool swig_up;
mutable bool swig_up;
#ifdef __PTHREAD__
/* locks for sharing the swig_up flag in a threaded environment */
@ -50,19 +73,20 @@ namespace Swig {
/* reset the swig_up flag once the routing direction has been determined */
#ifdef __PTHREAD__
void swig_clear_up() const {
Swig::Director::swig_up = false;
swig_up = false;
Swig::Director::swig_mutex_active = false;
pthread_mutex_unlock(&swig_mutex_up);
}
#else
void swig_clear_up() const {
Swig::Director::swig_up = false;
swig_up = false;
}
#endif
public:
/* wrap a ocaml object, optionally taking ownership */
Director(CAML_VALUE self, bool disown = false) : swig_self(self), swig_disown_flag(disown) {
Director(CAML_VALUE self, bool disown = false) : swig_self(self), swig_disown_flag(disown), swig_up( false ) {
register_global_root(&swig_self);
}
@ -76,27 +100,28 @@ namespace Swig {
/* return a pointer to the wrapped ocaml object */
CAML_VALUE swig_get_self() const {
return callback(*caml_named_value("caml_director_get_self"),swig_self);
return swig_self;
}
/* get the swig_up flag to determine if the method call should be routed
* to the c++ base class or through the wrapped ocaml object
*/
#ifdef __PTHREAD__
bool swig_get_up() const {
bool swig_get_up( bool clear = true ) const {
if (Swig::Director::swig_mutex_active) {
if (pthread_equal(Swig::Director::swig_mutex_thread, pthread_self())) {
bool up = swig_up;
swig_clear_up();
if( clear ) swig_clear_up();
return up;
}
}
return false;
}
#else
bool swig_get_up() const {
bool swig_get_up( bool clear = true ) const {
bool up = swig_up;
swig_up = false;
if( clear ) swig_up = false;
return up;
}
#endif
@ -109,11 +134,11 @@ namespace Swig {
pthread_mutex_lock(&Swig::Director::swig_mutex_up);
Swig::Director::swig_mutex_thread = pthread_self();
Swig::Director::swig_mutex_active = true;
Swig::Director::swig_up = true;
swig_up = true;
}
#else
void swig_set_up() const {
Swig::Director::swig_up = true;
swig_up = true;
}
#endif
@ -127,8 +152,6 @@ namespace Swig {
}
};
bool Swig::Director::swig_up = false;
#ifdef __PTHREAD__
MUTEX_INIT(Swig::Director::swig_mutex_up);
pthread_t Swig::Director::swig_mutex_thread;
@ -138,49 +161,3 @@ namespace Swig {
}
#endif /* __cplusplus */
%}
%insert(mli) %{
val new_derived_object:
(c_obj -> c_obj) ->
(c_obj -> string -> c_obj -> c_obj) ->
c_obj -> c_obj
%}
%insert(ml) %{
let invoke obj = match obj with C_obj o -> o | _ -> raise (NotObject obj)
let _ = Callback.register "swig_runmethod" invoke
let fnhelper fin f arg =
let args = match arg with C_list l -> l | C_void -> [] | _ -> [ arg ] in
match f args with
[] -> C_void
| [ x ] -> (if fin then Gc.finalise
(fun x -> ignore ((invoke x) "~" C_void)) x) ; x
| lst -> C_list lst
let addr_of obj = (invoke obj) "&" C_void
let _ = Callback.register "caml_obj_ptr" addr_of
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_director_core (C_obj new_class,ob_ref)) :: argl))
| a -> (C_list [ C_director_core
(C_obj new_class,ob_ref) ; a ])) in
ob_ref := Some obj ;
obj
end
%}

1
Lib/ocaml/ocaml.i
View file

@ -32,4 +32,3 @@
%include "typecheck.i"
%include "exception.i"
%include "preamble.swg"
%include "director.swg"

12
Lib/ocaml/ocaml.swg
View file

@ -162,6 +162,7 @@ extern "C" {
fprintf( stderr, "]\n" );
v = SWIG_Field(v,1);
}
CAMLreturn0;
}
SWIGSTATIC CAML_VALUE caml_list_nth( CAML_VALUE lst, int n ) {
@ -341,7 +342,7 @@ extern "C" {
CAMLparam0();
SWIG_CAMLlocal1(fv);
fv = caml_swig_alloc(1,C_float);
SWIG_Store_field(fv,0,copy_double(f));
SWIG_Store_field(fv,0,copy_double((double)f));
CAMLreturn(fv);
}
@ -511,6 +512,15 @@ extern "C" {
return (char *)caml_ptr_val( v, 0 );
}
SWIGSTATIC int caml_string_len( CAML_VALUE v ) {
switch( SWIG_Tag_val(v) ) {
case C_string:
return string_length(SWIG_Field(v,0));
default:
return strlen((char *)caml_ptr_val(v,0));
}
}
SWIGSTATIC int caml_bool_check( CAML_VALUE v ) {
CAMLparam1(v);

1
Lib/ocaml/ocamldec.swg
View file

@ -140,6 +140,7 @@ CAMLextern int64 Int64_val(caml_value_t v);
static void *caml_ptr_val( CAML_VALUE v, swig_type_info *descriptor );
static char *caml_string_val( CAML_VALUE v );
static int caml_string_len( CAML_VALUE v );
#ifdef __cplusplus
}

4
Lib/ocaml/preamble.swg
View file

@ -6,8 +6,7 @@ exception BadMethodName of c_obj * string * string
exception NotObject of c_obj
exception NotEnumType of c_obj
exception LabelNotFromThisEnum of c_obj
val invoke : c_obj -> (string -> c_obj -> c_obj)
exception InvalidDirectorCall of c_obj
%}
%insert(ml) %{
@ -18,4 +17,5 @@ exception BadMethodName of c_obj * string * string
exception NotObject of c_obj
exception NotEnumType of c_obj
exception LabelNotFromThisEnum of c_obj
exception InvalidDirectorCall of c_obj
%}

17
Lib/ocaml/std_string.i
View file

@ -81,14 +81,16 @@ namespace std {
/* Overloading check */
%typemap(in) string {
if (caml_ptr_check($input))
$1 = std::string((char *)caml_ptr_val($input,0));
$1 = std::string((char *)caml_ptr_val($input,0),
caml_string_len($input));
else
SWIG_exception(SWIG_TypeError, "string expected");
}
%typemap(in) const string & (std::string temp) {
if (caml_ptr_check($input)) {
temp = std::string((char *)caml_ptr_val($input,0));
temp = std::string((char *)caml_ptr_val($input,0),
caml_string_len($input));
$1 = &temp;
} else {
SWIG_exception(SWIG_TypeError, "string expected");
@ -97,7 +99,8 @@ namespace std {
%typemap(in) string & (std::string temp) {
if (caml_ptr_check($input)) {
temp = std::string((char *)caml_ptr_val($input,0));
temp = std::string((char *)caml_ptr_val($input,0),
caml_string_len($input));
$1 = &temp;
} else {
SWIG_exception(SWIG_TypeError, "string expected");
@ -106,7 +109,8 @@ namespace std {
%typemap(in) string * (std::string *temp) {
if (caml_ptr_check($input)) {
temp = new std::string((char *)caml_ptr_val($input,0));
temp = new std::string((char *)caml_ptr_val($input,0),
caml_string_len($input));
$1 = temp;
} else {
SWIG_exception(SWIG_TypeError, "string expected");
@ -122,6 +126,11 @@ namespace std {
(*$1).size()));
}
%typemap(directorout) string {
$result = std::string((char *)caml_ptr_val($input,0),
caml_string_len($input));
}
%typemap(out) string {
$result = caml_val_string_len($1.c_str(),$1.size());
}

42
Lib/ocaml/swig.ml
View file

@ -23,16 +23,22 @@ type 'a c_obj_t =
| C_enum of 'a
| C_director_core of 'a c_obj_t * 'a c_obj_t option ref
type empty_enum = [ `Int of int ]
type empty_enum = [ `SWIGFake | `Int of int ]
exception BadArgs of string
exception BadMethodName of string * string
exception NotObject of empty_enum c_obj_t
exception NotEnumType of empty_enum c_obj_t
exception LabelNotFromThisEnum of empty_enum c_obj_t
exception InvalidDirectorCall of empty_enum c_obj_t
let invoke obj = match obj with C_obj o -> o | _ -> raise (NotObject (Obj.magic obj))
let rec invoke obj =
match obj with
C_obj o -> o
| C_director_core (o,r) -> invoke o
| _ -> raise (NotObject (Obj.magic obj))
let _ = Callback.register "swig_runmethod" invoke
let fnhelper fin f arg =
let args = match arg with C_list l -> l | C_void -> [] | _ -> [ arg ] in
match f args with
@ -95,14 +101,12 @@ let disown_object obj =
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 =
let addr_of obj =
match obj with
C_obj o -> obj
| 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
C_obj _ -> (invoke obj) "&" C_void
| C_director_core (self,r) -> (invoke self) "&" C_void
| C_ptr _ -> obj
| _ -> raise (Failure "Not a pointer.")
let _ = Callback.register "caml_obj_ptr" addr_of
let convert_c_obj a = Obj.magic a
@ -122,3 +126,23 @@ let make_uint i = C_uint (Int32.of_int i)
let make_int32 i = C_int32 (Int32.of_int i)
let make_int64 i = C_int64 (Int64.of_int i)
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 ob_ref = ref None in
let class_fun class_f ob_r =
(fun meth args -> class_f (get_object ob_r) meth args) in
let new_class = class_fun x_class ob_ref in
let dircore = C_director_core (C_obj new_class,ob_ref) in
let obj =
cfun (match args with
C_list argl -> (C_list ((dircore :: argl)))
| C_void -> (C_list [ dircore ])
| a -> (C_list [ dircore ; a ])) in
ob_ref := Some obj ;
obj
end

10
Lib/ocaml/swig.mli
View file

@ -20,8 +20,13 @@ type 'a c_obj_t =
| C_enum of 'a
| C_director_core of 'a c_obj_t * 'a c_obj_t option ref
type empty_enum = [ `SWIGFake | `Int of int ]
exception InvalidDirectorCall of empty_enum c_obj_t
val invoke : 'a c_obj_t -> (string -> 'a c_obj_t -> 'a c_obj_t)
val convert_c_obj : 'a c_obj_t -> 'b c_obj_t
val fnhelper : bool -> ('a c_obj_t list -> 'a c_obj_t list) -> 'a c_obj_t -> 'a c_obj_t
val get_int : 'a c_obj_t -> int
val get_float : 'a c_obj_t -> float
@ -44,3 +49,8 @@ val make_uint : int -> 'a c_obj_t
val make_int32 : int -> 'a c_obj_t
val make_int64 : int -> 'a c_obj_t
val new_derived_object:
('a c_obj_t -> 'a c_obj_t) ->
('a c_obj_t -> string -> 'a c_obj_t -> 'a c_obj_t) ->
'a c_obj_t -> 'a c_obj_t