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

Merge pull request #1474 from ZackerySpytz/OCaml-INPUT-OUTPUT-INOUT-primitives

Browse source 
[OCaml] Add missing INPUT, OUTPUT, and INOUT typemaps for primitives
This commit is contained in:
Zackery Spytz 2019-05-13 21:44:02 -06:00 • committed by GitHub
commit f042543c6f
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
10 changed files with 972 additions and 916 deletions
Download patch file Download diff file Expand all files Collapse all files

6
Examples/test-suite/multivalue.i
View file

@ -26,6 +26,11 @@ void divide_v(int a, int b, int *OUTPUT, int *OUTPUT);
void divide_mv(int a, int b, int *OUTPUT, int *OUTPUT);
#else
%include "typemaps.i"
void divide_l(int a, int b, int *OUTPUT, int *OUTPUT);
void divide_v(int a, int b, int *OUTPUT, int *OUTPUT);
void divide_mv(int a, int b, int *OUTPUT, int *OUTPUT);
#endif
%{
@ -49,4 +54,3 @@ void divide_mv(int a, int b, int *quotient_p, int *remainder_p)
}
%}

6
Examples/test-suite/ocaml/Makefile.in
View file

@ -34,6 +34,12 @@ FAILING_C_TESTS = \
enums \
preproc_constants_c \
CPP_TEST_CASES += \
inout \
C_TEST_CASES += \
multivalue \
ml_runme = $(SCRIPTPREFIX)$*$(SCRIPTSUFFIX)
run_testcase = \

8
Examples/test-suite/ocaml/inout_runme.ml Normal file
View file

