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

Added:

Browse source 
Type registration.  Correct support for casting.  Proper type safety.
Changed:
ocaml.swg: Correct casts, declaration order for C
ocamldec.swg: Removed problematic forward declarations without array index.


git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@4573 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Art Yerkes 2003-03-19 16:24:47 +00:00
commit 4b2da49eb3
12 changed files with 634 additions and 230 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -38,7 +38,7 @@ let triangle_class pts ob meth args =
let triangle = let triangle =
new_derived_object new_derived_object
new_shape new_shape
(triangle_class ((0.0,0.0),(0.5,1.0),(1.0,0.0))) (triangle_class ((0.0,0.0),(0.5,1.0),(1.0,0.6)))
C_void ;; C_void ;;
let _ = _draw_shape_coverage (C_list [ triangle ; C_int 60 ; C_int 20 ]) ;; let _ = _draw_shape_coverage (C_list [ triangle ; C_int 60 ; C_int 20 ]) ;;

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

@ -0,0 +1,208 @@
Failed:
bools.cpptest
director_exception.cpptest
lib_std_string.cpptest
namespace_typemap.cpptest
private_assign.cpptest
template_type_namespace.cpptest
template_typedef_import.multicpptest
Success:
abstract_inherit.cpptest
abstract_inherit_ok.cpptest
abstract_signature.cpptest
abstract_typedef.cpptest
abstract_typedef2.cpptest
abstract_virtual.cpptest
add_link.cpptest
anonymous_arg.cpptest
anonymous_bitfield.cpptest
argout.cpptest
arrayref.cpptest
arrays_global.cpptest
arrays_global_twodim.cpptest
arrays_scope.cpptest
bool_default.cpptest
casts.cpptest
cast_operator.cpptest
class_ignore.cpptest
const_const_2.cpptest
constant_pointers.cpptest
constover.cpptest
constructor_exception.cpptest
constructor_explicit.cpptest
constructor_value.cpptest
conversion.cpptest
conversion_namespace.cpptest
conversion_ns_template.cpptest
cplusplus_throw.cpptest
cpp_enum.cpptest
cpp_enum_scope.cpptest
cpp_namespace.cpptest
cpp_nodefault.cpptest
cpp_static.cpptest
cpp_typedef.cpptest
default_cast.cpptest
default_constructor.cpptest
default_ns.cpptest
default_ref.cpptest
director_basic.cpptest
director_finalizer.cpptest
director_unroll.cpptest
dynamic_cast.cpptest
enum_plus.cpptest
enum_scope.cpptest
enum_scope_template.cpptest
enum_var.cpptest
evil_diamond.cpptest
evil_diamond_ns.cpptest
evil_diamond_prop.cpptest
explicit.cpptest
extend_template.cpptest
extend_template_ns.cpptest
global_ns_arg.cpptest
grouping.cpptest
ignore_parameter.cpptest
import_nomodule.cpptest
inherit_missing.cpptest
kind.cpptest
lib_carrays.cpptest
lib_cdata.cpptest
lib_cpointer.cpptest
lib_std_deque.cpptest
lib_std_vector.cpptest
lib_typemaps.cpptest
long_long_apply.cpptest
member_template.cpptest
minherit.cpptest
name_cxx.cpptest
name_inherit.cpptest
namespace_enum.cpptest
namespace_extend.cpptest
namespace_template.cpptest
newobject1.cpptest
overload_complicated.cpptest
overload_copy.cpptest
overload_extend.cpptest
overload_simple.cpptest
overload_subtype.cpptest
overload_template.cpptest
pointer_reference.cpptest
primitive_ref.cpptest
pure_virtual.cpptest
reference_global_vars.cpptest
rename_default.cpptest
rename_scope.cpptest
return_value_scope.cpptest
rname.cpptest
smart_pointer_const.cpptest
smart_pointer_const2.cpptest
smart_pointer_multi.cpptest
smart_pointer_multi_typedef.cpptest
smart_pointer_not.cpptest
smart_pointer_overload.cpptest
smart_pointer_protected.cpptest
smart_pointer_rename.cpptest
smart_pointer_simple.cpptest
smart_pointer_typedef.cpptest
static_array_member.cpptest
static_const_member.cpptest
static_const_member_2.cpptest
struct_value.cpptest
template.cpptest
template_arg_replace.cpptest
template_arg_scope.cpptest
template_arg_typename.cpptest
template_base_template.cpptest
template_classes.cpptest
template_const_ref.cpptest
template_construct.cpptest
template_default.cpptest
template_default2.cpptest
template_default_inherit.cpptest
template_default_qualify.cpptest
template_default_vw.cpptest
template_enum.cpptest
template_enum_ns_inherit.cpptest
template_enum_typedef.cpptest
template_explicit.cpptest
template_extend1.cpptest
template_extend2.cpptest
template_forward.cpptest
template_inherit.cpptest
template_inherit_abstract.cpptest
template_int_const.cpptest
template_ns.cpptest
template_ns2.cpptest
template_ns3.cpptest
template_ns4.cpptest
template_ns_enum.cpptest
template_ns_enum2.cpptest
template_ns_inherit.cpptest
template_ns_scope.cpptest
template_qualifier.cpptest
template_rename.cpptest
template_retvalue.cpptest
template_specialization.cpptest
template_static.cpptest
template_tbase_template.cpptest
template_typedef.cpptest
template_typedef_cplx.cpptest
template_typedef_cplx2.cpptest
template_typedef_cplx3.cpptest
template_typedef_cplx4.cpptest
template_virtual.cpptest
template_whitespace.cpptest
throw_exception.cpptest
typedef_array_member.cpptest
typedef_funcptr.cpptest
typedef_inherit.cpptest
typedef_mptr.cpptest
typedef_reference.cpptest
typedef_scope.cpptest
typemap_namespace.cpptest
typemap_ns_using.cpptest
typename.cpptest
union_scope.cpptest
using1.cpptest
using2.cpptest
using_composition.cpptest
using_extend.cpptest
using_inherit.cpptest
using_private.cpptest
using_protected.cpptest
valuewrapper_base.cpptest
varargs.cpptest
virtual_destructor.cpptest
voidtest.cpptest
arrayptr.ctest
arrays.ctest
char_constant.ctest
const_const.ctest
cpp_macro_noarg.ctest
defineop.ctest
defines.ctest
enum.ctest
function_typedef.ctest
lib_carrays.ctest
lib_cdata.ctest
lib_cmalloc.ctest
lib_constraints.ctest
lib_cpointer.ctest
lib_math.ctest
long_long.ctest
macro_2.ctest
name.ctest
nested.ctest
newobject2.ctest
overload_extendc.ctest
preproc_1.ctest
preproc_2.ctest
preproc_3.ctest
preproc_4.ctest
preproc_5.ctest
ret_by_value.ctest
sizeof_pointer.ctest
sneaky1.ctest
typemap_subst.ctest
unions.ctest
imports.multicpptest

154
Lib/ocaml/carray.i
View file

@ -1,22 +1,136 @@
template < class T > class SWIG_OCAML_ARRAY_WRAPPER { %insert(mli) %{
public: type _value = c_obj
SWIG_OCAML_ARRAY_WRAPPER( T *t ) : t(t) { } %}
SWIG_OCAML_ARRAY_WRAPPER( T &t ) : t(&t) { }
SWIG_OCAML_ARRAY_WRAPPER( T t[] ) : t(&t[0]) { }
T &operator[]( int n ) { return t[n]; }
SWIG_OCAML_ARRAY_WRAPPER offset( int elts ) {
return SWIG_OCAML_ARRAY_WRAPPER( t + elts );
}
T *operator & () { return t; }
void own() { owned = true; }
void disown() { owned = false; }
~SWIG_OCAML_ARRAY_WRAPPER() {
if( owned ) delete t;
}
private: %insert(ml) %{
T *t; type _value = c_obj
int owned; %}
};
%apply SWIGTYPE [ANY] {SWIG_OCAML_ARRAY_WRAPPER}; %define %array_tmap_out(type,what,out_f)
%typemap(type) what [ANY] {
int i;
/* $*1_type */
$result = caml_array_new($1_dim0);
for( i = 0; i < $1_dim0; i++ ) {
caml_array_set($result,i,out_f($1[i]));
}
}
%enddef
%define %array_tmap_in(type,what,in_f)
%typemap(type) what [ANY] {
int i;
/* $*1_type */
$1 = ($*1_type *)malloc( $1_size );
for( i = 0; i < $1_dim0 && i < caml_array_len($input); i++ ) {
$1[i] = in_f(caml_array_nth($input,i));
}
}
%typemap(free) what [ANY] {
free( (void *)$1 );
}
%enddef
%define %make_simple_array_typemap(type,out_f,in_f)
%array_tmap_out(out,type,out_f);
%array_tmap_out(varout,type,out_f);
%array_tmap_out(inv,type,out_f);
%array_tmap_in(in,type,in_f);
%array_tmap_in(varin,type,in_f);
%array_tmap_in(outv,type,in_f);
%enddef
%make_simple_array_typemap(bool,caml_val_bool,caml_long_val);
%make_simple_array_typemap(short,caml_val_short,caml_long_val);
%make_simple_array_typemap(unsigned short,caml_val_ushort,caml_long_val);
%make_simple_array_typemap(int,caml_val_int,caml_long_val);
%make_simple_array_typemap(unsigned int,caml_val_uint,caml_long_val);
%make_simple_array_typemap(long,caml_val_long,caml_long_val);
%make_simple_array_typemap(unsigned long,caml_val_ulong,caml_long_val);
%make_simple_array_typemap(size_t,caml_val_int,caml_long_val);
%make_simple_array_typemap(float,caml_val_float,caml_double_val);
%make_simple_array_typemap(double,caml_val_double,caml_double_val);
#ifdef __cplusplus
%typemap(in) SWIGTYPE [] {
int i;
/* $*1_type */
$1 = new $*1_type [$1_dim0];
for( i = 0; i < $1_dim0 && i < caml_array_len($input); i++ ) {
$1[i] = *(($*1_ltype *)
caml_ptr_val(caml_array_nth($input,i),
$*1_descriptor)) ;
}
}
#else
%typemap(in) SWIGTYPE [] {
int i;
/* $*1_type */
$1 = ($*1_type *)malloc( $1_size );
for( i = 0; i < $1_dim0 && i < caml_array_len($input); i++ ) {
$1[i] = *(($*1_ltype)
caml_ptr_val(caml_array_nth($input),
$*1_descriptor));
}
}
#endif
%typemap(out) SWIGTYPE [] {
int i;
CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
$result = caml_array_new($1_dim0);
for( i = 0; i < $1_dim0; i++ ) {
if( fromval ) {
caml_array_set
($result,
i,
callback(*fromval,caml_val_ptr((void *)&$1[i],$*1_descriptor)));
} else {
caml_array_set
($result,
i,
caml_val_ptr ((void *)&$1[i],$&1_descriptor));
}
}
}
%typemap(in) enum SWIGTYPE [] {
int i;
/* $*1_type */
$1 = ($*1_type *)malloc( $1_size );
for( i = 0; i < $1_dim0 && i < caml_array_len($input); i++ ) {
$1[i] = ($type)
caml_long_val_full(caml_array_nth($input),
"$type_marker");
}
}
%typemap(out) enum SWIGTYPE [] {
int i;
$result = caml_array_new($1_dim0);
for( i = 0; i < $1_dim0; i++ ) {
caml_array_set
($result,
i,
callback2(*caml_named_value(SWIG_MODULE "_int_to_enum"),
*caml_named_value("$type_marker"),
Val_int($1[i])));
}
}
#ifdef __cplusplus
%typemap(freearg) SWIGTYPE [ANY] {
delete [] $1;
}
#else
%typemap(freearg) SWIGTYPE [ANY] {
free( (void *)$1 );
}
#endif

8
Lib/ocaml/director.swg
View file

