diff --git a/Examples/Makefile.in b/Examples/Makefile.in index 210cd6a76..5110be852 100644 --- a/Examples/Makefile.in +++ b/Examples/Makefile.in @@ -537,10 +537,11 @@ mzscheme_clean: ##### Ocaml ##### ################################################################## -OCC=@OCAMLC@ +SWIGWHERE=-I `$(SWIG) -ocaml -where` +OCC=@OCAMLC@ $(SWIGWHERE) OCAMLDLGEN=@OCAMLDLGEN@ OCAMLFIND=@OCAMLFIND@ -OCAMLMKTOP=@OCAMLMKTOP@ +OCAMLMKTOP=@OCAMLMKTOP@ $(SWIGWHERE) NOLINK ?= false ocaml_static: $(SRCS) @@ -551,6 +552,7 @@ ocaml_static: $(SRCS) test -z "$(PROGFILE)" || test -f "$(PROGFILE)" && \ $(OCC) -c $(PROGFILE) $(NOLINK) || $(OCC) -g -ccopt -g -cclib -g -custom -o $(TARGET) \ + swig.cmo \ $(INTERFACE:%.i=%.cmo) \ $(PROGFILE:%.ml=%.cmo) \ $(INTERFACE:%.i=%_wrap.@OBJEXT@) $(OBJS) -cclib "$(LIBS)" @@ -569,6 +571,7 @@ ocaml_dynamic: $(SRCS) $(OCC) -c $(PROGFILE) $(NOLINK) || $(OCAMLFIND) \ $(OCC) -g -ccopt -g -cclib -g -custom -o $(TARGET) \ + swig.cmo \ -package dl -linkpkg \ $(INTERFACE:%.i=%.cmo) $(PROGFILE:%.ml=%.cmo) @@ -580,6 +583,7 @@ ocaml_static_toplevel: $(SRCS) test -z "$(PROGFILE)" || test -f "$(PROGFILE)" && \ $(OCC) -c $(PROGFILE) $(NOLINK) || $(OCAMLMKTOP) \ + swig.cmo \ -g -ccopt -g -cclib -g -custom -o $(TARGET)_top \ $(INTERFACE:%.i=%.cmo) \ $(INTERFACE:%.i=%_wrap.@OBJEXT@) $(OBJS) -cclib "$(LIBS)" @@ -594,6 +598,7 @@ ocaml_static_cpp: $(SRCS) test -z "$(PROGFILE)" || test -f "$(PROGFILE)" && \ $(OCC) -c $(PROGFILE) $(NOLINK) || $(OCC) -g -ccopt -g -cclib -g -custom -o $(TARGET) \ + swig.cmo \ $(INTERFACE:%.i=%.cmo) \ $(PROGFILE:%.ml=%.cmo) \ $(INTERFACE:%.i=%_wrap.@OBJEXT@) $(OBJS) \ @@ -609,6 +614,7 @@ ocaml_static_cpp_toplevel: $(SRCS) test -z "$(PROGFILE)" || test -f "$(PROGFILE)" && \ $(OCC) -c $(PROGFILE) $(NOLINK) || $(OCAMLMKTOP) \ + swig.cmo \ -g -ccopt -g -cclib -g -custom -o $(TARGET)_top \ $(INTERFACE:%.i=%.cmo) \ $(INTERFACE:%.i=%_wrap.@OBJEXT@) $(OBJS) \ @@ -630,6 +636,7 @@ ocaml_dynamic_cpp: $(SRCS) test -z "$(PROGFILE)" || test -f "$(PROGFILE)" && \ $(OCC) -c $(PROGFILE) $(NOLINK) || $(OCAMLFIND) \ + swig.cmo \ $(OCC) -cclib -export-dynamic -g -ccopt -g -cclib -g -custom \ -o $(TARGET) \ -package dl -linkpkg \ @@ -646,6 +653,7 @@ ocaml_static_multi_cpp: $(SRCS) test -z "$(PROGFILE)" || test -f "$(PROGFILE)" && \ $(OCC) -c $(PROGFILE) $(NOLINK) || $(OCC) -g -ccopt -g -cclib -g -custom -o $(TARGET) \ + swig.cmo \ $(INTERFACE:%.i=%.cmo) \ $(PROGFILE:%.ml=%.cmo) \ $(INTERFACE:%.i=%_wrap.@OBJEXT@) -cclib "$(LIBS)" -cc '$(CXX)' diff --git a/Examples/ocaml/shapes/example.i b/Examples/ocaml/shapes/example.i index cef7d0cff..cf900bf2d 100644 --- a/Examples/ocaml/shapes/example.i +++ b/Examples/ocaml/shapes/example.i @@ -1,8 +1,10 @@ /* File : example.i */ %module(directors="1") example +#ifndef SWIGSEXP %{ #include "example.h" %} +#endif %feature("director"); %include "example.h" diff --git a/Examples/ocaml/shapes/example_prog.ml b/Examples/ocaml/shapes/example_prog.ml index 7ede09f1f..a4848304b 100644 --- a/Examples/ocaml/shapes/example_prog.ml +++ b/Examples/ocaml/shapes/example_prog.ml @@ -1,5 +1,6 @@ (* example_prog.ml *) +open Swig ;; open Example ;; let side_length (ax,ay) (bx,by) = diff --git a/Examples/test-suite/ocaml/results b/Examples/test-suite/ocaml/results index 44104d250..787976cd4 100644 --- a/Examples/test-suite/ocaml/results +++ b/Examples/test-suite/ocaml/results @@ -1,4 +1,6 @@ Failed: +director_abstract.cpptest +template_array_numeric.cpptest typedef_inherit.cpptest template_typedef_import.multicpptest Success: @@ -49,6 +51,7 @@ director_basic.cpptest director_exception.cpptest director_finalizer.cpptest director_unroll.cpptest +director_wombat.cpptest dynamic_cast.cpptest enum_plus.cpptest enum_scope.cpptest @@ -57,10 +60,10 @@ enum_var.cpptest evil_diamond.cpptest evil_diamond_ns.cpptest evil_diamond_prop.cpptest -explicit.cpptest extend_placement.cpptest extend_template.cpptest extend_template_ns.cpptest +extern_throws.cpptest global_ns_arg.cpptest grouping.cpptest ignore_parameter.cpptest @@ -72,6 +75,7 @@ lib_carrays.cpptest lib_cdata.cpptest lib_cpointer.cpptest lib_std_deque.cpptest +lib_std_pair.cpptest lib_std_string.cpptest lib_std_vector.cpptest lib_typemaps.cpptest @@ -83,6 +87,7 @@ name_inherit.cpptest namespace_enum.cpptest namespace_extend.cpptest namespace_nested.cpptest +namespace_spaces.cpptest namespace_template.cpptest namespace_typemap.cpptest namespace_virtual_method.cpptest @@ -106,11 +111,13 @@ smart_pointer_const.cpptest smart_pointer_const2.cpptest smart_pointer_multi.cpptest smart_pointer_multi_typedef.cpptest +smart_pointer_namespace.cpptest smart_pointer_not.cpptest smart_pointer_overload.cpptest smart_pointer_protected.cpptest smart_pointer_rename.cpptest smart_pointer_simple.cpptest +smart_pointer_static.cpptest smart_pointer_typedef.cpptest static_array_member.cpptest static_const_member.cpptest @@ -148,6 +155,7 @@ template_ns_enum.cpptest template_ns_enum2.cpptest template_ns_inherit.cpptest template_ns_scope.cpptest +template_partial_arg.cpptest template_qualifier.cpptest template_ref_type.cpptest template_rename.cpptest @@ -184,6 +192,7 @@ using_protected.cpptest valuewrapper.cpptest valuewrapper_base.cpptest valuewrapper_const.cpptest +valuewrapper_default.cpptest varargs.cpptest virtual_destructor.cpptest voidtest.cpptest @@ -217,6 +226,7 @@ preproc_6.ctest ret_by_value.ctest sizeof_pointer.ctest sneaky1.ctest +struct_rename.ctest typemap_subst.ctest unions.ctest imports.multicpptest diff --git a/Lib/ocaml/director.swg b/Lib/ocaml/director.swg index 00a98b69e..72dfabf89 100644 --- a/Lib/ocaml/director.swg +++ b/Lib/ocaml/director.swg @@ -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 = diff --git a/Lib/ocaml/extra-install.list b/Lib/ocaml/extra-install.list index b35f4709d..ac4637101 100644 --- a/Lib/ocaml/extra-install.list +++ b/Lib/ocaml/extra-install.list @@ -1,2 +1,6 @@ # see top-level Makefile.in # libswigocaml is not needed anymore. +swigp4.ml +swig.mli +swig.cmi +swig.cmo \ No newline at end of file diff --git a/Lib/ocaml/mlheading.swg b/Lib/ocaml/mlheading.swg index 74f486e1c..a8c7783b8 100644 --- a/Lib/ocaml/mlheading.swg +++ b/Lib/ocaml/mlheading.swg @@ -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) diff --git a/Lib/ocaml/mliheading.swg b/Lib/ocaml/mliheading.swg index 29066e9c7..bebb8f877 100644 --- a/Lib/ocaml/mliheading.swg +++ b/Lib/ocaml/mliheading.swg @@ -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 diff --git a/Lib/ocaml/ocaml.i b/Lib/ocaml/ocaml.i index 35139f53f..3d77eec20 100644 --- a/Lib/ocaml/ocaml.i +++ b/Lib/ocaml/ocaml.i @@ -31,4 +31,5 @@ %include "typemaps.i" %include "typecheck.i" %include "exception.i" +%include "preamble.swg" %include "director.swg" diff --git a/Lib/ocaml/swig.ml b/Lib/ocaml/swig.ml index 602c9b08e..fba26c343 100644 --- a/Lib/ocaml/swig.ml +++ b/Lib/ocaml/swig.ml @@ -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) diff --git a/Lib/swig.swg b/Lib/swig.swg index ecf85df27..29ab59e3e 100644 --- a/Lib/swig.swg +++ b/Lib/swig.swg @@ -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) diff --git a/Source/Modules/lang.cxx b/Source/Modules/lang.cxx index 63312a440..09bde9fda 100644 --- a/Source/Modules/lang.cxx +++ b/Source/Modules/lang.cxx @@ -202,11 +202,13 @@ Language::Language() { symbols = NewHash(); classtypes = NewHash(); none_comparison = NewString("$arg != 0"); + argc_template_string = NewString("argc"); + argv_template_string = NewString("argv[%d]"); director_ctor_code = NewString(""); /* Default director constructor code, passed to Swig_ConstructorToFunction */ Printv(director_ctor_code, - "if ( $comparison ) { /*subclassed */\n", + "if ( $comparison ) { /* subclassed */\n", " $director_new \n", "} else {\n", " $nondirector_new \n", @@ -2197,3 +2199,10 @@ int Language::abstractClassTest(Node *n) { void Language::setSubclassInstanceCheck(String *nc) { none_comparison = nc; } + +void Language::setOverloadResolutionTemplates(String *argc, String *argv) { + Delete(argc_template_string); + argc_template_string = Copy(argc); + Delete(argv_template_string); + argv_template_string = Copy(argv); +} diff --git a/Source/Modules/ocaml.cxx b/Source/Modules/ocaml.cxx index 2a3e941e1..4cce776c9 100755 --- a/Source/Modules/ocaml.cxx +++ b/Source/Modules/ocaml.cxx @@ -26,19 +26,20 @@ char cvsroot_ocaml_cxx[] = "$Header$"; #include -static const char *usage = (char*)"\ -Ocaml Options (available with -ocaml)\n\ - -prefix - Set a prefix to be prepended to all names\n\ -\n"; +static const char *usage = (char*) + ("Ocaml Options (available with -ocaml)\n" + "-prefix - Set a prefix to be prepended to all names\n" + "-where - Emit library location\n" + "\n"); static int classmode = 0; static int in_constructor = 0, in_destructor = 0, in_copyconst = 0; static int const_enum = 0; static int static_member_function = 0; static char *prefix=0; +static char *ocaml_path=(char*)"ocaml"; static String *classname=0; static String *module=0; -static char *ocaml_path=(char*)"ocaml"; static String *init_func_def = 0; static String *f_classtemplate = 0; @@ -63,6 +64,13 @@ static File *f_class_ctors_end = 0; static File *f_enum_to_int = 0; static File *f_int_to_enum = 0; +extern String *method_decl(SwigType *s, const String_or_char *id, List *args, + int strip, int values); +extern String *Swig_method_call(String_or_char *name, ParmList *parms); +extern String *Swig_csuperclass_call(String* base, String* method, + ParmList* l); +extern String *Swig_class_declaration(Node *n, String *name); + class OCAML : public Language { public: @@ -70,216 +78,17 @@ public: return true; } -/* method_decl - * - * Misnamed and misappropriated! Taken from SWIG's type string manipulation - * utilities and modified to generate full (or partial) type qualifiers for - * method declarations, local variable declarations, and return value casting. - * More importantly, it merges parameter type information with actual - * parameter names to produce a complete method declaration that fully mirrors - * the original method declaration. - * - * There is almost certainly a saner way to do this. - * - * This function needs to be cleaned up and possibly split into several - * smaller functions. For instance, attaching default names to parameters - * should be done in a separate function. - * - */ - - String *method_decl(SwigType *s, const String_or_char *id, List *args, int strip, int values) { - String *result; - List *elements; - String *element = 0, *nextelement; - int is_const = 0; - int nelements, i; - int is_func = 0; - int arg_idx = 0; - - if (id) { - result = NewString(Char(id)); - } else { - result = NewString(""); - } - - elements = SwigType_split(s); - nelements = Len(elements); - if (nelements > 0) { - element = Getitem(elements, 0); - } - for (i = 0; i < nelements; i++) { - if (i < (nelements - 1)) { - nextelement = Getitem(elements, i+1); - } else { - nextelement = 0; - } - if (SwigType_isqualifier(element)) { - int skip = 0; - DOH *q = 0; - if (!strip) { - q = SwigType_parm(element); - if (!Cmp(q, "const")) { - is_const = 1; - is_func = SwigType_isfunction(nextelement); - if (is_func) skip = 1; - skip = 1; - } - if (!skip) { - Insert(result,0," "); - Insert(result,0,q); - } - Delete(q); - } - } else if (SwigType_ispointer(element)) { - Insert(result,0,"*"); - if ((nextelement) && ((SwigType_isfunction(nextelement) || (SwigType_isarray(nextelement))))) { - Insert(result,0,"("); - Append(result,")"); - } - } else if (SwigType_ismemberpointer(element)) { - String *q; - q = SwigType_parm(element); - Insert(result,0,"::*"); - Insert(result,0,q); - if ((nextelement) && ((SwigType_isfunction(nextelement) || (SwigType_isarray(nextelement))))) { - Insert(result,0,"("); - Append(result,")"); - } - Delete(q); - } - else if (SwigType_isreference(element)) { - Insert(result,0,"&"); - } else if (SwigType_isarray(element)) { - DOH *size; - Append(result,"["); - size = SwigType_parm(element); - Append(result,size); - Append(result,"]"); - Delete(size); - } else if (SwigType_isfunction(element)) { - Parm *parm; - String *p; - Append(result,"("); - parm = args; - while (parm != 0) { - String *type = Getattr(parm, "type"); - String* name = Getattr(parm, "name"); - if (!name && Cmp(type, "void")) { - name = NewString(""); - Printf(name, "arg%d", arg_idx++); - Setattr(parm, "name", name); - } - if (!name) { - name = NewString(""); - } - p = SwigType_str(type, name); - Append(result,p); - String* value = Getattr(parm, "CAML_VALUE"); - if (values && (value != 0)) { - Printf(result, " = %s", value); - } - parm = nextSibling(parm); - if (parm != 0) Append(result,", "); - } - Append(result,")"); - } else { - if (Strcmp(element,"v(...)") == 0) { - Insert(result,0,"..."); - } else { - String *bs = SwigType_namestr(element); - Insert(result,0," "); - Insert(result,0,bs); - Delete(bs); - } - } - element = nextelement; - } - Delete(elements); - if (is_const) { - if (is_func) { - Append(result, " "); - Append(result, "const"); - } else { - Insert(result, 0, "const "); - } - } - Chop(result); - return result; - } - String *Swig_class_name(Node *n) { String *name; name = Copy(Getattr(n, "sym:name")); return name; } - String *Swig_method_call(String_or_char *name, ParmList *parms) { - String *func; - int i = 0; - int comma = 0; - Parm *p = parms; - SwigType *pt; - String *nname; - - func = NewString(""); - nname = SwigType_namestr(name); - Printf(func,"%s(", nname); - while (p) { - String *pname; - pt = Getattr(p,"type"); - if ((SwigType_type(pt) != T_VOID)) { - if (comma) Printf(func,","); - pname = Getattr(p, "name"); - Printf(func,"%s", pname); - comma = 1; - i++; - } - p = nextSibling(p); - } - Printf(func,")"); - return func; + void PrintIncludeArg() { + Printv(stdout,SWIG_LIB,SWIG_FILE_DELIMETER,ocaml_path, + "\n",NIL); } - /* Swig_csuperclass_call() - * - * Generates a fully qualified method call, including the full parameter list. - * e.g. "base::method(i, j)" - * - */ - - String *Swig_csuperclass_call(String* base, String* method, ParmList* l) { - String *call = NewString(""); - Parm *p; - if (base) { - Printf(call, "%s::", base); - } - Printf(call, "%s(", method); - for (p=l; p; p = nextSibling(p)) { - String *pname = Getattr(p, "name"); - if (p != l) Printf(call, ", "); - Printv(call, pname, NIL); - } - Printf(call, ")"); - return call; - } - - /* Swig_class_declaration() - * - * Generate the start of a class/struct declaration. - * e.g. "class myclass" - * - */ - - String *Swig_class_declaration(Node *n, String *name) { - if (!name) { - name = Getattr(n, "sym:name"); - } - String *result = NewString(""); - String *kind = Getattr(n, "kind"); - Printf(result, "%s %s", kind, name); - return result; - } - /* ------------------------------------------------------------ * main() * ------------------------------------------------------------ */ @@ -297,6 +106,9 @@ public: if (strcmp (argv[i], "-help") == 0) { fputs (usage, stderr); SWIG_exit (0); + } else if (strcmp (argv[i], "-where") == 0) { + PrintIncludeArg(); + SWIG_exit (0); } else if (strcmp (argv[i], "-prefix") == 0) { if (argv[i + 1]) { prefix = new char[strlen(argv[i + 1]) + 2]; @@ -1443,7 +1255,7 @@ public: } int enumDeclaration(Node *n) { - String *name = Getattr(n,"name"); + String *name = Getattr(n,"type"); if( name && !Getattr(seen_enums,name) ) { const_enum = 1; @@ -1804,43 +1616,29 @@ public: /* insert self and disown parameters */ Parm *p, *ip; - ParmList *superparms = CopyParmList(Getattr(n, "parms")); - ParmList *parms_in_declaration = CopyParmList(superparms); - ParmList *parms_in_definition = CopyParmList(superparms); + ParmList *superparms = Getattr(n, "parms"); + ParmList *parms = CopyParmList(superparms); String *type = NewString("CAML_VALUE"); - p = NewParm(type, NewString("self")); - set_nextSibling(p, parms_in_definition); - parms_in_definition = p; - - p = NewParm(type, NewString("self")); - set_nextSibling(p, parms_in_declaration); - parms_in_declaration = p; - - for (ip = parms_in_definition; nextSibling(ip); ) - ip = nextSibling(ip); -#if 0 + set_nextSibling(p, parms); + parms = p; + for (ip = parms; nextSibling(ip); ) ip = nextSibling(ip); p = NewParm(NewString("bool"), NewString("disown")); - Setattr(p, "CAML_VALUE", "1"); - Setattr(p, "args:byname", "1"); - Setattr(p, "value", "0"); + Setattr(p, "arg:byname", "1"); Setattr(n, "director:postfix_args", p); -#endif - /* set_nextSibling(ip, p); */ - + Setattr(p, "value", "0"); + set_nextSibling(ip, p); /* constructor */ { Wrapper *w = NewWrapper(); String *call; String *basetype = Getattr(parent, "classtype"); - // SwigType_add_pointer(basetype); - Setattr(n, "parms", parms_in_definition); - String *target = method_decl(decl, classname, parms_in_declaration, + String *target = method_decl(decl, classname, parms, 0, 0); call = Swig_csuperclass_call(0, basetype, superparms); Printf( w->def, - "%s::%s: %s, Swig::Director(self) { }", + "%s::%s: %s, Swig::Director(self, disown) { }", classname, target, call ); Delete(target); Wrapper_print(w, f_directors); @@ -1851,7 +1649,7 @@ public: /* constructor header */ { String *target = method_decl(decl, classname, - parms_in_declaration, 0, 1); + parms, 0, 1); Printf(f_directors_h, " %s;\n", target); Delete(target); } @@ -1859,8 +1657,8 @@ public: Delete(sub); Delete(classname); Delete(supername); - Delete(parms_in_definition); - /* Setattr(n, "parms", parms_in_definition ); */ + Delete(parms); + return Language::classDirectorConstructor(n); } @@ -1871,6 +1669,22 @@ public: int classDirectorDefaultConstructor(Node *n) { String *classname; classname = Swig_class_name(n); + + /* insert self and disown parameters */ + Parm *p, *ip; + ParmList *superparms = Getattr(n, "parms"); + ParmList *parms = CopyParmList(superparms); + String *type = NewString("CAML_VALUE"); + p = NewParm(type, NewString("self")); + set_nextSibling(p, parms); + parms = p; + for (ip = parms; nextSibling(ip); ) ip = nextSibling(ip); + p = NewParm(NewString("bool"), NewString("disown")); + Setattr(p, "arg:byname", "1"); + Setattr(n, "director:postfix_args", p); + Setattr(p, "value", "0"); + set_nextSibling(ip, p); + { Wrapper *w = NewWrapper(); Printf(w->def, "SwigDirector_%s::SwigDirector_%s(CAML_VALUE self, bool disown) : Swig::Director(self, disown) { }", classname, classname); diff --git a/Source/Modules/overload.cxx b/Source/Modules/overload.cxx index 14c30fb13..37a310107 100644 --- a/Source/Modules/overload.cxx +++ b/Source/Modules/overload.cxx @@ -17,6 +17,10 @@ char cvsroot_overload_cxx[] = "$Header$"; #define MAX_OVERLOAD 256 +/* Overload "argc" and "argv" */ +String *argv_template_string; +String *argc_template_string; + extern int emit_num_required(ParmList *); /* ----------------------------------------------------------------------------- @@ -262,7 +266,7 @@ Swig_overload_rank(Node *n) { static bool print_typecheck(String *f, int j, Parm *pj) { char tmp[256]; - sprintf(tmp,"argv[%d]",j); + sprintf(tmp,Char(argv_template_string),j); String *tm = Getattr(pj,"tmap:typecheck"); if (tm) { Replaceid(tm,Getattr(pj,"lname"),"_v"); @@ -284,7 +288,8 @@ ReplaceFormat (const String_or_char *fmt, int j) int i; String *commaargs = NewString (""); for (i=0; i < j; i++) { - Printf (commaargs, ", argv[%d]", i); + Printv (commaargs, ", ", NIL); + Printf (commaargs, Char(argv_template_string), i); } Replaceall (lfmt, "$commaargs", commaargs); return lfmt; @@ -314,12 +319,14 @@ Swig_overload_dispatch(Node *n, const String_or_char *fmt, int *maxargs) { if (!varargs) { if (num_required == num_arguments) { - Printf(f,"if (argc == %d) {\n", num_required); + Printf(f,"if (%s == %d) {\n", argc_template_string, num_required); } else { - Printf(f,"if ((argc >= %d) && (argc <= %d)) {\n", num_required, num_arguments); + Printf(f,"if ((%s >= %d) && (%s <= %d)) {\n", + argc_template_string, num_required, + argc_template_string, num_arguments); } } else { - Printf(f,"if (argc >= %d) {\n", num_required); + Printf(f,"if (%s >= %d) {\n", argc_template_string, num_required); } if (num_arguments) { @@ -336,7 +343,7 @@ Swig_overload_dispatch(Node *n, const String_or_char *fmt, int *maxargs) { } if (j >= num_required) { String *lfmt = ReplaceFormat (fmt, num_arguments); - Printf(f, "if (argc <= %d) {\n", j); + Printf(f, "if (%s <= %d) {\n", argc_template_string, j); Printf(f, Char(lfmt),Getattr(ni,"wrap:name")); Printf(f, "}\n"); Delete (lfmt); diff --git a/Source/Modules/swigmod.h b/Source/Modules/swigmod.h index 6aba6a529..f2664bebe 100644 --- a/Source/Modules/swigmod.h +++ b/Source/Modules/swigmod.h @@ -42,6 +42,10 @@ extern int NoExcept; // -no_except option extern int Abstract; // abstract base class extern int SmartPointer; // smart pointer methods being emitted +/* Overload "argc" and "argv" */ +extern String *argv_template_string; +extern String *argc_template_string; + /* Miscellaneous stuff */ #define tab2 " " @@ -213,6 +217,9 @@ public: /* Set none comparison string */ void setSubclassInstanceCheck(String *s); + /* Set overload variable templates argc and argv */ + void setOverloadResolutionTemplates(String *argc, String *argv); + protected: /* Patch C++ pass-by-value */ static void patch_parms(Parm *p);