@ -0,0 +1,8 @@
open Swig
open Inout
let _ =
assert (_AddOne1 '(1.) as float = 2.);
assert (_AddOne3 '(1, 1, 1) = C_list ['2.;'2.;'2.]);
assert (_AddOne1r '(1.) as float = 2.);
;;

8
Examples/test-suite/ocaml/multivalue_runme.ml Normal file
View file

@ -0,0 +1,8 @@
open Swig
open Multivalue
let _ =
assert (_divide_l '(37, 5) = C_list ['7;'2]);
assert (_divide_v '(41, 7) = C_list ['5;'6]);
assert (_divide_mv '(91, 13) = C_list ['7;'0]);
;;

10
Lib/ocaml/ocaml.i
View file

@ -8,7 +8,7 @@
%insert(runtime) "swigrun.swg"
/* Include headers */
%insert(runtime) "ocamldec.swg"
%insert(runtime) "ocamlrundec.swg"
/* Type registration */
%insert(init) "swiginit.swg"
@ -28,18 +28,14 @@
%}
/*#ifndef SWIG_NOINCLUDE*/
%insert(runtime) "ocaml.swg"
%insert(runtime) "ocamlrun.swg"
/*#endif*/
%insert(classtemplate) "class.swg"
/* Definitions */
#define SWIG_malloc(size) swig_malloc(size, FUNC_NAME)
#define SWIG_free(mem) free(mem)
/* Read in standard typemaps. */
%include <swig.swg>
%include <typemaps.i>
%include <ocaml.swg>
%include <typecheck.i>
%include <exception.i>
%include <preamble.swg>

894
Lib/ocaml/ocaml.swg
View file

@ -1,607 +1,311 @@
/* -*-c-*- */
/* -----------------------------------------------------------------------------
* ocaml.swg
*
* The Ocaml module handles all types uniformly via typemaps. Here
* are the definitions.
* ----------------------------------------------------------------------------- */
/* SWIG pointer structure */
/* Pointers */
#include <string.h>
#include <assert.h>
%typemap(in) void ""
#ifdef __cplusplus
extern "C" {
#endif
%typemap(out) void "$result = Val_int(0);"
#define C_bool 0
#define C_char 1
#define C_uchar 2
#define C_short 3
#define C_ushort 4
#define C_int 5
#define C_uint 6
#define C_int32 7
#define C_int64 8
#define C_float 9
#define C_double 10
#define C_ptr 11
#define C_array 12
#define C_list 13
#define C_obj 14
#define C_string 15
#define C_enum 16
#define C_director_core 17
%typemap(in) void * {
$1 = caml_ptr_val($input,$descriptor);
}
%typemap(varin) void * {
$1 = ($ltype)caml_ptr_val($input,$descriptor);
}
/* Cast a pointer if possible; returns 1 if successful */
SWIGINTERN int
SWIG_Cast (void *source, swig_type_info *source_type,
void **ptr, swig_type_info *dest_type)
{
if( !source ) { /* Special case for NULL. This is a popular question
for other modules on the list, so I want an easy way out... */
*ptr = 0;
return 0;
}
%typemap(out) void * {
$result = caml_val_ptr($1,$descriptor);
}
#ifdef TYPE_CAST_VERBOSE
fprintf( stderr, "Trying to cast %s to %s\n",
source_type ? source_type->str : "<none>",
dest_type ? dest_type->str : "<none>" );
#endif
if (dest_type != source_type) {
/* We have a type mismatch. Will have to look through our type
mapping table to figure out whether or not we can accept this
datatype.
--
Ignore typechecks for void *. Allow any conversion. */
if( !dest_type || !source_type ||
!strcmp(dest_type->name,"_p_void") ||
!strcmp(source_type->name,"_p_void") ) {
*ptr = source;
return 0;
} else {
swig_cast_info *tc =
SWIG_TypeCheckStruct(source_type, dest_type );
#ifdef TYPE_CAST_VERBOSE
fprintf( stderr, "Typecheck -> %s\n",
tc ? tc->type->str : "<none>" );
#endif
if( tc ) {
int newmemory = 0;
*ptr = SWIG_TypeCast(tc, source, &newmemory);
assert(!newmemory); /* newmemory handling not yet implemented */
return 0;
} else
return -1;
}
} else {
*ptr = source;
return 0;
}
%typemap(varout) void * {
$result = caml_val_ptr($1,$descriptor);
}
%typemap(in) char *& (char *temp) {
temp = (char*)caml_val_ptr($1,$descriptor);
$1 = &temp;
}
%typemap(argout) char *& {
swig_result = caml_list_append(swig_result,caml_val_string_len(*$1, strlen(*$1)));
}
%typemap(in) SWIGTYPE & {
$1 = ($ltype) caml_ptr_val($input,$1_descriptor);
}
%typemap(in) SWIGTYPE && {
$1 = ($ltype) caml_ptr_val($input,$1_descriptor);
}
%typemap(varin) SWIGTYPE & {
$1 = *(($ltype) caml_ptr_val($input,$1_descriptor));
}
%typemap(varin) SWIGTYPE && {
$1 = *(($ltype) caml_ptr_val($input,$1_descriptor));
}
%typemap(varout) SWIGTYPE &, SWIGTYPE && {
$result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)&$1, $1_descriptor);
}
%typemap(out) SWIGTYPE &, SWIGTYPE && {
$result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)$1, $1_descriptor);
}
#if 0
%typemap(argout) SWIGTYPE & {
CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) {
swig_result =
caml_list_append(swig_result,
caml_callback(*fromval,caml_val_ptr((void *) $1,
$1_descriptor)));
} else {
swig_result =
caml_list_append(swig_result,
caml_val_ptr ((void *) $1,$1_descriptor));
}
/* Return 0 if successful. */
SWIGINTERN int
SWIG_GetPtr(void *inptr, void **outptr,
swig_type_info *intype, swig_type_info *outtype) {
if (intype) {
return SWIG_Cast(inptr, intype,
outptr, outtype) == -1;
} else {
*outptr = inptr;
return 0;
}
}
%typemap(argout) SWIGTYPE && {
CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) {
swig_result =
caml_list_append(swig_result,
caml_callback(*fromval,caml_val_ptr((void *) $1,
$1_descriptor)));
} else {
swig_result =
caml_list_append(swig_result,
caml_val_ptr ((void *) $1,$1_descriptor));
}
SWIGINTERN void caml_print_list( CAML_VALUE v );
SWIGINTERN void caml_print_val( CAML_VALUE v ) {
switch( SWIG_Tag_val(v) ) {
case C_bool:
if( Bool_val(SWIG_Field(v,0)) ) fprintf( stderr, "true " );
else fprintf( stderr, "false " );
break;
case C_char:
case C_uchar:
fprintf( stderr, "'%c' (\\%03d) ",
(Int_val(SWIG_Field(v,0)) >= ' ' &&
Int_val(SWIG_Field(v,0)) < 127) ? Int_val(SWIG_Field(v,0)) : '.',
Int_val(SWIG_Field(v,0)) );
break;
case C_short:
case C_ushort:
case C_int:
fprintf( stderr, "%d ", (int)caml_long_val(v) );
break;
case C_uint:
case C_int32:
fprintf( stderr, "%ud ", (unsigned int)caml_long_val(v) );
break;
case C_int64:
fprintf( stderr, "%ld ", caml_long_val(v) );
break;
case C_float:
case C_double:
fprintf( stderr, "%f ", caml_double_val(v) );
break;
case C_ptr:
{
void *vout = 0;
swig_type_info *ty = (swig_type_info *)(long)SWIG_Int64_val(SWIG_Field(v,1));
caml_ptr_val_internal(v,&vout,0);
fprintf( stderr, "PTR(%p,%s) ",
vout,
ty ? ty->name : "(null)" );
}
break;
case C_array:
{
unsigned int i;
for( i = 0; i < Wosize_val( SWIG_Field(v,0) ); i++ )
caml_print_val( SWIG_Field(SWIG_Field(v,0),i) );
}
break;
case C_list:
caml_print_list( SWIG_Field(v,0) );
break;
case C_obj:
fprintf( stderr, "OBJ(%p) ", (void *)SWIG_Field(v,0) );
break;
case C_string:
{
void *cout;
caml_ptr_val_internal(v,&cout,0);
fprintf( stderr, "'%s' ", (char *)cout );
}
break;
}
}
SWIGINTERN void caml_print_list( CAML_VALUE v ) {
CAMLparam1(v);
while( v && Is_block(v) ) {
fprintf( stderr, "[ " );
caml_print_val( SWIG_Field(v,0) );
fprintf( stderr, "]\n" );
v = SWIG_Field(v,1);
}
CAMLreturn0;
}
SWIGINTERN CAML_VALUE caml_list_nth( CAML_VALUE lst, int n ) {
CAMLparam1(lst);
int i = 0;
while( i < n && lst && Is_block(lst) ) {
i++; lst = SWIG_Field(lst,1);
}
if( lst == Val_unit ) CAMLreturn(Val_unit);
else CAMLreturn(SWIG_Field(lst,0));
}
SWIGINTERN CAML_VALUE caml_list_append( CAML_VALUE lst, CAML_VALUE elt ) {
CAMLparam2(lst,elt);
SWIG_CAMLlocal3(v,vt,lh);
lh = Val_unit;
v = Val_unit;
/* Appending C_void should have no effect */
if( !Is_block(elt) ) return lst;
while( lst && Is_block(lst) ) {
if( v && v != Val_unit ) {
vt = caml_alloc_tuple(2);
SWIG_Store_field(v,1,vt);
v = vt;
} else {
v = lh = caml_alloc_tuple(2);
}
SWIG_Store_field(v,0,SWIG_Field(lst,0));
lst = SWIG_Field(lst,1);
}
if( v && Is_block(v) ) {
vt = caml_alloc_tuple(2);
SWIG_Store_field(v,1,vt);
v = vt;
} else {
v = lh = caml_alloc_tuple(2);
}
SWIG_Store_field(v,0,elt);
SWIG_Store_field(v,1,Val_unit);
CAMLreturn(lh);
}
SWIGINTERN int caml_list_length( CAML_VALUE lst ) {
CAMLparam1(lst);
int i = 0;
while( lst && Is_block(lst) ) { i++; lst = SWIG_Field(lst,1); }
CAMLreturn(i);
}
SWIGINTERN void caml_array_set( CAML_VALUE arr, int n, CAML_VALUE item ) {
CAMLparam2(arr,item);
SWIG_Store_field(SWIG_Field(arr,0),n,item);
CAMLreturn0;
}
SWIGINTERN value caml_array_nth( CAML_VALUE arr, int n ) {
CAMLparam1(arr);
if( SWIG_Tag_val(arr) == C_array )
CAMLreturn(SWIG_Field(SWIG_Field(arr,0),n));
else if( SWIG_Tag_val(arr) == C_list )
CAMLreturn(caml_list_nth(arr,0));
else
caml_failwith("Need array or list");
}
SWIGINTERN int caml_array_len( CAML_VALUE arr ) {
CAMLparam1(arr);
if( SWIG_Tag_val(arr) == C_array )
CAMLreturn(Wosize_val(SWIG_Field(arr,0)));
else if( SWIG_Tag_val(arr) == C_list )
CAMLreturn(caml_list_length(arr));
else
caml_failwith("Need array or list");
}
SWIGINTERN CAML_VALUE caml_swig_alloc(int x,int y) {
return caml_alloc(x,y);
}
SWIGINTERN value caml_array_new( int n ) {
CAMLparam0();
SWIG_CAMLlocal1(vv);
vv = caml_swig_alloc(1,C_array);
SWIG_Store_field(vv,0,caml_alloc_tuple(n));
CAMLreturn(vv);
}
SWIGINTERN CAML_VALUE caml_val_bool( int b ) {
CAMLparam0();
SWIG_CAMLlocal1(bv);
bv = caml_swig_alloc(1,C_bool);
SWIG_Store_field(bv,0,Val_bool(b));
CAMLreturn(bv);
}
SWIGINTERN CAML_VALUE caml_val_char( char c ) {
CAMLparam0();
SWIG_CAMLlocal1(cv);
cv = caml_swig_alloc(1,C_char);
SWIG_Store_field(cv,0,Val_int(c));
CAMLreturn(cv);
}
SWIGINTERN CAML_VALUE caml_val_uchar( unsigned char uc ) {
CAMLparam0();
SWIG_CAMLlocal1(ucv);
ucv = caml_swig_alloc(1,C_uchar);
SWIG_Store_field(ucv,0,Val_int(uc));
CAMLreturn(ucv);
}
SWIGINTERN CAML_VALUE caml_val_short( short s ) {
CAMLparam0();
SWIG_CAMLlocal1(sv);
sv = caml_swig_alloc(1,C_short);
SWIG_Store_field(sv,0,Val_int(s));
CAMLreturn(sv);
}
SWIGINTERN CAML_VALUE caml_val_ushort( unsigned short us ) {
CAMLparam0();
SWIG_CAMLlocal1(usv);
usv = caml_swig_alloc(1,C_ushort);
SWIG_Store_field(usv,0,Val_int(us));
CAMLreturn(usv);
}
SWIGINTERN CAML_VALUE caml_val_int( int i ) {
CAMLparam0();
SWIG_CAMLlocal1(iv);
iv = caml_swig_alloc(1,C_int);
SWIG_Store_field(iv,0,Val_int(i));
CAMLreturn(iv);
}
SWIGINTERN CAML_VALUE caml_val_uint( unsigned int ui ) {
CAMLparam0();
SWIG_CAMLlocal1(uiv);
uiv = caml_swig_alloc(1,C_int);
SWIG_Store_field(uiv,0,Val_int(ui));
CAMLreturn(uiv);
}
SWIGINTERN CAML_VALUE caml_val_long( long l ) {
CAMLparam0();
SWIG_CAMLlocal1(lv);
lv = caml_swig_alloc(1,C_int64);
SWIG_Store_field(lv,0,caml_copy_int64(l));
CAMLreturn(lv);
}
SWIGINTERN CAML_VALUE caml_val_ulong( unsigned long ul ) {
CAMLparam0();
SWIG_CAMLlocal1(ulv);
ulv = caml_swig_alloc(1,C_int64);
SWIG_Store_field(ulv,0,caml_copy_int64(ul));
CAMLreturn(ulv);
}
SWIGINTERN CAML_VALUE caml_val_float( float f ) {
CAMLparam0();
SWIG_CAMLlocal1(fv);
fv = caml_swig_alloc(1,C_float);
SWIG_Store_field(fv,0,caml_copy_double((double)f));
CAMLreturn(fv);
}
SWIGINTERN CAML_VALUE caml_val_double( double d ) {
CAMLparam0();
SWIG_CAMLlocal1(fv);
fv = caml_swig_alloc(1,C_double);
SWIG_Store_field(fv,0,caml_copy_double(d));
CAMLreturn(fv);
}
SWIGINTERN CAML_VALUE caml_val_ptr( void *p, swig_type_info *info ) {
CAMLparam0();
SWIG_CAMLlocal1(vv);
vv = caml_swig_alloc(2,C_ptr);
SWIG_Store_field(vv,0,caml_copy_int64((long)p));
SWIG_Store_field(vv,1,caml_copy_int64((long)info));
CAMLreturn(vv);
}
SWIGINTERN CAML_VALUE caml_val_string( const char *p ) {
CAMLparam0();
SWIG_CAMLlocal1(vv);
if( !p ) CAMLreturn(caml_val_ptr( (void *)p, 0 ));
vv = caml_swig_alloc(1,C_string);
SWIG_Store_field(vv,0,caml_copy_string(p));
CAMLreturn(vv);
}
SWIGINTERN CAML_VALUE caml_val_string_len( const char *p, int len ) {
CAMLparam0();
SWIG_CAMLlocal1(vv);
if( !p || len < 0 ) CAMLreturn(caml_val_ptr( (void *)p, 0 ));
vv = caml_swig_alloc(1,C_string);
SWIG_Store_field(vv,0,caml_alloc_string(len));
memcpy(String_val(SWIG_Field(vv,0)),p,len);
CAMLreturn(vv);
}
#define caml_val_obj(v, name) caml_val_obj_helper(v, SWIG_TypeQuery((name)), name)
SWIGINTERN CAML_VALUE caml_val_obj_helper( void *v, swig_type_info *type, char *name) {
CAMLparam0();
CAMLreturn(caml_callback2(*caml_named_value("caml_create_object_fn"),
caml_val_ptr(v,type),
caml_copy_string(name)));
}
SWIGINTERN long caml_long_val_full( CAML_VALUE v, const char *name ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( SWIG_Tag_val(v) ) {
case C_bool:
case C_char:
case C_uchar:
case C_short:
case C_ushort:
case C_int:
CAMLreturn(Int_val(SWIG_Field(v,0)));
case C_uint:
case C_int32:
CAMLreturn(Int32_val(SWIG_Field(v,0)));
case C_int64:
CAMLreturn((long)SWIG_Int64_val(SWIG_Field(v,0)));
case C_float:
case C_double:
CAMLreturn((long)Double_val(SWIG_Field(v,0)));
case C_string:
CAMLreturn((long)String_val(SWIG_Field(v,0)));
case C_ptr:
CAMLreturn((long)SWIG_Int64_val(SWIG_Field(SWIG_Field(v,0),0)));
case C_enum: {
SWIG_CAMLlocal1(ret);
CAML_VALUE *enum_to_int = caml_named_value(SWIG_MODULE "_enum_to_int");
if( !name ) caml_failwith( "Not an enum conversion" );
ret = caml_callback2(*enum_to_int,*caml_named_value(name),v);
CAMLreturn(caml_long_val(ret));
}
default:
caml_failwith("No conversion to int");
}
}
SWIGINTERN long caml_long_val( CAML_VALUE v ) {
return caml_long_val_full(v,0);
}
SWIGINTERN double caml_double_val( CAML_VALUE v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0.0;
switch( SWIG_Tag_val(v) ) {
case C_bool:
case C_char:
case C_uchar:
case C_short:
case C_ushort:
case C_int:
CAMLreturn_type(Int_val(SWIG_Field(v,0)));
case C_uint:
case C_int32:
CAMLreturn_type(Int32_val(SWIG_Field(v,0)));
case C_int64:
CAMLreturn_type(SWIG_Int64_val(SWIG_Field(v,0)));
case C_float:
case C_double:
CAMLreturn_type(Double_val(SWIG_Field(v,0)));
default:
fprintf( stderr, "Unknown block tag %d\n", SWIG_Tag_val(v) );
caml_failwith("No conversion to double");
}
}
SWIGINTERN int caml_ptr_val_internal( CAML_VALUE v, void **out,
swig_type_info *descriptor ) {
CAMLparam1(v);
void *outptr = NULL;
swig_type_info *outdescr = NULL;
static CAML_VALUE *func_val = NULL;
if( v == Val_unit ) {
*out = 0;
CAMLreturn_type(0);
}
if( !Is_block(v) ) return -1;
switch( SWIG_Tag_val(v) ) {
case C_obj:
if (!func_val) {
func_val = caml_named_value("caml_obj_ptr");
}
CAMLreturn_type(caml_ptr_val_internal(caml_callback(*func_val, v), out, descriptor));
case C_string:
outptr = (void *)String_val(SWIG_Field(v,0));
break;
case C_ptr:
outptr = (void *)(long)SWIG_Int64_val(SWIG_Field(v,0));
outdescr = (swig_type_info *)(long)SWIG_Int64_val(SWIG_Field(v,1));
break;
default:
*out = 0;
CAMLreturn_type(1);
break;
}
CAMLreturn_type(SWIG_GetPtr(outptr, out, outdescr, descriptor));
}
SWIGINTERN void *caml_ptr_val( CAML_VALUE v, swig_type_info *descriptor ) {
CAMLparam0();
#ifdef TYPE_CAST_VERBOSE
caml_print_val( v );
#endif
void *out = NULL;
if( !caml_ptr_val_internal( v, &out, descriptor ) )
CAMLreturn_type(out);
else
caml_failwith( "No appropriate conversion found." );
}
SWIGINTERN char *caml_string_val( CAML_VALUE v ) {
return (char *)caml_ptr_val( v, 0 );
}
SWIGINTERN int caml_string_len( CAML_VALUE v ) {
switch( SWIG_Tag_val(v) ) {
case C_string:
return caml_string_length(SWIG_Field(v,0));
default:
return strlen((char *)caml_ptr_val(v,0));
}
}
SWIGINTERN int caml_bool_check( CAML_VALUE v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( SWIG_Tag_val(v) ) {
case C_bool:
case C_ptr:
case C_string:
CAMLreturn(1);
default:
CAMLreturn(0);
}
}
SWIGINTERN int caml_int_check( CAML_VALUE v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( SWIG_Tag_val(v) ) {
case C_char:
case C_uchar:
case C_short:
case C_ushort:
case C_int:
case C_uint:
case C_int32:
case C_int64:
CAMLreturn(1);
default:
CAMLreturn(0);
}
}
SWIGINTERN int caml_float_check( CAML_VALUE v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( SWIG_Tag_val(v) ) {
case C_float:
case C_double:
CAMLreturn(1);
default:
CAMLreturn(0);
}
}
SWIGINTERN int caml_ptr_check( CAML_VALUE v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( SWIG_Tag_val(v) ) {
case C_string:
case C_ptr:
case C_int64:
CAMLreturn(1);
default:
CAMLreturn(0);
}
}
SWIGINTERN CAML_VALUE SWIG_Ocaml_ptr_to_val(const char *name, void *ptr, swig_type_info *descriptor) {
CAMLparam0();
SWIG_CAMLlocal1(result);
CAML_VALUE *fromval = caml_named_value(name);
if (fromval) {
result = caml_callback(*fromval, caml_val_ptr(ptr, descriptor));
} else {
result = caml_val_ptr(ptr, descriptor);
}
CAMLreturn(result);
}
static swig_module_info *SWIG_Ocaml_GetModule(void *SWIGUNUSEDPARM(clientdata)) {
CAML_VALUE pointer;
pointer = caml_callback(*caml_named_value("swig_find_type_info"), caml_val_int(0));
if (Is_block(pointer) && SWIG_Tag_val(pointer) == C_ptr) {
return (swig_module_info *)(void *)(long)SWIG_Int64_val(SWIG_Field(pointer,0));
}
return 0;
}
static void SWIG_Ocaml_SetModule(swig_module_info *pointer) {
CAML_VALUE mod_pointer;
mod_pointer = caml_val_ptr(pointer, NULL);
caml_callback(*caml_named_value("swig_set_type_info"), mod_pointer);
}
#ifdef __cplusplus
}
#endif
#undef value
%typemap(in) SWIGTYPE {
$1 = *(($&1_ltype) caml_ptr_val($input,$&1_descriptor)) ;
}
#ifdef __cplusplus
%typemap(out) SWIGTYPE {
$&1_ltype temp = new $ltype((const $1_ltype &) $1);
$result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)temp, $&1_descriptor);
}
#else
%typemap(out) SWIGTYPE {
void *temp = calloc(1,sizeof($ltype));
memmove(temp, &$1, sizeof($1_type));
$result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", temp, $&1_descriptor);
}
#endif
%typemap(directorin) SWIGTYPE {
$&ltype temp = new $ltype((const $ltype &)$1);
swig_result = SWIG_Ocaml_ptr_to_val("create_$ltype_from_ptr", (void *)temp, $&1_descriptor);
args = caml_list_append(args, swig_result);
}
%typemap(directorin) SWIGTYPE *, SWIGTYPE [], SWIGTYPE &, SWIGTYPE && {
swig_result = SWIG_Ocaml_ptr_to_val("create_$ltype_from_ptr", (void *)&$1, $&1_descriptor);
args = caml_list_append(args, swig_result);
}
/* The SIMPLE_MAP macro below defines the whole set of typemaps needed
for simple types. */
%define SIMPLE_MAP(C_NAME, C_TO_OCAML, OCAML_TO_C)
/* In */
%typemap(in) C_NAME {
$1 = OCAML_TO_C($input);
}
%typemap(varin) C_NAME {
$1 = OCAML_TO_C($input);
}
%typemap(in) const C_NAME & ($*1_ltype temp) {
temp = ($*1_ltype) OCAML_TO_C($input);
$1 = &temp;
}
%typemap(varin) const C_NAME & {
$1 = OCAML_TO_C($input);
}
%typemap(directorout) C_NAME {
$1 = OCAML_TO_C($input);
}
/* Out */
%typemap(out) C_NAME {
$result = C_TO_OCAML($1);
}
%typemap(varout) C_NAME {
$result = C_TO_OCAML($1);
}
%typemap(varout) const C_NAME & {
$result = C_TO_OCAML($1);
}
%typemap(out) const C_NAME & {
$result = C_TO_OCAML(*$1);
}
%typemap(directorin) C_NAME {
args = caml_list_append(args, C_TO_OCAML($1));
}
%enddef
SIMPLE_MAP(bool, caml_val_bool, caml_long_val);
SIMPLE_MAP(char, caml_val_char, caml_long_val);
SIMPLE_MAP(signed char, caml_val_char, caml_long_val);
SIMPLE_MAP(unsigned char, caml_val_uchar, caml_long_val);
SIMPLE_MAP(int, caml_val_int, caml_long_val);
SIMPLE_MAP(short, caml_val_short, caml_long_val);
SIMPLE_MAP(wchar_t, caml_val_short, caml_long_val);
SIMPLE_MAP(long, caml_val_long, caml_long_val);
SIMPLE_MAP(ptrdiff_t, caml_val_int, caml_long_val);
SIMPLE_MAP(unsigned int, caml_val_uint, caml_long_val);
SIMPLE_MAP(unsigned short, caml_val_ushort, caml_long_val);
SIMPLE_MAP(unsigned long, caml_val_ulong, caml_long_val);
SIMPLE_MAP(size_t, caml_val_int, caml_long_val);
SIMPLE_MAP(float, caml_val_float, caml_double_val);
SIMPLE_MAP(double, caml_val_double, caml_double_val);
SIMPLE_MAP(long long,caml_val_ulong,caml_long_val);
SIMPLE_MAP(unsigned long long,caml_val_ulong,caml_long_val);
/* Void */
%typemap(out) void "$result = Val_unit;";
/* Pass through value */
%typemap (in) CAML_VALUE "$1=$input;";
%typemap (out) CAML_VALUE "$result=$1;";
#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);
}
/* Again work around the empty array bound bug */
%typemap(how) char [ANY], signed char [ANY], unsigned char [ANY] {
char *temp = caml_string_val($input);
strcpy((char *)$1,temp);
}
%enddef
%char_ptr_in(in);
%char_ptr_in(varin);
%char_ptr_in(directorout);
%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);
}
/* I'd like to use the length here but can't because it might be empty */
%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((char *)$1);
}
%enddef
%char_ptr_out(out);
%char_ptr_out(varout);
%char_ptr_out(directorin);
%define %swigtype_ptr_in(how)
%typemap(how) SWIGTYPE * {
$1 = ($ltype)caml_ptr_val($input,$1_descriptor);
}
%typemap(how) SWIGTYPE (CLASS::*) {
void *v = caml_ptr_val($input,$1_descriptor);
memcpy(& $1, &v, sizeof(v));
}
%enddef
%typemap(out) SWIGTYPE * {
$result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)$1, $1_descriptor);
}
%define %swigtype_ptr_out(how)
%typemap(how) SWIGTYPE (CLASS::*) {
void *v;
memcpy(&v,& $1, sizeof(void *));
$result = caml_val_ptr (v,$1_descriptor);
}
%enddef
%swigtype_ptr_in(in);
%swigtype_ptr_in(varin);
%swigtype_ptr_in(directorout);
%swigtype_ptr_out(out);
%swigtype_ptr_out(varout);
%swigtype_ptr_out(directorin);
%define %swigtype_array_fail(how,msg)
%typemap(how) SWIGTYPE [] {
caml_failwith(msg);
}
%enddef
%swigtype_array_fail(in,"Array arguments for arbitrary types need a typemap");
%swigtype_array_fail(varin,"Assignment to global arrays for arbitrary types need a typemap");
%swigtype_array_fail(out,"Array arguments for arbitrary types need a typemap");
%swigtype_array_fail(varout,"Array variables need a typemap");
%swigtype_array_fail(directorin,"Array results with arbitrary types need a typemap");
%swigtype_array_fail(directorout,"Array arguments with arbitrary types need a typemap");
/* C++ References */
/* Enums */
%define %swig_enum_in(how)
%typemap(how) enum SWIGTYPE {
$1 = ($type)caml_long_val_full($input,"$type_marker");
}
%enddef
%define %swig_enum_out(how)
%typemap(how) enum SWIGTYPE {
$result = caml_callback2(*caml_named_value(SWIG_MODULE "_int_to_enum"),*caml_named_value("$type_marker"),Val_int((int)$1));
}
%enddef
%swig_enum_in(in)
%swig_enum_in(varin)
%swig_enum_in(directorout)
%swig_enum_out(out)
%swig_enum_out(varout)
%swig_enum_out(directorin)
%typemap(in) (char *STRING, int LENGTH), (char *STRING, size_t LENGTH) {
$1 = ($1_ltype) caml_string_val($input);
$2 = ($2_ltype) caml_string_len($input);
}
%typemap(out) SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC {
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor, (void **)&$1);
$result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)$1, ty);
}
/* Array reference typemaps */
%apply SWIGTYPE & { SWIGTYPE ((&)[ANY]) }
%apply SWIGTYPE && { SWIGTYPE ((&)[ANY]) }
/* const pointers */
%apply SWIGTYPE * { SWIGTYPE *const }
%apply SWIGTYPE (CLASS::*) { SWIGTYPE (CLASS::*const) }
%apply SWIGTYPE & { SWIGTYPE (CLASS::*const&) }