@ -26,7 +26,7 @@ public:
virtual ~SWIG_DIRECTOR_EXCEPTION() { } virtual ~SWIG_DIRECTOR_EXCEPTION() { }
}; };
/* type mismatch in the return value from a ocaml method call */ /* type mismatch in the return CAML_VALUE from a ocaml method call */
class SWIG_DIRECTOR_TYPE_MISMATCH: public SWIG_DIRECTOR_EXCEPTION { class SWIG_DIRECTOR_TYPE_MISMATCH: public SWIG_DIRECTOR_EXCEPTION {
public: public:
SWIG_DIRECTOR_TYPE_MISMATCH(const char* msg="") { SWIG_DIRECTOR_TYPE_MISMATCH(const char* msg="") {
@ -57,7 +57,7 @@ class SWIG_DIRECTOR_METHOD_EXCEPTION: public SWIG_DIRECTOR_EXCEPTION { };
class __DIRECTOR__ { class __DIRECTOR__ {
private: private:
/* pointer to the wrapped ocaml object */ /* pointer to the wrapped ocaml object */
value _self; CAML_VALUE _self;
/* flag indicating whether the object is owned by ocaml or c++ */ /* flag indicating whether the object is owned by ocaml or c++ */
mutable int _disown; mutable int _disown;
/* shared flag for breaking recursive director calls */ /* shared flag for breaking recursive director calls */
@ -90,7 +90,7 @@ public:
} }
/* wrap a ocaml object, optionally taking ownership */ /* wrap a ocaml object, optionally taking ownership */
__DIRECTOR__(value self, int disown): _self(self), _disown(disown) { __DIRECTOR__(CAML_VALUE self, int disown): _self(self), _disown(disown) {
register_global_root(&_self); register_global_root(&_self);
} }
@ -103,7 +103,7 @@ public:
} }
/* return a pointer to the wrapped ocaml object */ /* return a pointer to the wrapped ocaml object */
value __get_self() const { CAML_VALUE __get_self() const {
return callback(*caml_named_value("caml_director_get_self"),_self); return callback(*caml_named_value("caml_director_get_self"),_self);
} }

2
Lib/ocaml/ocaml.i
View file

@ -14,7 +14,9 @@
%insert(runtime) "ocamldec.swg" %insert(runtime) "ocamldec.swg"
/* Type registration */ /* Type registration */
#if 0
%insert(init) "typeregister.swg" %insert(init) "typeregister.swg"
#endif
/*#ifndef SWIG_NOINCLUDE*/ /*#ifndef SWIG_NOINCLUDE*/
%insert(runtime) "ocaml.swg" %insert(runtime) "ocaml.swg"

104
Lib/ocaml/ocaml.swg
View file

@ -81,9 +81,9 @@ extern "C" {
} }
} }
SWIGSTATIC void caml_print_list( value v ); SWIGSTATIC void caml_print_list( CAML_VALUE v );
SWIGSTATIC void caml_print_val( value v ) { SWIGSTATIC void caml_print_val( CAML_VALUE v ) {
switch( Tag_val(v) ) { switch( Tag_val(v) ) {
case C_bool: case C_bool:
if( Bool_val(Field(v,0)) ) fprintf( stderr, "true " ); if( Bool_val(Field(v,0)) ) fprintf( stderr, "true " );
@ -117,8 +117,8 @@ extern "C" {
case C_ptr: case C_ptr:
{ {
void *vout = 0; void *vout = 0;
swig_type_info *ty = (swig_type_info *)(long)Int64_val(Field(v,1));
caml_ptr_val_internal(v,&vout,0); caml_ptr_val_internal(v,&vout,0);
swig_type_info *ty = (swig_type_info *)Int64_val(Field(v,1));
fprintf( stderr, "PTR(%p,%s) ", fprintf( stderr, "PTR(%p,%s) ",
vout, vout,
ty ? ty->name : "(null)" ); ty ? ty->name : "(null)" );
@ -147,7 +147,7 @@ extern "C" {
} }
} }
SWIGSTATIC void caml_print_list( value v ) { SWIGSTATIC void caml_print_list( CAML_VALUE v ) {
CAMLparam1(v); CAMLparam1(v);
while( v && Is_block(v) ) { while( v && Is_block(v) ) {
fprintf( stderr, "[ " ); fprintf( stderr, "[ " );
@ -157,7 +157,7 @@ extern "C" {
} }
} }
SWIGSTATIC value caml_list_nth( value lst, int n ) { SWIGSTATIC CAML_VALUE caml_list_nth( CAML_VALUE lst, int n ) {
CAMLparam1(lst); CAMLparam1(lst);
int i = 0; int i = 0;
while( i < n && lst && Is_block(lst) ) { while( i < n && lst && Is_block(lst) ) {
@ -167,7 +167,7 @@ extern "C" {
else CAMLreturn(Field(lst,0)); else CAMLreturn(Field(lst,0));
} }
SWIGSTATIC value caml_list_append( value lst, value elt ) { SWIGSTATIC CAML_VALUE caml_list_append( CAML_VALUE lst, CAML_VALUE elt ) {
CAMLparam2(lst,elt); CAMLparam2(lst,elt);
CAMLlocal3(v,vt,lh); CAMLlocal3(v,vt,lh);
lh = Val_unit; lh = Val_unit;
@ -201,30 +201,64 @@ extern "C" {
CAMLreturn(lh); CAMLreturn(lh);
} }
SWIGSTATIC int caml_list_length( value lst ) { SWIGSTATIC int caml_list_length( CAML_VALUE lst ) {
CAMLparam1(lst); CAMLparam1(lst);
int i = 0; int i = 0;
while( lst && Is_block(lst) ) { i++; lst = Field(lst,1); } while( lst && Is_block(lst) ) { i++; lst = Field(lst,1); }
CAMLreturn(i); CAMLreturn(i);
} }
SWIGSTATIC void caml_array_set( CAML_VALUE arr, int n, CAML_VALUE item ) {
CAMLparam2(arr,item);
Store_field(Field(arr,0),n,item);
CAMLreturn0;
}
SWIGSTATIC value caml_array_nth( CAML_VALUE arr, int n ) {
CAMLparam1(arr);
if( Tag_val(arr) == C_array )
CAMLreturn(Field(Field(arr,0),n));
else if( Tag_val(arr) == C_list )
CAMLreturn(caml_list_nth(arr,0));
else
failwith("Need array or list");
}
SWIGSTATIC int caml_array_len( CAML_VALUE arr ) {
CAMLparam1(arr);
if( Tag_val(arr) == C_array )
CAMLreturn(Wosize_val(Field(arr,0)));
else if( Tag_val(arr) == C_list )
CAMLreturn(caml_list_length(arr));
else
failwith("Need array or list");
}
#ifdef __cplusplus #ifdef __cplusplus
namespace caml { namespace caml {
extern "C" extern "C"
#endif #endif
value alloc(int,int); CAML_VALUE alloc(int,int);
#ifdef __cplusplus #ifdef __cplusplus
}; };
#endif #endif
SWIGSTATIC value caml_swig_alloc(int x,int y) { SWIGSTATIC CAML_VALUE caml_swig_alloc(int x,int y) {
#ifdef __cplusplus #ifdef __cplusplus
using namespace caml; using namespace caml;
#endif #endif
return alloc(x,y); return alloc(x,y);
} }
SWIGSTATIC value caml_array_new( int n ) {
CAMLparam0();
CAMLlocal1(vv);
vv = caml_swig_alloc(1,C_array);
Store_field(vv,0,alloc_tuple(n));
CAMLreturn(vv);
}
SWIGSTATIC value caml_val_bool( int b ) { SWIGSTATIC CAML_VALUE caml_val_bool( int b ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(bv); CAMLlocal1(bv);
bv = caml_swig_alloc(1,C_bool); bv = caml_swig_alloc(1,C_bool);
@ -232,7 +266,7 @@ extern "C" {
CAMLreturn(bv); CAMLreturn(bv);
} }
SWIGSTATIC value caml_val_char( char c ) { SWIGSTATIC CAML_VALUE caml_val_char( char c ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(cv); CAMLlocal1(cv);
cv = caml_swig_alloc(1,C_char); cv = caml_swig_alloc(1,C_char);
@ -240,7 +274,7 @@ extern "C" {
CAMLreturn(cv); CAMLreturn(cv);
} }
SWIGSTATIC value caml_val_uchar( unsigned char uc ) { SWIGSTATIC CAML_VALUE caml_val_uchar( unsigned char uc ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(ucv); CAMLlocal1(ucv);
ucv = caml_swig_alloc(1,C_uchar); ucv = caml_swig_alloc(1,C_uchar);
@ -248,7 +282,7 @@ extern "C" {
CAMLreturn(ucv); CAMLreturn(ucv);
} }
SWIGSTATIC value caml_val_short( short s ) { SWIGSTATIC CAML_VALUE caml_val_short( short s ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(sv); CAMLlocal1(sv);
sv = caml_swig_alloc(1,C_short); sv = caml_swig_alloc(1,C_short);
@ -256,7 +290,7 @@ extern "C" {
CAMLreturn(sv); CAMLreturn(sv);
} }
SWIGSTATIC value caml_val_ushort( unsigned short us ) { SWIGSTATIC CAML_VALUE caml_val_ushort( unsigned short us ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(usv); CAMLlocal1(usv);
usv = caml_swig_alloc(1,C_ushort); usv = caml_swig_alloc(1,C_ushort);
@ -264,7 +298,7 @@ extern "C" {
CAMLreturn(usv); CAMLreturn(usv);
} }
SWIGSTATIC value caml_val_int( int i ) { SWIGSTATIC CAML_VALUE caml_val_int( int i ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(iv); CAMLlocal1(iv);
iv = caml_swig_alloc(1,C_int); iv = caml_swig_alloc(1,C_int);
@ -272,7 +306,7 @@ extern "C" {
CAMLreturn(iv); CAMLreturn(iv);
} }
SWIGSTATIC value caml_val_uint( unsigned int ui ) { SWIGSTATIC CAML_VALUE caml_val_uint( unsigned int ui ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(uiv); CAMLlocal1(uiv);
uiv = caml_swig_alloc(1,C_int); uiv = caml_swig_alloc(1,C_int);
@ -280,7 +314,7 @@ extern "C" {
CAMLreturn(uiv); CAMLreturn(uiv);
} }
SWIGSTATIC value caml_val_long( long l ) { SWIGSTATIC CAML_VALUE caml_val_long( long l ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(lv); CAMLlocal1(lv);
lv = caml_swig_alloc(1,C_int64); lv = caml_swig_alloc(1,C_int64);
@ -288,7 +322,7 @@ extern "C" {
CAMLreturn(lv); CAMLreturn(lv);
} }
SWIGSTATIC value caml_val_ulong( unsigned long ul ) { SWIGSTATIC CAML_VALUE caml_val_ulong( unsigned long ul ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(ulv); CAMLlocal1(ulv);
ulv = caml_swig_alloc(1,C_int64); ulv = caml_swig_alloc(1,C_int64);
@ -296,7 +330,7 @@ extern "C" {
CAMLreturn(ulv); CAMLreturn(ulv);
} }
SWIGSTATIC value caml_val_float( float f ) { SWIGSTATIC CAML_VALUE caml_val_float( float f ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(fv); CAMLlocal1(fv);
fv = caml_swig_alloc(1,C_float); fv = caml_swig_alloc(1,C_float);
@ -304,7 +338,7 @@ extern "C" {
CAMLreturn(fv); CAMLreturn(fv);
} }
SWIGSTATIC value caml_val_double( double d ) { SWIGSTATIC CAML_VALUE caml_val_double( double d ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(fv); CAMLlocal1(fv);
fv = caml_swig_alloc(1,C_double); fv = caml_swig_alloc(1,C_double);
@ -312,7 +346,7 @@ extern "C" {
CAMLreturn(fv); CAMLreturn(fv);
} }
SWIGSTATIC value caml_val_ptr( void *p, swig_type_info *info ) { SWIGSTATIC CAML_VALUE caml_val_ptr( void *p, swig_type_info *info ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(vv); CAMLlocal1(vv);
vv = caml_swig_alloc(2,C_ptr); vv = caml_swig_alloc(2,C_ptr);
@ -321,7 +355,7 @@ extern "C" {
CAMLreturn(vv); CAMLreturn(vv);
} }
SWIGSTATIC value caml_val_string( const char *p ) { SWIGSTATIC CAML_VALUE caml_val_string( const char *p ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(vv); CAMLlocal1(vv);
if( !p ) CAMLreturn(caml_val_ptr( (void *)p, 0 )); if( !p ) CAMLreturn(caml_val_ptr( (void *)p, 0 ));
@ -330,7 +364,7 @@ extern "C" {
CAMLreturn(vv); CAMLreturn(vv);
} }
SWIGSTATIC value caml_val_string_len( const char *p, int len ) { SWIGSTATIC CAML_VALUE caml_val_string_len( const char *p, int len ) {
CAMLparam0(); CAMLparam0();
CAMLlocal1(vv); CAMLlocal1(vv);
if( !p || len < 0 ) CAMLreturn(caml_val_ptr( (void *)p, 0 )); if( !p || len < 0 ) CAMLreturn(caml_val_ptr( (void *)p, 0 ));
@ -340,14 +374,14 @@ extern "C" {
CAMLreturn(vv); CAMLreturn(vv);
} }
SWIGSTATIC value caml_val_obj( void *v, char *object_type ) { SWIGSTATIC CAML_VALUE caml_val_obj( void *v, char *object_type ) {
CAMLparam0(); CAMLparam0();
CAMLreturn(callback2(*caml_named_value("caml_create_object_fn"), CAMLreturn(callback2(*caml_named_value("caml_create_object_fn"),
caml_val_ptr(v,SWIG_TypeQuery(object_type)), caml_val_ptr(v,SWIG_TypeQuery(object_type)),
copy_string(object_type))); copy_string(object_type)));
} }
SWIGSTATIC long caml_long_val_full( value v, char *name ) { SWIGSTATIC long caml_long_val_full( CAML_VALUE v, char *name ) {
CAMLparam1(v); CAMLparam1(v);
if( !Is_block(v) ) return 0; if( !Is_block(v) ) return 0;
@ -373,7 +407,7 @@ extern "C" {
CAMLreturn((long)Int64_val(Field(Field(v,0),0))); CAMLreturn((long)Int64_val(Field(Field(v,0),0)));
case C_enum: { case C_enum: {
CAMLlocal1(ret); CAMLlocal1(ret);
value *enum_to_int = caml_named_value(SWIG_MODULE "_enum_to_int"); CAML_VALUE *enum_to_int = caml_named_value(SWIG_MODULE "_enum_to_int");
if( !name ) failwith( "Not an enum conversion" ); if( !name ) failwith( "Not an enum conversion" );
ret = callback2(*enum_to_int,*caml_named_value(name),v); ret = callback2(*enum_to_int,*caml_named_value(name),v);
CAMLreturn(caml_long_val(ret)); CAMLreturn(caml_long_val(ret));
@ -383,11 +417,11 @@ extern "C" {
} }
} }
SWIGSTATIC long caml_long_val( value v ) { SWIGSTATIC long caml_long_val( CAML_VALUE v ) {
return caml_long_val_full(v,0); return caml_long_val_full(v,0);
} }
SWIGSTATIC double caml_double_val( value v ) { SWIGSTATIC double caml_double_val( CAML_VALUE v ) {
CAMLparam1(v); CAMLparam1(v);
if( !Is_block(v) ) return 0.0; if( !Is_block(v) ) return 0.0;
switch( Tag_val(v) ) { switch( Tag_val(v) ) {
@ -412,7 +446,7 @@ extern "C" {
} }
} }
SWIGSTATIC int caml_ptr_val_internal( value v, void **out, SWIGSTATIC int caml_ptr_val_internal( CAML_VALUE v, void **out,
swig_type_info *descriptor ) { swig_type_info *descriptor ) {
CAMLparam1(v); CAMLparam1(v);
void *outptr = NULL; void *outptr = NULL;
@ -454,7 +488,7 @@ extern "C" {
CAMLreturn(SWIG_GetPtr(outptr,out,outdescr,descriptor)); CAMLreturn(SWIG_GetPtr(outptr,out,outdescr,descriptor));
} }
SWIGSTATIC void *caml_ptr_val( value v, swig_type_info *descriptor ) { SWIGSTATIC void *caml_ptr_val( CAML_VALUE v, swig_type_info *descriptor ) {
CAMLparam0(); CAMLparam0();
#ifdef TYPE_CAST_VERBOSE #ifdef TYPE_CAST_VERBOSE
caml_print_val( v ); caml_print_val( v );
@ -466,11 +500,11 @@ extern "C" {
failwith( "No appropriate conversion found." ); failwith( "No appropriate conversion found." );
} }
SWIGSTATIC char *caml_string_val( value v ) { SWIGSTATIC char *caml_string_val( CAML_VALUE v ) {
return (char *)caml_ptr_val( v, 0 ); return (char *)caml_ptr_val( v, 0 );
} }
SWIGSTATIC int caml_bool_check( value v ) { SWIGSTATIC int caml_bool_check( CAML_VALUE v ) {
CAMLparam1(v); CAMLparam1(v);
if( !Is_block(v) ) return 0; if( !Is_block(v) ) return 0;
@ -485,7 +519,7 @@ extern "C" {
} }
} }
SWIGSTATIC int caml_int_check( value v ) { SWIGSTATIC int caml_int_check( CAML_VALUE v ) {
CAMLparam1(v); CAMLparam1(v);
if( !Is_block(v) ) return 0; if( !Is_block(v) ) return 0;
@ -506,7 +540,7 @@ extern "C" {
} }
} }
SWIGSTATIC int caml_float_check( value v ) { SWIGSTATIC int caml_float_check( CAML_VALUE v ) {
CAMLparam1(v); CAMLparam1(v);
if( !Is_block(v) ) return 0; if( !Is_block(v) ) return 0;
@ -520,7 +554,7 @@ extern "C" {
} }
} }
SWIGSTATIC int caml_ptr_check( value v ) { SWIGSTATIC int caml_ptr_check( CAML_VALUE v ) {
CAMLparam1(v); CAMLparam1(v);
if( !Is_block(v) ) return 0; if( !Is_block(v) ) return 0;

81
Lib/ocaml/ocamldec.swg
View file

@ -17,6 +17,7 @@ SWIGEXT {
#define SWIGEXT #define SWIGEXT
#endif #endif
#define alloc caml_alloc #define alloc caml_alloc
#define value caml_value_t
#include <caml/alloc.h> #include <caml/alloc.h>
#include <caml/custom.h> #include <caml/custom.h>
#include <caml/mlvalues.h> #include <caml/mlvalues.h>
@ -25,6 +26,7 @@ SWIGEXT {
#include <caml/fail.h> #include <caml/fail.h>
#include <caml/misc.h> #include <caml/misc.h>
#undef alloc #undef alloc
#define CAML_VALUE value
#if defined(SWIG_NOINCLUDE) #if defined(SWIG_NOINCLUDE)
# define SWIGSTATIC # define SWIGSTATIC
@ -36,77 +38,56 @@ SWIGEXT {
#define __OCAML__SWIG__MAXVALUES 6 #define __OCAML__SWIG__MAXVALUES 6
static swig_type_info *swig_types[];
static swig_type_info *swig_types_initial[];
SWIGSTATIC int SWIGSTATIC int
SWIG_GetPtr(void *source, void **result, swig_type_info *type, swig_type_info *result_type); SWIG_GetPtr(void *source, void **result, swig_type_info *type, swig_type_info *result_type);
SWIGSTATIC void * SWIGSTATIC void *
SWIG_MustGetPtr (value v, swig_type_info *type); SWIG_MustGetPtr (CAML_VALUE v, swig_type_info *type);
static value _wrap_delete_void( value ); static CAML_VALUE _wrap_delete_void( CAML_VALUE );
static int enum_to_int( char *name, value v ); static int enum_to_int( char *name, CAML_VALUE v );
static value int_to_enum( char *name, int v ); static CAML_VALUE int_to_enum( char *name, int v );
static value caml_list_nth( value lst, int n ); static CAML_VALUE caml_list_nth( CAML_VALUE lst, int n );
static value caml_list_append( value lst, value elt ); static CAML_VALUE caml_list_append( CAML_VALUE lst, CAML_VALUE elt );
static int caml_list_length( value lst ); static int caml_list_length( CAML_VALUE lst );
static CAML_VALUE caml_array_new( int n );
static void caml_array_set( CAML_VALUE arr, int n, CAML_VALUE item );
static CAML_VALUE caml_array_nth( CAML_VALUE arr, int n );
static int caml_array_length( CAML_VALUE arr );
static value caml_val_char( char c ); static CAML_VALUE caml_val_char( char c );
static value caml_val_uchar( unsigned char c ); static CAML_VALUE caml_val_uchar( unsigned char c );
static value caml_val_short( short s ); static CAML_VALUE caml_val_short( short s );
static value caml_val_ushort( unsigned short s ); static CAML_VALUE caml_val_ushort( unsigned short s );
static value caml_val_int( int x ); static CAML_VALUE caml_val_int( int x );
static value caml_val_uint( unsigned int x ); static CAML_VALUE caml_val_uint( unsigned int x );
static value caml_val_long( long x ); static CAML_VALUE caml_val_long( long x );
static value caml_val_ulong( unsigned long x ); static CAML_VALUE caml_val_ulong( unsigned long x );
static value caml_val_float( float f ); static CAML_VALUE caml_val_float( float f );
static value caml_val_double( double d ); static CAML_VALUE caml_val_double( double d );
static value caml_val_ptr( void *p, swig_type_info *descriptor ); static CAML_VALUE caml_val_ptr( void *p, swig_type_info *descriptor );
static value caml_val_string( const char *str ); static CAML_VALUE caml_val_string( const char *str );
static value caml_val_string_len( const char *str, int len ); static CAML_VALUE caml_val_string_len( const char *str, int len );
static long caml_long_val( value v ); static long caml_long_val( CAML_VALUE v );
static double caml_double_val( value v ); static double caml_double_val( CAML_VALUE v );
static int caml_ptr_val_internal( value v, void **out, static int caml_ptr_val_internal( CAML_VALUE v, void **out,
swig_type_info *descriptor ); swig_type_info *descriptor );
static void *caml_ptr_val( value v, swig_type_info *descriptor ); static void *caml_ptr_val( CAML_VALUE v, swig_type_info *descriptor );
static char *caml_string_val( value v ); static char *caml_string_val( CAML_VALUE v );
#ifdef __cplusplus #ifdef __cplusplus
} }
template < class T > class SWIG_OCAML_ARRAY_WRAPPER {
public:
SWIG_OCAML_ARRAY_WRAPPER( T *t ) : t(t) { }
SWIG_OCAML_ARRAY_WRAPPER( T &t ) : t(&t) { }
SWIG_OCAML_ARRAY_WRAPPER( T t[] ) : t(&t[0]) { }
T &operator[]( int n ) { return t[n]; }
SWIG_OCAML_ARRAY_WRAPPER offset( int elts ) {
return SWIG_OCAML_ARRAY_WRAPPER( t + elts );
}
T *operator & () { return t; }
void own() { owned = true; }
void disown() { owned = false; }
~SWIG_OCAML_ARRAY_WRAPPER() {
if( owned ) delete t;
}
private:
T *t;
int owned;
};
#endif #endif
/* mzschemedec.swg ends here */ /* mzschemedec.swg ends here */

4
Lib/ocaml/std_common.i
View file

@ -8,10 +8,10 @@
%{ %{
#include <string> #include <string>
value SwigString_FromString(const std::string& s) { CAML_VALUE SwigString_FromString(const std::string& s) {
return caml_val_string((char *)s.c_str()); return caml_val_string((char *)s.c_str());
} }
std::string SwigString_AsString(value o) { std::string SwigString_AsString(CAML_VALUE o) {
return std::string((char *)caml_ptr_val(o,0)); return std::string((char *)caml_ptr_val(o,0));
} }
%} %}

2
Lib/ocaml/std_string.i
View file

@ -18,6 +18,8 @@
%{ %{
#include <string> #include <string>
#include <vector> #include <vector>
using std::string;
using std::vector;
%} %}
%include std_vector.i %include std_vector.i

196
Lib/ocaml/typemaps.i
View file

@ -11,74 +11,34 @@
/* Pointers */ /* Pointers */
%typemap(ocaml,in) void * { %typemap(in) void ""
%typemap(out) void "$result = Val_int(0);"
%typemap(in) void * {
$1 = caml_ptr_val($input,$descriptor); $1 = caml_ptr_val($input,$descriptor);
} }
%typemap(ocaml,varin) void * { %typemap(varin) void * {
$1 = ($ltype)caml_ptr_val($input,$descriptor); $1 = ($ltype)caml_ptr_val($input,$descriptor);
} }
%typemap(ocaml,in) char *, signed char *, unsigned char *, const char *, const signed char *, const unsigned char * { %typemap(out) void * {
$1 = ($ltype)caml_string_val($input);
}
%typemap(ocaml,varin) char *, signed char *, unsigned char *, const char *, const signed char *, const unsigned char * {
$1 = ($ltype)caml_string_val($input);
}
%typemap(ocaml,out) void * {
$result = caml_val_ptr($1,$descriptor); $result = caml_val_ptr($1,$descriptor);
} }
%typemap(ocaml,varout) void * { %typemap(varout) void * {
$result = caml_val_ptr($1,$descriptor); $result = caml_val_ptr($1,$descriptor);
} }
%typemap(ocaml,out) char *, signed char *, unsigned char *, const char *, const signed char *, const unsigned char * {
$result = caml_val_string($1);
}
%typemap(ocaml,varout) char *, signed char *, unsigned char *, const char *, const signed char *, const unsigned char * {
$result = caml_val_string($1);
}
%typemap(ocaml,in) SWIGTYPE * {
$1 = ($ltype)caml_ptr_val($input,$1_descriptor);
}
%typemap(ocaml,out) SWIGTYPE * {
value *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) {
$result = callback(*fromval,caml_val_ptr((void *)$1,$1_descriptor));
} else {
$result = caml_val_ptr ((void *)$1,$1_descriptor);
}
}
%typemap(ocaml,varin) SWIGTYPE * {
$1 = ($ltype)caml_ptr_val($input,$1_descriptor);
}
%typemap(ocaml,varout) SWIGTYPE * {
value *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) {
$result = callback(*fromval,caml_val_ptr((void *)$1,$1_descriptor));
} else {
$result = caml_val_ptr ((void *)$1,$1_descriptor);
}
}
/* C++ References */
#ifdef __cplusplus #ifdef __cplusplus
%typemap(ocaml,in) SWIGTYPE & { %typemap(in) SWIGTYPE & {
$1 = ($ltype) caml_ptr_val($input,$1_descriptor); $1 = ($ltype) caml_ptr_val($input,$1_descriptor);
} }
%typemap(ocaml,out) SWIGTYPE & { %typemap(out) SWIGTYPE & {
value *fromval = caml_named_value("create_$ntype_from_ptr"); CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) { if( fromval ) {
$result = callback(*fromval,caml_val_ptr((void *) $1,$1_descriptor)); $result = callback(*fromval,caml_val_ptr((void *) $1,$1_descriptor));
} else { } else {
@ -87,8 +47,8 @@
} }
#if 0 #if 0
%typemap(ocaml,argout) SWIGTYPE & { %typemap(argout) SWIGTYPE & {
value *fromval = caml_named_value("create_$ntype_from_ptr"); CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) { if( fromval ) {
swig_result = swig_result =
caml_list_append(swig_result, caml_list_append(swig_result,
@ -102,15 +62,15 @@
} }
#endif #endif
%typemap(ocaml,argout) const SWIGTYPE & { } %typemap(argout) const SWIGTYPE & { }
%typemap(ocaml,in) SWIGTYPE { %typemap(in) SWIGTYPE {
$1 = *(($&1_ltype) caml_ptr_val($input,$&1_descriptor)) ; $1 = *(($&1_ltype) caml_ptr_val($input,$&1_descriptor)) ;
} }
%typemap(ocaml,out) SWIGTYPE { %typemap(out) SWIGTYPE {
void *temp = new $ltype($1); void *temp = new $ltype($1);
value *fromval = caml_named_value("create_$ntype_from_ptr"); CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
*(($ltype *)temp) = $1; *(($ltype *)temp) = $1;
if( fromval ) { if( fromval ) {
$result = callback(*fromval,caml_val_ptr((void *)temp,$&1_descriptor)); $result = callback(*fromval,caml_val_ptr((void *)temp,$&1_descriptor));
@ -121,13 +81,13 @@
#else #else
%typemap(ocaml,in) SWIGTYPE { %typemap(in) SWIGTYPE {
$1 = *(($&1_ltype) caml_ptr_val($input,$&1_descriptor)) ; $1 = *(($&1_ltype) caml_ptr_val($input,$&1_descriptor)) ;
} }
%typemap(ocaml,out) SWIGTYPE { %typemap(out) SWIGTYPE {
void *temp = calloc(1,sizeof($ltype)); void *temp = calloc(1,sizeof($ltype));
value *fromval = caml_named_value("create_$ntype_from_ptr"); CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
*(($ltype *)temp) = $1; *(($ltype *)temp) = $1;
if( fromval ) { if( fromval ) {
$result = callback(*fromval,caml_val_ptr((void *)temp,$&1_descriptor)); $result = callback(*fromval,caml_val_ptr((void *)temp,$&1_descriptor));
@ -140,20 +100,6 @@
#endif #endif
/* Arrays */
/* Enums */
%typemap(ocaml,in) enum SWIGTYPE {
$1 = ($type)caml_long_val_full($input,"$type_marker");
}
%typemap(ocaml,varin) enum SWIGTYPE {
$1 = ($type)caml_long_val_full($input,"$type_marker");
}
%typemap(ocaml,out) enum SWIGTYPE "$result = callback2(*caml_named_value(SWIG_MODULE \"_int_to_enum\"),*caml_named_value(\"$type_marker\"),Val_int($1));"
%typemap(ocaml,varout) enum SWIGTYPE "$result = callback2(*caml_named_value(SWIG_MODULE \"_int_to_enum\"),*caml_named_value(\"$type_marker\"),Val_int($1));"
/* The SIMPLE_MAP macro below defines the whole set of typemaps needed /* The SIMPLE_MAP macro below defines the whole set of typemaps needed
for simple types. */ for simple types. */
@ -164,18 +110,12 @@
%typemap(varin) C_NAME { %typemap(varin) C_NAME {
$1 = MZ_TO_C($input); $1 = MZ_TO_C($input);
} }
%typemap(memberin) C_NAME {
$1 = MZ_TO_C($input);
}
%typemap(out) C_NAME { %typemap(out) C_NAME {
$result = C_TO_MZ($1); $result = C_TO_MZ($1);
} }
%typemap(varout) C_NAME { %typemap(varout) C_NAME {
$result = C_TO_MZ($1); $result = C_TO_MZ($1);
} }
%typemap(memberout) C_NAME {
$resunt = C_TO_MZ($1);
}
%typemap(in) C_NAME *INPUT ($*1_ltype temp) { %typemap(in) C_NAME *INPUT ($*1_ltype temp) {
temp = ($*1_ltype) MZ_TO_C($input); temp = ($*1_ltype) MZ_TO_C($input);
$1 = &temp; $1 = &temp;
@ -225,5 +165,97 @@ SIMPLE_MAP(unsigned long long,caml_val_ulong,caml_long_val);
/* Pass through value */ /* Pass through value */
%typemap (in) value "$1=$input;"; %typemap (in) value,caml::value,CAML_VALUE "$1=$input;";
%typemap (out) value "$result=$1;"; %typemap (out) value,caml::value,CAML_VALUE "$result=$1;";
/* Arrays */
%typemap(in) ArrayCarrier * {
$1 = ($ltype)caml_ptr_val($input,$1_descriptor);
}
%typemap(out) ArrayCarrier * {
CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) {
$result = callback(*fromval,caml_val_ptr((void *)$1,$1_descriptor));
} else {
$result = caml_val_ptr ((void *)$1,$1_descriptor);
}
}
#if 0
%include "carray.i"
#endif
/* Handle char arrays as strings */
%define %char_ptr_in(how)
%typemap(how) char *, signed char *, unsigned char * {
$1 = ($ltype)caml_string_val($input);
}
%typemap(how) char [ANY], signed char [ANY], unsigned char [ANY] {
char *temp = caml_string_val($input);
strncpy((char *)$1,temp,$1_dim0);
}
%enddef
%char_ptr_in(in);
%char_ptr_in(varin);
%char_ptr_in(outv);
%define %char_ptr_out(how)
%typemap(how)
char *, signed char *, unsigned char *,
const char *, const signed char *, const unsigned char * {
$result = caml_val_string((char *)$1);
}
%typemap(how)
char [ANY], signed char [ANY], unsigned char [ANY],
const char [ANY], const signed char [ANY], const unsigned char [ANY] {
$result = caml_val_string_len((char *)$1,(int)$1_size);
}
%enddef
%char_ptr_out(out);
%char_ptr_out(varout);
%char_ptr_out(invv);
%typemap(in) SWIGTYPE * {
$1 = ($ltype)caml_ptr_val($input,$1_descriptor);
}
%typemap(out) SWIGTYPE * {
CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) {
$result = callback(*fromval,caml_val_ptr((void *)$1,$1_descriptor));
} else {
$result = caml_val_ptr ((void *)$1,$1_descriptor);
}
}
%typemap(varin) SWIGTYPE * {
$1 = ($ltype)caml_ptr_val($input,$1_descriptor);
}
%typemap(varout) SWIGTYPE * {
CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) {
$result = callback(*fromval,caml_val_ptr((void *)$1,$1_descriptor));
} else {
$result = caml_val_ptr ((void *)$1,$1_descriptor);
}
}
/* C++ References */
/* Enums */
%typemap(in) enum SWIGTYPE {
$1 = ($type)caml_long_val_full($input,"$type_marker");
}
%typemap(varin) enum SWIGTYPE {
$1 = ($type)caml_long_val_full($input,"$type_marker");
}
%typemap(out) enum SWIGTYPE "$result = callback2(*caml_named_value(SWIG_MODULE \"_int_to_enum\"),*caml_named_value(\"$type_marker\"),Val_int($1));"
%typemap(varout) enum SWIGTYPE "$result = callback2(*caml_named_value(SWIG_MODULE \"_int_to_enum\"),*caml_named_value(\"$type_marker\"),Val_int($1));"

11
Lib/ocaml/typeregister.swg Normal file
View file

@ -0,0 +1,11 @@
/* Code ripped from python implementation */
{
static int typeinit = 0;
int i;
if (!typeinit) {
for (i = 0; swig_types_initial[i]; i++) {
swig_types[i] = SWIG_TypeRegister(swig_types_initial[i]);
}
typeinit = 1;
}
}

92
Source/Modules/ocaml.cxx
View file

@ -176,7 +176,7 @@ public:
} }
p = SwigType_str(type, name); p = SwigType_str(type, name);
Append(result,p); Append(result,p);
String* value = Getattr(parm, "value"); String* value = Getattr(parm, "CAML_VALUE");
if (values && (value != 0)) { if (values && (value != 0)) {
Printf(result, " = %s", value); Printf(result, " = %s", value);
} }
@ -363,7 +363,7 @@ public:
virtual int top(Node *n) { virtual int top(Node *n) {
/* Set comparison with none for ConstructorToFunction */ /* Set comparison with none for ConstructorToFunction */
SetNoneComparison( NewString( "$arg != Val_unit" ) ); SetNoneComparison( NewString( "argv[0] != Val_unit" ) );
/* check if directors are enabled for this module. note: this /* check if directors are enabled for this module. note: this
* is a "master" switch, without which no director code will be * is a "master" switch, without which no director code will be
@ -488,7 +488,7 @@ public:
module ); module );
Printf( f_mlibody, Printf( f_mlibody,
"val int_to_enum : c_enum_type -> int -> c_obj\n" ); "val int_to_enum : c_enum_type -> int -> c_obj\n" );
Printf( f_wrappers, Printf( f_init,
"SWIGEXT void f_%s_init() {\n" "SWIGEXT void f_%s_init() {\n"
"%s" "%s"
"}\n", "}\n",
@ -553,28 +553,43 @@ public:
*/ */
void oc_SwigType_del_reference(SwigType *t) { void oc_SwigType_del_reference(SwigType *t) {
char *c = Char(t); char *c = Char(t);
if (strncmp(c,"q(",2) == 0) { if (strncmp(c,"q(",2) == 0) {
Delete(SwigType_pop(t)); Delete(SwigType_pop(t));
c = Char(t); c = Char(t);
} }
if (strncmp(c,"r.",2)) { if (strncmp(c,"r.",2)) {
printf("Fatal error. SwigType_del_pointer applied to non-pointer.\n"); printf("Fatal error. SwigType_del_pointer applied to non-pointer.\n");
abort(); abort();
} }
Replace(t,"r.","", DOH_REPLACE_ANY | DOH_REPLACE_FIRST); Replace(t,"r.","", DOH_REPLACE_ANY | DOH_REPLACE_FIRST);
} }
void oc_SwigType_del_array(SwigType *t) {
char *c = Char(t);
if (strncmp(c,"q(",2) == 0) {
Delete(SwigType_pop(t));
c = Char(t);
}
if (strncmp(c,"a(",1)) {
Delete(SwigType_pop(t));
}
}
/* /*
* Return true iff T is a reference type * Return true iff T is a reference type
*/ */
int int
is_a_reference (SwigType *t) is_a_reference (SwigType *t) {
{
return SwigType_isreference(SwigType_typedef_resolve_all(t)); return SwigType_isreference(SwigType_typedef_resolve_all(t));
} }
int
is_an_array (SwigType *t) {
return SwigType_isarray(SwigType_typedef_resolve_all(t));
}
/* ------------------------------------------------------------ /* ------------------------------------------------------------
* functionWrapper() * functionWrapper()
* Create a function declaration and register it with the interpreter. * Create a function declaration and register it with the interpreter.
@ -678,8 +693,8 @@ public:
// writing the function wrapper function // writing the function wrapper function
Printv(f->def, Printv(f->def,
"SWIGEXT value ", wname, " (", NIL); "SWIGEXT CAML_VALUE ", wname, " (", NIL);
Printv(f->def, "value args", NIL); Printv(f->def, "CAML_VALUE args", NIL);
Printv(f->def, ")\n{", NIL); Printv(f->def, ")\n{", NIL);
/* Define the scheme name in C. This define is used by several /* Define the scheme name in C. This define is used by several
@ -692,11 +707,11 @@ public:
Wrapper_add_local(f, "_len", "int _len"); Wrapper_add_local(f, "_len", "int _len");
Wrapper_add_local(f, "lenv", "int lenv = 1"); Wrapper_add_local(f, "lenv", "int lenv = 1");
Wrapper_add_local(f, "argc", "int argc = caml_list_length(args)"); Wrapper_add_local(f, "argc", "int argc = caml_list_length(args)");
Wrapper_add_local(f, "argv", "value *argv"); Wrapper_add_local(f, "argv", "CAML_VALUE *argv");
Wrapper_add_local(f, "i" , "int i"); Wrapper_add_local(f, "i" , "int i");
Printv( f->code, Printv( f->code,
"argv = (value *)malloc( argc * sizeof( value ) );\n" "argv = (CAML_VALUE *)malloc( argc * sizeof( CAML_VALUE ) );\n"
"for( i = 0; i < argc; i++ ) {\n" "for( i = 0; i < argc; i++ ) {\n"
" argv[i] = caml_list_nth(args,i);\n" " argv[i] = caml_list_nth(args,i);\n"
"}\n", NIL ); "}\n", NIL );
@ -706,6 +721,7 @@ public:
// they are called arg0, arg1, ... // they are called arg0, arg1, ...
// the return value is called result // the return value is called result
d = SwigType_typedef_qualified(d);
emit_args(d, l, f); emit_args(d, l, f);
/* Attach the standard typemaps */ /* Attach the standard typemaps */
@ -727,6 +743,7 @@ public:
SwigType *pt = Getattr(p,"type"); SwigType *pt = Getattr(p,"type");
String *ln = Getattr(p,"lname"); String *ln = Getattr(p,"lname");
pt = SwigType_typedef_qualified(pt);
// Produce names of source and target // Produce names of source and target
Clear(source); Clear(source);
@ -895,15 +912,15 @@ public:
"free(argv);\nCAMLreturn(%s(args));\n", "free(argv);\nCAMLreturn(%s(args));\n",
&maxargs); &maxargs);
Wrapper_add_local(df, "argv", "value *argv"); Wrapper_add_local(df, "argv", "CAML_VALUE *argv");
Printv(df->def, Printv(df->def,
"SWIGEXT value ",dname,"(value args) {\n" "SWIGEXT CAML_VALUE ",dname,"(CAML_VALUE args) {\n"
" CAMLparam1(args);\n" " CAMLparam1(args);\n"
" int i;\n" " int i;\n"
" int argc = caml_list_length(args);\n",NIL); " int argc = caml_list_length(args);\n",NIL);
Printv( df->code, Printv( df->code,
"argv = (value *)malloc( argc * sizeof( value ) );\n" "argv = (CAML_VALUE *)malloc( argc * sizeof( CAML_VALUE ) );\n"
"for( i = 0; i < argc; i++ ) {\n" "for( i = 0; i < argc; i++ ) {\n"
" argv[i] = caml_list_nth(args,i);\n" " argv[i] = caml_list_nth(args,i);\n"
"}\n", NIL ); "}\n", NIL );
@ -991,10 +1008,10 @@ public:
if ((SwigType_type(t) != T_USER) || (is_a_pointer(t))) { if ((SwigType_type(t) != T_USER) || (is_a_pointer(t))) {
Printf (f->def, Printf (f->def,
"SWIGEXT value %s(value args) {\n", var_name); "SWIGEXT CAML_VALUE %s(CAML_VALUE args) {\n", var_name);
// Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL); // Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL);
Wrapper_add_local (f, "swig_result", "value swig_result"); Wrapper_add_local (f, "swig_result", "CAML_VALUE swig_result");
if (!Getattr(n,"feature:immutable")) { if (!Getattr(n,"feature:immutable")) {
/* Check for a setting of the variable value */ /* Check for a setting of the variable value */
@ -1291,26 +1308,29 @@ public:
name ); name );
String *name_normalized = normalizeTemplatedClassName(name); String *name_normalized = normalizeTemplatedClassName(name);
Printf( f_class_ctors, Printf( f_class_ctors,
"let _ = Callback.register \"create_%s_from_ptr\" " "let _ = Callback.register \"create_%s_from_ptr\" "
"create_%s_from_ptr\n", "create_%s_from_ptr\n",
name_normalized, classname ); name_normalized, classname );
Setattr(n,"ocaml:ctor",classname); Setattr(n,"ocaml:ctor",classname);
return rv; return rv;
} }
String *normalizeTemplatedClassName( String *name ) { String *normalizeTemplatedClassName( String *name ) {
String *name_normalized = SwigType_typedef_resolve_all(name); String *name_normalized = SwigType_typedef_resolve_all(name);
if( is_a_pointer(name_normalized) ) if( is_a_pointer(name_normalized) )
SwigType_del_pointer( name_normalized ); SwigType_del_pointer( name_normalized );
if( is_a_reference(name_normalized) ) if( is_a_reference(name_normalized) )
oc_SwigType_del_reference( name_normalized ); oc_SwigType_del_reference( name_normalized );
if( is_an_array(name_normalized) )
oc_SwigType_del_array( name_normalized );
Replaceall(name_normalized,"(",""); Replaceall(name_normalized,"(","");
Replaceall(name_normalized,")",""); Replaceall(name_normalized,")","");
return name_normalized; return name_normalized;
@ -1551,7 +1571,7 @@ public:
if (target) { if (target) {
String *director = NewStringf("director_%s", mangle); String *director = NewStringf("director_%s", mangle);
Wrapper_add_localv(w, director, "__DIRECTOR__ *", director, "= 0", NIL); Wrapper_add_localv(w, director, "__DIRECTOR__ *", director, "= 0", NIL);
Wrapper_add_localv(w, source, "value", source, "= Val_unit", NIL); Wrapper_add_localv(w, source, "CAML_VALUE", source, "= Val_unit", NIL);
Printf(wrap_args, "%s = dynamic_cast<__DIRECTOR__*>(%s);\n", director, nonconst); Printf(wrap_args, "%s = dynamic_cast<__DIRECTOR__*>(%s);\n", director, nonconst);
Printf(wrap_args, "if (!%s) {\n", director); Printf(wrap_args, "if (!%s) {\n", director);
Printf(wrap_args, "%s = SWIG_NewPointerObj(%s, SWIGTYPE%s, 0);\n", source, nonconst, mangle); Printf(wrap_args, "%s = SWIG_NewPointerObj(%s, SWIGTYPE%s, 0);\n", source, nonconst, mangle);
@ -1562,7 +1582,7 @@ public:
Delete(director); Delete(director);
Printv(arglist, source, NIL); Printv(arglist, source, NIL);
} else { } else {
Wrapper_add_localv(w, source, "value", source, "= Val_unit", NIL); Wrapper_add_localv(w, source, "CAML_VALUE", source, "= Val_unit", NIL);
Printf(wrap_args, "%s = SWIG_NewPointerObj(%s, SWIGTYPE%s, 0);\n", Printf(wrap_args, "%s = SWIG_NewPointerObj(%s, SWIGTYPE%s, 0);\n",
source, nonconst, mangle); source, nonconst, mangle);
//Printf(wrap_args, "%s = SWIG_NewPointerObj(%s, SWIGTYPE_p_%s, 0);\n", //Printf(wrap_args, "%s = SWIG_NewPointerObj(%s, SWIGTYPE_p_%s, 0);\n",
@ -1621,7 +1641,7 @@ public:
} }
if ((tm) && Len(tm) && (Strcmp(tm, "1") != 0)) { if ((tm) && Len(tm) && (Strcmp(tm, "1") != 0)) {
Printf(w->code, "if (result == NULL) {\n"); Printf(w->code, "if (result == NULL) {\n");
Printf(w->code, " value error = *caml_named_value(\"director_except\");\n"); Printf(w->code, " CAML_VALUE error = *caml_named_value(\"director_except\");\n");
Replaceall(tm, "$error", "error"); Replaceall(tm, "$error", "error");
Printv(w->code, Str(tm), "\n", NIL); Printv(w->code, Str(tm), "\n", NIL);
Printf(w->code, "}\n"); Printf(w->code, "}\n");
@ -1734,7 +1754,7 @@ public:
ParmList *superparms = CopyParmList(Getattr(n, "parms")); ParmList *superparms = CopyParmList(Getattr(n, "parms"));
ParmList *parms_in_declaration = CopyParmList(superparms); ParmList *parms_in_declaration = CopyParmList(superparms);
ParmList *parms_in_definition = CopyParmList(superparms); ParmList *parms_in_definition = CopyParmList(superparms);
String *type = NewString("value"); String *type = NewString("CAML_VALUE");
p = NewParm(type, NewString("self")); p = NewParm(type, NewString("self"));
set_nextSibling(p, parms_in_definition); set_nextSibling(p, parms_in_definition);
@ -1746,7 +1766,7 @@ public:
for (ip = parms_in_declaration; nextSibling(ip); ) ip = nextSibling(ip); for (ip = parms_in_declaration; nextSibling(ip); ) ip = nextSibling(ip);
p = NewParm(NewString("int"), NewString("__disown")); p = NewParm(NewString("int"), NewString("__disown"));
Setattr(p, "value", "1"); Setattr(p, "CAML_VALUE", "1");
set_nextSibling(ip, p); set_nextSibling(ip, p);
/* constructor */ /* constructor */
@ -1793,11 +1813,11 @@ public:
classname = Swig_class_name(n); classname = Swig_class_name(n);
{ {
Wrapper *w = NewWrapper(); Wrapper *w = NewWrapper();
Printf(w->def, "__DIRECTOR__%s::__DIRECTOR__%s(value self, int __disown): __DIRECTOR__(self, __disown) { }", classname, classname); Printf(w->def, "__DIRECTOR__%s::__DIRECTOR__%s(CAML_VALUE self, int __disown): __DIRECTOR__(self, __disown) { }", classname, classname);
Wrapper_print(w, f_directors); Wrapper_print(w, f_directors);
DelWrapper(w); DelWrapper(w);
} }
Printf(f_directors_h, " __DIRECTOR__%s(value self, int __disown = 1);\n", classname); Printf(f_directors_h, " __DIRECTOR__%s(CAML_VALUE self, int __disown = 1);\n", classname);
Delete(classname); Delete(classname);
return Language::classDirectorDefaultConstructor(n); return Language::classDirectorDefaultConstructor(n);
} }