Director related changes, other edits.
director_wombat testcase, as well as all others except director_abstract compile. Four test cases fail. git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@5196 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Art Yerkes
parent
500e3b21b6
commit
dff2895809
15 changed files with 224 additions and 504 deletions
|
|
@ -62,7 +62,7 @@ namespace Swig {
|
|||
|
||||
public:
|
||||
/* wrap a ocaml object, optionally taking ownership */
|
||||
Director(CAML_VALUE self) : swig_self(self), swig_disown_flag(false) {
|
||||
Director(CAML_VALUE self, bool disown = false) : swig_self(self), swig_disown_flag(disown) {
|
||||
register_global_root(&swig_self);
|
||||
}
|
||||
|
||||
|
|
@ -149,6 +149,20 @@ namespace Swig {
|
|||
%}
|
||||
|
||||
%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 =
|
||||
|
|
|
|||
|
|
@ -1,2 +1,6 @@
|
|||
# see top-level Makefile.in
|
||||
# libswigocaml is not needed anymore.
|
||||
swigp4.ml
|
||||
swig.mli
|
||||
swig.cmi
|
||||
swig.cmo
|
||||
|
|
@ -1,118 +1,4 @@
|
|||
(* -*- tuareg -*- *)
|
||||
open Int32
|
||||
open Int64
|
||||
|
||||
type c_obj =
|
||||
C_void
|
||||
| C_bool of bool
|
||||
| C_char of char
|
||||
| C_uchar of char
|
||||
| C_short of int
|
||||
| C_ushort of int
|
||||
| C_int of int
|
||||
| C_uint of int32
|
||||
| C_int32 of int32
|
||||
| C_int64 of int64
|
||||
| C_float of float
|
||||
| C_double of float
|
||||
| C_ptr of int64 * int64
|
||||
| C_array of c_obj array
|
||||
| C_list of c_obj list
|
||||
| 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
|
||||
exception NotEnumType of c_obj
|
||||
exception LabelNotFromThisEnum of c_obj
|
||||
open Swig
|
||||
|
||||
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 rec get_int x =
|
||||
match x with
|
||||
C_bool b -> if b then 1 else 0
|
||||
| C_char c
|
||||
| C_uchar c -> (int_of_char c)
|
||||
| C_short s
|
||||
| C_ushort s
|
||||
| C_int s -> s
|
||||
| C_uint u
|
||||
| C_int32 u -> (Int32.to_int u)
|
||||
| C_int64 u -> (Int64.to_int u)
|
||||
| C_float f -> (int_of_float f)
|
||||
| C_double d -> (int_of_float d)
|
||||
| C_ptr (p,q) -> (Int64.to_int p)
|
||||
| C_obj o -> (try (get_int (o "int" C_void))
|
||||
with _ -> (get_int (o "&" C_void)))
|
||||
| _ -> raise (Failure "Can't convert to int")
|
||||
|
||||
let rec get_float x =
|
||||
match x with
|
||||
C_char c
|
||||
| C_uchar c -> (float_of_int (int_of_char c))
|
||||
| C_short s -> (float_of_int s)
|
||||
| C_ushort s -> (float_of_int s)
|
||||
| C_int s -> (float_of_int s)
|
||||
| C_uint u
|
||||
| C_int32 u -> (float_of_int (Int32.to_int u))
|
||||
| C_int64 u -> (float_of_int (Int64.to_int u))
|
||||
| C_float f -> f
|
||||
| C_double d -> d
|
||||
| C_obj o -> (try (get_float (o "float" C_void))
|
||||
with _ -> (get_float (o "double" C_void)))
|
||||
| _ -> raise (Failure "Can't convert to float")
|
||||
|
||||
let rec get_char x =
|
||||
(char_of_int (get_int x))
|
||||
|
||||
let rec get_string x =
|
||||
match x with
|
||||
C_string str -> str
|
||||
| _ -> raise (Failure "Can't convert to string")
|
||||
|
||||
let rec get_bool x =
|
||||
match x with
|
||||
C_bool b -> b
|
||||
| _ ->
|
||||
(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_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
|
||||
let _ = Callback.register "caml_obj_ptr" addr_of
|
||||
|
||||
let make_float f = C_float f
|
||||
let make_double f = C_double f
|
||||
let make_string s = C_string s
|
||||
let make_bool b = C_bool b
|
||||
let make_char c = C_char c
|
||||
let make_char_i c = C_char (char_of_int c)
|
||||
let make_uchar c = C_uchar c
|
||||
let make_uchar_i c = C_uchar (char_of_int c)
|
||||
let make_short i = C_short i
|
||||
let make_ushort i = C_ushort i
|
||||
let make_int i = C_int i
|
||||
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)
|
||||
|
|
|
|||
|
|
@ -1,48 +1,3 @@
|
|||
(* -*- tuareg -*- *)
|
||||
type c_obj =
|
||||
C_void
|
||||
| C_bool of bool
|
||||
| C_char of char
|
||||
| C_uchar of char
|
||||
| C_short of int
|
||||
| C_ushort of int
|
||||
| C_int of int
|
||||
| C_uint of int32
|
||||
| C_int32 of int32
|
||||
| C_int64 of int64
|
||||
| C_float of float
|
||||
| C_double of float
|
||||
| C_ptr of int64 * int64
|
||||
| C_array of c_obj array
|
||||
| C_list of c_obj list
|
||||
| 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
|
||||
exception NotEnumType of c_obj
|
||||
exception LabelNotFromThisEnum of c_obj
|
||||
|
||||
val invoke : c_obj -> (string -> c_obj -> c_obj)
|
||||
val get_int : c_obj -> int
|
||||
val get_float : c_obj -> float
|
||||
val get_string : c_obj -> string
|
||||
val get_char : c_obj -> char
|
||||
val get_bool : c_obj -> bool
|
||||
|
||||
val make_float : float -> c_obj
|
||||
val make_double : float -> c_obj
|
||||
val make_string : string -> c_obj
|
||||
val make_bool : bool -> c_obj
|
||||
val make_char : char -> c_obj
|
||||
val make_char_i : int -> c_obj
|
||||
val make_uchar : char -> c_obj
|
||||
val make_uchar_i : int -> c_obj
|
||||
val make_short : int -> c_obj
|
||||
val make_ushort : int -> c_obj
|
||||
val make_int : int -> c_obj
|
||||
val make_uint : int -> c_obj
|
||||
val make_int32 : int -> c_obj
|
||||
val make_int64 : int -> c_obj
|
||||
open Swig
|
||||
|
|
|
|||
|
|
@ -31,4 +31,5 @@
|
|||
%include "typemaps.i"
|
||||
%include "typecheck.i"
|
||||
%include "exception.i"
|
||||
%include "preamble.swg"
|
||||
%include "director.swg"
|
||||
|
|
|
|||
|
|
@ -1,100 +1,100 @@
|
|||
open Pcaml ;;
|
||||
(* -*- tuareg -*- *)
|
||||
open Int32
|
||||
open Int64
|
||||
|
||||
let lap x y = x :: y
|
||||
let c_ify e loc =
|
||||
match e with
|
||||
<:expr< $int:_$ >> -> <:expr< (C_int $e$) >>
|
||||
| <:expr< $str:_$ >> -> <:expr< (C_string $e$) >>
|
||||
| <:expr< $chr:_$ >> -> <:expr< (C_char $e$) >>
|
||||
| <:expr< $flo:_$ >> -> <:expr< (C_double $e$) >>
|
||||
| _ -> <:expr< $e$ >>
|
||||
let rec mk_list args l f =
|
||||
match args with
|
||||
[] -> (let loc = l in <:expr< [] >>)
|
||||
| x :: xs ->
|
||||
(let loc = MLast.loc_of_expr x in
|
||||
<:expr< [ ($f x loc$) ] @ ($mk_list xs loc f$) >>)
|
||||
type 'a c_obj_t =
|
||||
C_void
|
||||
| C_bool of bool
|
||||
| C_char of char
|
||||
| C_uchar of char
|
||||
| C_short of int
|
||||
| C_ushort of int
|
||||
| C_int of int
|
||||
| C_uint of int32
|
||||
| C_int32 of int32
|
||||
| C_int64 of int64
|
||||
| C_float of float
|
||||
| C_double of float
|
||||
| C_ptr of int64 * int64
|
||||
| C_array of 'a c_obj_t array
|
||||
| C_list of 'a c_obj_t list
|
||||
| C_obj of (string -> 'a c_obj_t -> 'a c_obj_t)
|
||||
| C_string of string
|
||||
| C_enum of 'a
|
||||
| C_director_core of 'a c_obj_t * 'a c_obj_t option ref
|
||||
|
||||
EXTEND
|
||||
expr:
|
||||
[ [ e1 = expr ; "'" ; "[" ; e2 = expr ; "]" ->
|
||||
<:expr< (invoke $e1$) "[]" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "->" ; e2 = expr LEVEL "simple" ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
|
||||
<:expr< (invoke $e1$) $e2$ (C_list $mk_list args loc c_ify$) >>
|
||||
| e1 = expr ; "'" ; "." ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
|
||||
<:expr< (invoke $e1$) "()" (C_list $mk_list args loc c_ify$) >>
|
||||
| e1 = expr ; "'" ; "->" ->
|
||||
<:expr< (invoke ((invoke $e1$) "->" C_void)) >>
|
||||
| e1 = expr ; "'" ; "++" ->
|
||||
<:expr< (invoke $e1$) "++" C_void >>
|
||||
| e1 = expr ; "'" ; "--" ->
|
||||
<:expr< (invoke $e1$) "--" C_void >>
|
||||
| e1 = expr ; "'" ; "-" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "-" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "+" ; e2 = expr -> <:expr< (invoke $e1$) "+" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "*" ; e2 = expr -> <:expr< (invoke $e1$) "*" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| "'" ; "&" ; e1 = expr ->
|
||||
<:expr< (invoke $e1$) "&" C_void >>
|
||||
| "'" ; "!" ; e1 = expr ->
|
||||
<:expr< (invoke $e1$) "!" C_void >>
|
||||
| "'" ; "~" ; e1 = expr ->
|
||||
<:expr< (invoke $e1$) "~" C_void >>
|
||||
| e1 = expr ; "'" ; "/" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "/" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "%" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "%" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "lsl" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) ("<" ^ "<") (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "lsr" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) (">" ^ ">") (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "<" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "<" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "<=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "<=" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; ">" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) ">" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; ">=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) ">=" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "==" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "==" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "!=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "!=" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "&" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "&" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "^" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "^" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "|" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "|" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "&&" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "&&" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "||" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "||" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "=" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "+=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "+=" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "-=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "-=" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "*=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "*=" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "/=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "/=" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "%=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "%=" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "lsl" ; "=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) ("<" ^ "<=") (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "lsr" ; "=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) (">" ^ ">=") (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "&=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "&=" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "^=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "^=" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| e1 = expr ; "'" ; "|=" ; e2 = expr ->
|
||||
<:expr< (invoke $e1$) "|=" (C_list [ $c_ify e2 loc$ ]) >>
|
||||
| "'" ; e = expr -> c_ify e loc
|
||||
| f = expr ; "'" ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
|
||||
let l = mk_list args loc c_ify in
|
||||
<:expr< $f$ (C_list $l$) >>
|
||||
] ] ;
|
||||
END ;;
|
||||
let rec get_int x =
|
||||
match x with
|
||||
C_bool b -> if b then 1 else 0
|
||||
| C_char c
|
||||
| C_uchar c -> (int_of_char c)
|
||||
| C_short s
|
||||
| C_ushort s
|
||||
| C_int s -> s
|
||||
| C_uint u
|
||||
| C_int32 u -> (Int32.to_int u)
|
||||
| C_int64 u -> (Int64.to_int u)
|
||||
| C_float f -> (int_of_float f)
|
||||
| C_double d -> (int_of_float d)
|
||||
| C_ptr (p,q) -> (Int64.to_int p)
|
||||
| C_obj o -> (try (get_int (o "int" C_void))
|
||||
with _ -> (get_int (o "&" C_void)))
|
||||
| _ -> raise (Failure "Can't convert to int")
|
||||
|
||||
let rec get_float x =
|
||||
match x with
|
||||
C_char c
|
||||
| C_uchar c -> (float_of_int (int_of_char c))
|
||||
| C_short s -> (float_of_int s)
|
||||
| C_ushort s -> (float_of_int s)
|
||||
| C_int s -> (float_of_int s)
|
||||
| C_uint u
|
||||
| C_int32 u -> (float_of_int (Int32.to_int u))
|
||||
| C_int64 u -> (float_of_int (Int64.to_int u))
|
||||
| C_float f -> f
|
||||
| C_double d -> d
|
||||
| C_obj o -> (try (get_float (o "float" C_void))
|
||||
with _ -> (get_float (o "double" C_void)))
|
||||
| _ -> raise (Failure "Can't convert to float")
|
||||
|
||||
let rec get_char x =
|
||||
(char_of_int (get_int x))
|
||||
|
||||
let rec get_string x =
|
||||
match x with
|
||||
C_string str -> str
|
||||
| _ -> raise (Failure "Can't convert to string")
|
||||
|
||||
let rec get_bool x =
|
||||
match x with
|
||||
C_bool b -> b
|
||||
| _ ->
|
||||
(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_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 make_float f = C_float f
|
||||
let make_double f = C_double f
|
||||
let make_string s = C_string s
|
||||
let make_bool b = C_bool b
|
||||
let make_char c = C_char c
|
||||
let make_char_i c = C_char (char_of_int c)
|
||||
let make_uchar c = C_uchar c
|
||||
let make_uchar_i c = C_uchar (char_of_int c)
|
||||
let make_short i = C_short i
|
||||
let make_ushort i = C_ushort i
|
||||
let make_int i = C_int i
|
||||
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)
|
||||
|
|
|
|||
|
|
@ -306,6 +306,7 @@ namespace std {
|
|||
* known as the "Fulton Transform" :-).
|
||||
*/
|
||||
|
||||
#ifndef SWIGSEXP
|
||||
#ifdef __cplusplus
|
||||
%insert("runtime") %{
|
||||
#ifdef __cplusplus
|
||||
|
|
@ -325,6 +326,7 @@ private:
|
|||
#endif
|
||||
%}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Macro for setting a dynamic cast function */
|
||||
%define DYNAMIC_CAST(mangle,func)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue