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

Director related changes, other edits.

Browse source 
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 2003-10-22 04:01:27 +00:00
commit dff2895809
15 changed files with 224 additions and 504 deletions
Download patch file Download diff file Expand all files Collapse all files

12
Examples/Makefile.in
View file

@ -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)'

2
Examples/ocaml/shapes/example.i
View file

@ -1,8 +1,10 @@
/* File : example.i */
%module(directors="1") example
#ifndef SWIGSEXP
%{
#include "example.h"
%}
#endif
%feature("director");
%include "example.h"

1
Examples/ocaml/shapes/example_prog.ml
View file

@ -1,5 +1,6 @@
(* example_prog.ml *)
open Swig ;;
open Example ;;
let side_length (ax,ay) (bx,by) =

12
Examples/test-suite/ocaml/results
View file

@ -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

16
Lib/ocaml/director.swg
View file

@ -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 =

4
Lib/ocaml/extra-install.list
View file

@ -1,2 +1,6 @@
# see top-level Makefile.in
# libswigocaml is not needed anymore.
swigp4.ml
swig.mli
swig.cmi
swig.cmo

116
Lib/ocaml/mlheading.swg
View file

@ -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)

47
Lib/ocaml/mliheading.swg
View file

@ -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

1
Lib/ocaml/ocaml.i
View file

@ -31,4 +31,5 @@
%include "typemaps.i"
%include "typecheck.i"
%include "exception.i"
%include "preamble.swg"
%include "director.swg"

194
Lib/ocaml/swig.ml
View file

@ -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)

2
Lib/swig.swg
View file

@ -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)

11
Source/Modules/lang.cxx
View file

@ -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);
}

284
Source/Modules/ocaml.cxx
View file

@ -26,19 +26,20 @@ char cvsroot_ocaml_cxx[] = "$Header$";
#include <ctype.h>
static const char *usage = (char*)"\
Ocaml Options (available with -ocaml)\n\
-prefix <name> - Set a prefix <name> to be prepended to all names\n\
\n";
static const char *usage = (char*)
("Ocaml Options (available with -ocaml)\n"
"-prefix <name> - Set a prefix <name> 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);

19
Source/Modules/overload.cxx
View file

@ -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);

7
Source/Modules/swigmod.h
View file

@ -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);