607
Lib/ocaml/ocamlrun.swg Normal file
View file

@ -0,0 +1,607 @@
/* -*-c-*- */
/* SWIG pointer structure */
#include <string.h>
#include <assert.h>
#ifdef __cplusplus
extern "C" {
#endif
#define C_bool 0
#define C_char 1
#define C_uchar 2
#define C_short 3
#define C_ushort 4
#define C_int 5
#define C_uint 6
#define C_int32 7
#define C_int64 8
#define C_float 9
#define C_double 10
#define C_ptr 11
#define C_array 12
#define C_list 13
#define C_obj 14
#define C_string 15
#define C_enum 16
#define C_director_core 17
/* Cast a pointer if possible; returns 1 if successful */
SWIGINTERN int
SWIG_Cast (void *source, swig_type_info *source_type,
void **ptr, swig_type_info *dest_type)
{
if( !source ) { /* Special case for NULL. This is a popular question
for other modules on the list, so I want an easy way out... */
*ptr = 0;
return 0;
}
#ifdef TYPE_CAST_VERBOSE
fprintf( stderr, "Trying to cast %s to %s\n",
source_type ? source_type->str : "<none>",
dest_type ? dest_type->str : "<none>" );
#endif
if (dest_type != source_type) {
/* We have a type mismatch. Will have to look through our type
mapping table to figure out whether or not we can accept this
datatype.
--
Ignore typechecks for void *. Allow any conversion. */
if( !dest_type || !source_type ||
!strcmp(dest_type->name,"_p_void") ||
!strcmp(source_type->name,"_p_void") ) {
*ptr = source;
return 0;
} else {
swig_cast_info *tc =
SWIG_TypeCheckStruct(source_type, dest_type );
#ifdef TYPE_CAST_VERBOSE
fprintf( stderr, "Typecheck -> %s\n",
tc ? tc->type->str : "<none>" );
#endif
if( tc ) {
int newmemory = 0;
*ptr = SWIG_TypeCast(tc, source, &newmemory);
assert(!newmemory); /* newmemory handling not yet implemented */
return 0;
} else
return -1;
}
} else {
*ptr = source;
return 0;
}
}
/* Return 0 if successful. */
SWIGINTERN int
SWIG_GetPtr(void *inptr, void **outptr,
swig_type_info *intype, swig_type_info *outtype) {
if (intype) {
return SWIG_Cast(inptr, intype,
outptr, outtype) == -1;
} else {
*outptr = inptr;
return 0;
}
}
SWIGINTERN void caml_print_list( CAML_VALUE v );
SWIGINTERN void caml_print_val( CAML_VALUE v ) {
switch( SWIG_Tag_val(v) ) {
case C_bool:
if( Bool_val(SWIG_Field(v,0)) ) fprintf( stderr, "true " );
else fprintf( stderr, "false " );
break;
case C_char:
case C_uchar:
fprintf( stderr, "'%c' (\\%03d) ",
(Int_val(SWIG_Field(v,0)) >= ' ' &&
Int_val(SWIG_Field(v,0)) < 127) ? Int_val(SWIG_Field(v,0)) : '.',
Int_val(SWIG_Field(v,0)) );
break;
case C_short:
case C_ushort:
case C_int:
fprintf( stderr, "%d ", (int)caml_long_val(v) );
break;
case C_uint:
case C_int32:
fprintf( stderr, "%ud ", (unsigned int)caml_long_val(v) );
break;
case C_int64:
fprintf( stderr, "%ld ", caml_long_val(v) );
break;
case C_float:
case C_double:
fprintf( stderr, "%f ", caml_double_val(v) );
break;
case C_ptr:
{
void *vout = 0;
swig_type_info *ty = (swig_type_info *)(long)SWIG_Int64_val(SWIG_Field(v,1));
caml_ptr_val_internal(v,&vout,0);
fprintf( stderr, "PTR(%p,%s) ",
vout,
ty ? ty->name : "(null)" );
}
break;
case C_array:
{
unsigned int i;
for( i = 0; i < Wosize_val( SWIG_Field(v,0) ); i++ )
caml_print_val( SWIG_Field(SWIG_Field(v,0),i) );
}
break;
case C_list:
caml_print_list( SWIG_Field(v,0) );
break;
case C_obj:
fprintf( stderr, "OBJ(%p) ", (void *)SWIG_Field(v,0) );
break;
case C_string:
{
void *cout;
caml_ptr_val_internal(v,&cout,0);
fprintf( stderr, "'%s' ", (char *)cout );
}
break;
}
}
SWIGINTERN void caml_print_list( CAML_VALUE v ) {
CAMLparam1(v);
while( v && Is_block(v) ) {
fprintf( stderr, "[ " );
caml_print_val( SWIG_Field(v,0) );
fprintf( stderr, "]\n" );
v = SWIG_Field(v,1);
}
CAMLreturn0;
}
SWIGINTERN CAML_VALUE caml_list_nth( CAML_VALUE lst, int n ) {
CAMLparam1(lst);
int i = 0;
while( i < n && lst && Is_block(lst) ) {
i++; lst = SWIG_Field(lst,1);
}
if( lst == Val_unit ) CAMLreturn(Val_unit);
else CAMLreturn(SWIG_Field(lst,0));
}
SWIGINTERN CAML_VALUE caml_list_append( CAML_VALUE lst, CAML_VALUE elt ) {
CAMLparam2(lst,elt);
SWIG_CAMLlocal3(v,vt,lh);
lh = Val_unit;
v = Val_unit;
/* Appending C_void should have no effect */
if( !Is_block(elt) ) return lst;
while( lst && Is_block(lst) ) {
if( v && v != Val_unit ) {
vt = caml_alloc_tuple(2);
SWIG_Store_field(v,1,vt);
v = vt;
} else {
v = lh = caml_alloc_tuple(2);
}
SWIG_Store_field(v,0,SWIG_Field(lst,0));
lst = SWIG_Field(lst,1);
}
if( v && Is_block(v) ) {
vt = caml_alloc_tuple(2);
SWIG_Store_field(v,1,vt);
v = vt;
} else {
v = lh = caml_alloc_tuple(2);
}
SWIG_Store_field(v,0,elt);
SWIG_Store_field(v,1,Val_unit);
CAMLreturn(lh);
}
SWIGINTERN int caml_list_length( CAML_VALUE lst ) {
CAMLparam1(lst);
int i = 0;
while( lst && Is_block(lst) ) { i++; lst = SWIG_Field(lst,1); }
CAMLreturn(i);
}
SWIGINTERN void caml_array_set( CAML_VALUE arr, int n, CAML_VALUE item ) {
CAMLparam2(arr,item);
SWIG_Store_field(SWIG_Field(arr,0),n,item);
CAMLreturn0;
}
SWIGINTERN value caml_array_nth( CAML_VALUE arr, int n ) {
CAMLparam1(arr);
if( SWIG_Tag_val(arr) == C_array )
CAMLreturn(SWIG_Field(SWIG_Field(arr,0),n));
else if( SWIG_Tag_val(arr) == C_list )
CAMLreturn(caml_list_nth(arr,0));
else
caml_failwith("Need array or list");
}
SWIGINTERN int caml_array_len( CAML_VALUE arr ) {
CAMLparam1(arr);
if( SWIG_Tag_val(arr) == C_array )
CAMLreturn(Wosize_val(SWIG_Field(arr,0)));
else if( SWIG_Tag_val(arr) == C_list )
CAMLreturn(caml_list_length(arr));
else
caml_failwith("Need array or list");
}
SWIGINTERN CAML_VALUE caml_swig_alloc(int x,int y) {
return caml_alloc(x,y);
}
SWIGINTERN value caml_array_new( int n ) {
CAMLparam0();
SWIG_CAMLlocal1(vv);
vv = caml_swig_alloc(1,C_array);
SWIG_Store_field(vv,0,caml_alloc_tuple(n));
CAMLreturn(vv);
}
SWIGINTERN CAML_VALUE caml_val_bool( int b ) {
CAMLparam0();
SWIG_CAMLlocal1(bv);
bv = caml_swig_alloc(1,C_bool);
SWIG_Store_field(bv,0,Val_bool(b));
CAMLreturn(bv);
}
SWIGINTERN CAML_VALUE caml_val_char( char c ) {
CAMLparam0();
SWIG_CAMLlocal1(cv);
cv = caml_swig_alloc(1,C_char);
SWIG_Store_field(cv,0,Val_int(c));
CAMLreturn(cv);
}
SWIGINTERN CAML_VALUE caml_val_uchar( unsigned char uc ) {
CAMLparam0();
SWIG_CAMLlocal1(ucv);
ucv = caml_swig_alloc(1,C_uchar);
SWIG_Store_field(ucv,0,Val_int(uc));
CAMLreturn(ucv);
}
SWIGINTERN CAML_VALUE caml_val_short( short s ) {
CAMLparam0();
SWIG_CAMLlocal1(sv);
sv = caml_swig_alloc(1,C_short);
SWIG_Store_field(sv,0,Val_int(s));
CAMLreturn(sv);
}
SWIGINTERN CAML_VALUE caml_val_ushort( unsigned short us ) {
CAMLparam0();
SWIG_CAMLlocal1(usv);
usv = caml_swig_alloc(1,C_ushort);
SWIG_Store_field(usv,0,Val_int(us));
CAMLreturn(usv);
}
SWIGINTERN CAML_VALUE caml_val_int( int i ) {
CAMLparam0();
SWIG_CAMLlocal1(iv);
iv = caml_swig_alloc(1,C_int);
SWIG_Store_field(iv,0,Val_int(i));
CAMLreturn(iv);
}
SWIGINTERN CAML_VALUE caml_val_uint( unsigned int ui ) {
CAMLparam0();
SWIG_CAMLlocal1(uiv);
uiv = caml_swig_alloc(1,C_int);
SWIG_Store_field(uiv,0,Val_int(ui));
CAMLreturn(uiv);
}
SWIGINTERN CAML_VALUE caml_val_long( long l ) {
CAMLparam0();
SWIG_CAMLlocal1(lv);
lv = caml_swig_alloc(1,C_int64);
SWIG_Store_field(lv,0,caml_copy_int64(l));
CAMLreturn(lv);
}
SWIGINTERN CAML_VALUE caml_val_ulong( unsigned long ul ) {
CAMLparam0();
SWIG_CAMLlocal1(ulv);
ulv = caml_swig_alloc(1,C_int64);
SWIG_Store_field(ulv,0,caml_copy_int64(ul));
CAMLreturn(ulv);
}
SWIGINTERN CAML_VALUE caml_val_float( float f ) {
CAMLparam0();
SWIG_CAMLlocal1(fv);
fv = caml_swig_alloc(1,C_float);
SWIG_Store_field(fv,0,caml_copy_double((double)f));
CAMLreturn(fv);
}
SWIGINTERN CAML_VALUE caml_val_double( double d ) {
CAMLparam0();
SWIG_CAMLlocal1(fv);
fv = caml_swig_alloc(1,C_double);
SWIG_Store_field(fv,0,caml_copy_double(d));
CAMLreturn(fv);
}
SWIGINTERN CAML_VALUE caml_val_ptr( void *p, swig_type_info *info ) {
CAMLparam0();
SWIG_CAMLlocal1(vv);
vv = caml_swig_alloc(2,C_ptr);
SWIG_Store_field(vv,0,caml_copy_int64((long)p));
SWIG_Store_field(vv,1,caml_copy_int64((long)info));
CAMLreturn(vv);
}
SWIGINTERN CAML_VALUE caml_val_string( const char *p ) {
CAMLparam0();
SWIG_CAMLlocal1(vv);
if( !p ) CAMLreturn(caml_val_ptr( (void *)p, 0 ));
vv = caml_swig_alloc(1,C_string);
SWIG_Store_field(vv,0,caml_copy_string(p));
CAMLreturn(vv);
}
SWIGINTERN CAML_VALUE caml_val_string_len( const char *p, int len ) {
CAMLparam0();
SWIG_CAMLlocal1(vv);
if( !p || len < 0 ) CAMLreturn(caml_val_ptr( (void *)p, 0 ));
vv = caml_swig_alloc(1,C_string);
SWIG_Store_field(vv,0,caml_alloc_string(len));
memcpy(String_val(SWIG_Field(vv,0)),p,len);
CAMLreturn(vv);
}
#define caml_val_obj(v, name) caml_val_obj_helper(v, SWIG_TypeQuery((name)), name)
SWIGINTERN CAML_VALUE caml_val_obj_helper( void *v, swig_type_info *type, char *name) {
CAMLparam0();
CAMLreturn(caml_callback2(*caml_named_value("caml_create_object_fn"),
caml_val_ptr(v,type),
caml_copy_string(name)));
}
SWIGINTERN long caml_long_val_full( CAML_VALUE v, const char *name ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( SWIG_Tag_val(v) ) {
case C_bool:
case C_char:
case C_uchar:
case C_short:
case C_ushort:
case C_int:
CAMLreturn(Int_val(SWIG_Field(v,0)));
case C_uint:
case C_int32:
CAMLreturn(Int32_val(SWIG_Field(v,0)));
case C_int64:
CAMLreturn((long)SWIG_Int64_val(SWIG_Field(v,0)));
case C_float:
case C_double:
CAMLreturn((long)Double_val(SWIG_Field(v,0)));
case C_string:
CAMLreturn((long)String_val(SWIG_Field(v,0)));
case C_ptr:
CAMLreturn((long)SWIG_Int64_val(SWIG_Field(SWIG_Field(v,0),0)));
case C_enum: {
SWIG_CAMLlocal1(ret);
CAML_VALUE *enum_to_int = caml_named_value(SWIG_MODULE "_enum_to_int");
if( !name ) caml_failwith( "Not an enum conversion" );
ret = caml_callback2(*enum_to_int,*caml_named_value(name),v);
CAMLreturn(caml_long_val(ret));
}
default:
caml_failwith("No conversion to int");
}
}
SWIGINTERN long caml_long_val( CAML_VALUE v ) {
return caml_long_val_full(v,0);
}
SWIGINTERN double caml_double_val( CAML_VALUE v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0.0;
switch( SWIG_Tag_val(v) ) {
case C_bool:
case C_char:
case C_uchar:
case C_short:
case C_ushort:
case C_int:
CAMLreturn_type(Int_val(SWIG_Field(v,0)));
case C_uint:
case C_int32:
CAMLreturn_type(Int32_val(SWIG_Field(v,0)));
case C_int64:
CAMLreturn_type(SWIG_Int64_val(SWIG_Field(v,0)));
case C_float:
case C_double:
CAMLreturn_type(Double_val(SWIG_Field(v,0)));
default:
fprintf( stderr, "Unknown block tag %d\n", SWIG_Tag_val(v) );
caml_failwith("No conversion to double");
}
}
SWIGINTERN int caml_ptr_val_internal( CAML_VALUE v, void **out,
swig_type_info *descriptor ) {
CAMLparam1(v);
void *outptr = NULL;
swig_type_info *outdescr = NULL;
static CAML_VALUE *func_val = NULL;
if( v == Val_unit ) {
*out = 0;
CAMLreturn_type(0);
}
if( !Is_block(v) ) return -1;
switch( SWIG_Tag_val(v) ) {
case C_obj:
if (!func_val) {
func_val = caml_named_value("caml_obj_ptr");
}
CAMLreturn_type(caml_ptr_val_internal(caml_callback(*func_val, v), out, descriptor));
case C_string:
outptr = (void *)String_val(SWIG_Field(v,0));
break;
case C_ptr:
outptr = (void *)(long)SWIG_Int64_val(SWIG_Field(v,0));
outdescr = (swig_type_info *)(long)SWIG_Int64_val(SWIG_Field(v,1));
break;
default:
*out = 0;
CAMLreturn_type(1);
break;
}
CAMLreturn_type(SWIG_GetPtr(outptr, out, outdescr, descriptor));
}
SWIGINTERN void *caml_ptr_val( CAML_VALUE v, swig_type_info *descriptor ) {
CAMLparam0();
#ifdef TYPE_CAST_VERBOSE
caml_print_val( v );
#endif
void *out = NULL;
if( !caml_ptr_val_internal( v, &out, descriptor ) )
CAMLreturn_type(out);
else
caml_failwith( "No appropriate conversion found." );
}
SWIGINTERN char *caml_string_val( CAML_VALUE v ) {
return (char *)caml_ptr_val( v, 0 );
}
SWIGINTERN int caml_string_len( CAML_VALUE v ) {
switch( SWIG_Tag_val(v) ) {
case C_string:
return caml_string_length(SWIG_Field(v,0));
default:
return strlen((char *)caml_ptr_val(v,0));
}
}
SWIGINTERN int caml_bool_check( CAML_VALUE v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( SWIG_Tag_val(v) ) {
case C_bool:
case C_ptr:
case C_string:
CAMLreturn(1);
default:
CAMLreturn(0);
}
}
SWIGINTERN int caml_int_check( CAML_VALUE v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( SWIG_Tag_val(v) ) {
case C_char:
case C_uchar:
case C_short:
case C_ushort:
case C_int:
case C_uint:
case C_int32:
case C_int64:
CAMLreturn(1);
default:
CAMLreturn(0);
}
}
SWIGINTERN int caml_float_check( CAML_VALUE v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( SWIG_Tag_val(v) ) {
case C_float:
case C_double:
CAMLreturn(1);
default:
CAMLreturn(0);
}
}
SWIGINTERN int caml_ptr_check( CAML_VALUE v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( SWIG_Tag_val(v) ) {
case C_string:
case C_ptr:
case C_int64:
CAMLreturn(1);
default:
CAMLreturn(0);
}
}
SWIGINTERN CAML_VALUE SWIG_Ocaml_ptr_to_val(const char *name, void *ptr, swig_type_info *descriptor) {
CAMLparam0();
SWIG_CAMLlocal1(result);
CAML_VALUE *fromval = caml_named_value(name);
if (fromval) {
result = caml_callback(*fromval, caml_val_ptr(ptr, descriptor));
} else {
result = caml_val_ptr(ptr, descriptor);
}
CAMLreturn(result);
}
static swig_module_info *SWIG_Ocaml_GetModule(void *SWIGUNUSEDPARM(clientdata)) {
CAML_VALUE pointer;
pointer = caml_callback(*caml_named_value("swig_find_type_info"), caml_val_int(0));
if (Is_block(pointer) && SWIG_Tag_val(pointer) == C_ptr) {
return (swig_module_info *)(void *)(long)SWIG_Int64_val(SWIG_Field(pointer,0));
}
return 0;
}
static void SWIG_Ocaml_SetModule(swig_module_info *pointer) {
CAML_VALUE mod_pointer;
mod_pointer = caml_val_ptr(pointer, NULL);
caml_callback(*caml_named_value("swig_set_type_info"), mod_pointer);
}
#ifdef __cplusplus
}
#endif
#undef value

2
Lib/ocaml/ocamldec.swg → Lib/ocaml/ocamlrundec.swg
View file

@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
* ocamldec.swg
* ocamlrundec.swg
*
* Ocaml runtime code -- declarations
* ----------------------------------------------------------------------------- */

343
Lib/ocaml/typemaps.i
View file

@ -1,321 +1,44 @@
/* -----------------------------------------------------------------------------
/* ----------------------------------------------------------------------------
* typemaps.i
*
* The Ocaml module handles all types uniformly via typemaps. Here
* are the definitions.
* ----------------------------------------------------------------------------- */
* These typemaps provide support for input/output arguments for C/C++ pointers
* and C++ references.
* ---------------------------------------------------------------------------- */
/* Pointers */
%typemap(in) void ""
%typemap(out) void "$result = Val_int(0);"
%typemap(in) void * {
$1 = caml_ptr_val($input,$descriptor);
}
%typemap(varin) void * {
$1 = ($ltype)caml_ptr_val($input,$descriptor);
}
%typemap(out) void * {
$result = caml_val_ptr($1,$descriptor);
}
%typemap(varout) void * {
$result = caml_val_ptr($1,$descriptor);
}
%typemap(in) char *& (char *temp) {
temp = (char*)caml_val_ptr($1,$descriptor);
%define INPUT_OUTPUT_INOUT_TYPEMAPS(type, c_to_ocaml, ocaml_to_c)
%typemap(in) type *INPUT(type temp), type &INPUT(type temp) {
temp = (type)ocaml_to_c($input);
$1 = &temp;
}
%typemap(typecheck) type *INPUT = type;
%typemap(typecheck) type &INPUT = type;
%typemap(argout) char *& {
swig_result = caml_list_append(swig_result,caml_val_string_len(*$1, strlen(*$1)));
%typemap(in, numinputs=0) type *OUTPUT($*1_ltype temp), type &OUTPUT($*1_ltype temp) "$1 = &temp;"
%typemap(argout) type *OUTPUT, type &OUTPUT {
swig_result = caml_list_append(swig_result, c_to_ocaml(*$1));
}
%typemap(in) type *INOUT = type *INPUT;
%typemap(in) type &INOUT = type &INPUT;
%typemap(in) SWIGTYPE & {
$1 = ($ltype) caml_ptr_val($input,$1_descriptor);
}
%typemap(argout) type *INOUT = type *OUTPUT;
%typemap(argout) type &INOUT = type &OUTPUT;
%typemap(in) SWIGTYPE && {
$1 = ($ltype) caml_ptr_val($input,$1_descriptor);
}
%typemap(varin) SWIGTYPE & {
$1 = *(($ltype) caml_ptr_val($input,$1_descriptor));
}
%typemap(varin) SWIGTYPE && {
$1 = *(($ltype) caml_ptr_val($input,$1_descriptor));
}
%typemap(varout) SWIGTYPE &, SWIGTYPE && {
$result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)&$1, $1_descriptor);
}
%typemap(out) SWIGTYPE &, SWIGTYPE && {
$result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)$1, $1_descriptor);
}
#if 0
%typemap(argout) SWIGTYPE & {
CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) {
swig_result =
caml_list_append(swig_result,
caml_callback(*fromval,caml_val_ptr((void *) $1,
$1_descriptor)));
} else {
swig_result =
caml_list_append(swig_result,
caml_val_ptr ((void *) $1,$1_descriptor));
}
}
%typemap(argout) SWIGTYPE && {
CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
if( fromval ) {
swig_result =
caml_list_append(swig_result,
caml_callback(*fromval,caml_val_ptr((void *) $1,
$1_descriptor)));
} else {
swig_result =
caml_list_append(swig_result,
caml_val_ptr ((void *) $1,$1_descriptor));
}
}
#endif
%typemap(in) SWIGTYPE {
$1 = *(($&1_ltype) caml_ptr_val($input,$&1_descriptor)) ;
}
#ifdef __cplusplus
%typemap(out) SWIGTYPE {
$&1_ltype temp = new $ltype((const $1_ltype &) $1);
$result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)temp, $&1_descriptor);
}
#else
%typemap(out) SWIGTYPE {
void *temp = calloc(1,sizeof($ltype));
memmove(temp, &$1, sizeof($1_type));
$result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", temp, $&1_descriptor);
}
#endif
%typemap(directorin) SWIGTYPE {
$&ltype temp = new $ltype((const $ltype &)$1);
swig_result = SWIG_Ocaml_ptr_to_val("create_$ltype_from_ptr", (void *)temp, $&1_descriptor);
args = caml_list_append(args, swig_result);
}
%typemap(directorin) SWIGTYPE *, SWIGTYPE [], SWIGTYPE &, SWIGTYPE && {
swig_result = SWIG_Ocaml_ptr_to_val("create_$ltype_from_ptr", (void *)&$1, $&1_descriptor);
args = caml_list_append(args, swig_result);
}
/* The SIMPLE_MAP macro below defines the whole set of typemaps needed
for simple types. */
%define SIMPLE_MAP(C_NAME, C_TO_OCAML, OCAML_TO_C)
/* In */
%typemap(in) C_NAME {
$1 = OCAML_TO_C($input);
}
%typemap(varin) C_NAME {
$1 = OCAML_TO_C($input);
}
%typemap(in) const C_NAME & ($*1_ltype temp) {
temp = ($*1_ltype) OCAML_TO_C($input);
$1 = &temp;
}
%typemap(varin) const C_NAME & {
$1 = OCAML_TO_C($input);
}
%typemap(directorout) C_NAME {
$1 = OCAML_TO_C($input);
}
%typemap(in) C_NAME *INPUT ($*1_ltype temp) {
temp = ($*1_ltype) OCAML_TO_C($input);
$1 = &temp;
}
%typemap(in,numinputs=0) C_NAME *OUTPUT ($*1_ltype temp) {
$1 = &temp;
}
/* Out */
%typemap(out) C_NAME {
$result = C_TO_OCAML($1);
}
%typemap(varout) C_NAME {
$result = C_TO_OCAML($1);
}
%typemap(varout) const C_NAME & {
$result = C_TO_OCAML($1);
}
%typemap(argout) C_NAME *OUTPUT {
swig_result = caml_list_append(swig_result, C_TO_OCAML((long)*$1));
}
%typemap(out) const C_NAME & {
$result = C_TO_OCAML(*$1);
}
%typemap(directorin) C_NAME {
args = caml_list_append(args, C_TO_OCAML($1));
}
%typemap(typecheck) type *INOUT = type;
%typemap(typecheck) type &INOUT = type;
%enddef
SIMPLE_MAP(bool, caml_val_bool, caml_long_val);
SIMPLE_MAP(char, caml_val_char, caml_long_val);
SIMPLE_MAP(signed char, caml_val_char, caml_long_val);
SIMPLE_MAP(unsigned char, caml_val_uchar, caml_long_val);
SIMPLE_MAP(int, caml_val_int, caml_long_val);
SIMPLE_MAP(short, caml_val_short, caml_long_val);
SIMPLE_MAP(wchar_t, caml_val_short, caml_long_val);
SIMPLE_MAP(long, caml_val_long, caml_long_val);
SIMPLE_MAP(ptrdiff_t, caml_val_int, caml_long_val);
SIMPLE_MAP(unsigned int, caml_val_uint, caml_long_val);
SIMPLE_MAP(unsigned short, caml_val_ushort, caml_long_val);
SIMPLE_MAP(unsigned long, caml_val_ulong, caml_long_val);
SIMPLE_MAP(size_t, caml_val_int, caml_long_val);
SIMPLE_MAP(float, caml_val_float, caml_double_val);
SIMPLE_MAP(double, caml_val_double, caml_double_val);
SIMPLE_MAP(long long,caml_val_ulong,caml_long_val);
SIMPLE_MAP(unsigned long long,caml_val_ulong,caml_long_val);
/* Void */
%typemap(out) void "$result = Val_unit;";
/* Pass through value */
%typemap (in) CAML_VALUE "$1=$input;";
%typemap (out) CAML_VALUE "$result=$1;";
#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);
}
/* Again work around the empty array bound bug */
%typemap(how) char [ANY], signed char [ANY], unsigned char [ANY] {
char *temp = caml_string_val($input);
strcpy((char *)$1,temp);
}
%enddef
%char_ptr_in(in);
%char_ptr_in(varin);
%char_ptr_in(directorout);
%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);
}
/* I'd like to use the length here but can't because it might be empty */
%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((char *)$1);
}
%enddef
%char_ptr_out(out);
%char_ptr_out(varout);
%char_ptr_out(directorin);
%define %swigtype_ptr_in(how)
%typemap(how) SWIGTYPE * {
$1 = ($ltype)caml_ptr_val($input,$1_descriptor);
}
%typemap(how) SWIGTYPE (CLASS::*) {
void *v = caml_ptr_val($input,$1_descriptor);
memcpy(& $1, &v, sizeof(v));
}
%enddef
%typemap(out) SWIGTYPE * {
$result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)$1, $1_descriptor);
}
%define %swigtype_ptr_out(how)
%typemap(how) SWIGTYPE (CLASS::*) {
void *v;
memcpy(&v,& $1, sizeof(void *));
$result = caml_val_ptr (v,$1_descriptor);
}
%enddef
%swigtype_ptr_in(in);
%swigtype_ptr_in(varin);
%swigtype_ptr_in(directorout);
%swigtype_ptr_out(out);
%swigtype_ptr_out(varout);
%swigtype_ptr_out(directorin);
%define %swigtype_array_fail(how,msg)
%typemap(how) SWIGTYPE [] {
caml_failwith(msg);
}
%enddef
%swigtype_array_fail(in,"Array arguments for arbitrary types need a typemap");
%swigtype_array_fail(varin,"Assignment to global arrays for arbitrary types need a typemap");
%swigtype_array_fail(out,"Array arguments for arbitrary types need a typemap");
%swigtype_array_fail(varout,"Array variables need a typemap");
%swigtype_array_fail(directorin,"Array results with arbitrary types need a typemap");
%swigtype_array_fail(directorout,"Array arguments with arbitrary types need a typemap");
/* C++ References */
/* Enums */
%define %swig_enum_in(how)
%typemap(how) enum SWIGTYPE {
$1 = ($type)caml_long_val_full($input,"$type_marker");
}
%enddef
%define %swig_enum_out(how)
%typemap(how) enum SWIGTYPE {
$result = caml_callback2(*caml_named_value(SWIG_MODULE "_int_to_enum"),*caml_named_value("$type_marker"),Val_int((int)$1));
}
%enddef
%swig_enum_in(in)
%swig_enum_in(varin)
%swig_enum_in(directorout)
%swig_enum_out(out)
%swig_enum_out(varout)
%swig_enum_out(directorin)
%typemap(in) (char *STRING, int LENGTH), (char *STRING, size_t LENGTH) {
$1 = ($1_ltype) caml_string_val($input);
$2 = ($2_ltype) caml_string_len($input);
}
%typemap(out) SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC {
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor, (void **)&$1);
$result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)$1, ty);
}
/* Array reference typemaps */
%apply SWIGTYPE & { SWIGTYPE ((&)[ANY]) }
%apply SWIGTYPE && { SWIGTYPE ((&)[ANY]) }
/* const pointers */
%apply SWIGTYPE * { SWIGTYPE *const }
%apply SWIGTYPE (CLASS::*) { SWIGTYPE (CLASS::*const) }
%apply SWIGTYPE & { SWIGTYPE (CLASS::*const&) }
INPUT_OUTPUT_INOUT_TYPEMAPS(bool, caml_val_bool, caml_long_val);
INPUT_OUTPUT_INOUT_TYPEMAPS(int, caml_val_int, caml_long_val);
INPUT_OUTPUT_INOUT_TYPEMAPS(long, caml_val_long, caml_long_val);
INPUT_OUTPUT_INOUT_TYPEMAPS(short, caml_val_int, caml_long_val);
INPUT_OUTPUT_INOUT_TYPEMAPS(char, caml_val_char, caml_long_val);
INPUT_OUTPUT_INOUT_TYPEMAPS(signed char, caml_val_char, caml_long_val);
INPUT_OUTPUT_INOUT_TYPEMAPS(float, caml_val_float, caml_double_val);
INPUT_OUTPUT_INOUT_TYPEMAPS(double, caml_val_double, caml_double_val);
INPUT_OUTPUT_INOUT_TYPEMAPS(unsigned int, caml_val_uint, caml_long_val);
INPUT_OUTPUT_INOUT_TYPEMAPS(unsigned long, caml_val_ulong, caml_long_val);
INPUT_OUTPUT_INOUT_TYPEMAPS(unsigned short, caml_val_ushort, caml_long_val);
INPUT_OUTPUT_INOUT_TYPEMAPS(unsigned char, caml_val_uchar, caml_long_val);
INPUT_OUTPUT_INOUT_TYPEMAPS(long long, caml_val_long, caml_long_val);
INPUT_OUTPUT_INOUT_TYPEMAPS(unsigned long long, caml_val_ulong, caml_long_val);
#undef INPUT_OUTPUT_INOUT_TYPEMAPS

4
Source/Modules/ocaml.cxx
View file

@ -1866,9 +1866,9 @@ public:
}
String *runtimeCode() {
String *s = Swig_include_sys("ocaml.swg");
String *s = Swig_include_sys("ocamlrun.swg");
if (!s) {
Printf(stderr, "*** Unable to open 'ocaml.swg'\n");
Printf(stderr, "*** Unable to open 'ocamlrun.swg'\n");
s = NewString("");
}
return s;