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

The great merge

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@4141 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Dave Beazley 2002-11-30 22:01:28 +00:00
commit 516036631c
1508 changed files with 125983 additions and 44037 deletions
Download patch file Download diff file Expand all files Collapse all files

36
SWIG/Lib/ocaml/carray.i Normal file
View file

@ -0,0 +1,36 @@
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;
};
%typemap(ocaml,out) SWIGTYPE [ANY] {
$result = new SWIG_OCAML_ARRAY_WRAPPER($1);
}
%typemap(ocaml,varout) SWIGTYPE [ANY] {
$result = new SWIG_OCAML_ARRAY_WRAPPER($1);
}
%typemap(ocaml,in) SWIGTYPE [ANY] {
$1 = (SWIG_OCAML_ARRAY_WRAPPER<$ltype> *)$input;
}
%typemap(ocaml,varin) SWIGTYPE [ANY] {
$1 = (SWIG_OCAML_ARRAY_WRAPPER<$ltype> *)$input;
}

274
SWIG/Lib/ocaml/cstring.i Normal file
View file

@ -0,0 +1,274 @@
/* -*- C++ -*-
* cstring.i
* $Header$
*
* Author(s): Art Yerkes
* Modified from David Beazley (beazley@cs.uchicago.edu)
*
* This file provides typemaps and macros for dealing with various forms
* of C character string handling. The primary use of this module
* is in returning character data that has been allocated or changed in
* some way.
*/
%include "fragments.i"
/* %cstring_input_binary(TYPEMAP, SIZE)
*
* Macro makes a function accept binary string data along with
* a size.
*/
%define %cstring_input_binary(TYPEMAP, SIZE)
%apply (char *STRING, int LENGTH) { (TYPEMAP, SIZE) };
%enddef
/*
* %cstring_bounded_output(TYPEMAP, MAX)
*
* This macro is used to return a NULL-terminated output string of
* some maximum length. For example:
*
* %cstring_bounded_output(char *outx, 512);
* void foo(char *outx) {
* sprintf(outx,"blah blah\n");
* }
*
*/
%define %cstring_bounded_output(TYPEMAP,MAX)
%typemap(ignore) TYPEMAP(char temp[MAX+1]) {
$1 = ($1_ltype) temp;
}
%typemap(argout,fragment="t_output_helper") TYPEMAP {
$1[MAX] = 0;
$result = caml_list_append($result,caml_val_string(str));
}
%enddef
/*
* %cstring_chunk_output(TYPEMAP, SIZE)
*
* This macro is used to return a chunk of binary string data.
* Embedded NULLs are okay. For example:
*
* %cstring_chunk_output(char *outx, 512);
* void foo(char *outx) {
* memmove(outx, somedata, 512);
* }
*
*/
%define %cstring_chunk_output(TYPEMAP,SIZE)
%typemap(ignore) TYPEMAP(char temp[SIZE]) {
$1 = ($1_ltype) temp;
}
%typemap(argout) TYPEMAP {
$result = caml_list_append($result,caml_val_string_len($1,SIZE));
}
%enddef
/*
* %cstring_bounded_mutable(TYPEMAP, SIZE)
*
* This macro is used to wrap a string that's going to mutate.
*
* %cstring_bounded_mutable(char *in, 512);
* void foo(in *x) {
* while (*x) {
* *x = toupper(*x);
* x++;
* }
* }
*
*/
%define %cstring_bounded_mutable(TYPEMAP,MAX)
%typemap(in) TYPEMAP(char temp[MAX+1]) {
char *t = (char *)caml_ptr_val($input);
strncpy(temp,t,MAX);
$1 = ($1_ltype) temp;
}
%typemap(argout) TYPEMAP {
$result = caml_list_append($result,caml_val_string_len($1,MAX));
}
%enddef
/*
* %cstring_mutable(TYPEMAP [, expansion])
*
* This macro is used to wrap a string that will mutate in place.
* It may change size up to a user-defined expansion.
*
* %cstring_mutable(char *in);
* void foo(in *x) {
* while (*x) {
* *x = toupper(*x);
* x++;
* }
* }
*
*/
%define %cstring_mutable(TYPEMAP,...)
%typemap(in) TYPEMAP {
char *t = String_val($input);
int n = string_length($input);
$1 = ($1_ltype) t;
#if #__VA_ARGS__ == ""
#if __cplusplus
$1 = ($1_ltype) new char[n+1];
#else
$1 = ($1_ltype) malloc(n+1);
#endif
#else
#if __cplusplus
$1 = ($1_ltype) new char[n+1+__VA_ARGS__];
#else
$1 = ($1_ltype) malloc(n+1+__VA_ARGS__);
#endif
#endif
memmove($1,t,n);
$1[n] = 0;
}
%typemap(argout) TYPEMAP {
$result = caml_list_append($result,caml_val_string($1));
#if __cplusplus
delete[] $1;
#else
free($1);
#endif
}
%enddef
/*
* %cstring_output_maxsize(TYPEMAP, SIZE)
*
* This macro returns data in a string of some user-defined size.
*
* %cstring_output_maxsize(char *outx, int max) {
* void foo(char *outx, int max) {
* sprintf(outx,"blah blah\n");
* }
*/
%define %cstring_output_maxsize(TYPEMAP, SIZE)
%typemap(in) (TYPEMAP, SIZE) {
$2 = caml_val_long($input);
#ifdef __cpluscplus
$1 = ($1_ltype) new char[$2+1];
#else
$1 = ($1_ltype) malloc($2+1);
#endif
}
%typemap(argout) (TYPEMAP,SIZE) {
$result = caml_list_append($result,caml_val_string($1));
#ifdef __cplusplus
delete [] $1;
#else
free($1);
#endif
}
%enddef
/*
* %cstring_output_withsize(TYPEMAP, SIZE)
*
* This macro is used to return character data along with a size
* parameter.
*
* %cstring_output_maxsize(char *outx, int *max) {
* void foo(char *outx, int *max) {
* sprintf(outx,"blah blah\n");
* *max = strlen(outx);
* }
*/
%define %cstring_output_withsize(TYPEMAP, SIZE)
%typemap(in) (TYPEMAP, SIZE) {
int n = caml_val_long($input);
#ifdef __cpluscplus
$1 = ($1_ltype) new char[n+1];
$2 = ($2_ltype) new $*1_ltype;
#else
$1 = ($1_ltype) malloc(n+1);
$2 = ($2_ltype) malloc(sizeof($*1_ltype));
#endif
*$2 = n;
}
%typemap(argout) (TYPEMAP,SIZE) {
$result = caml_list_append($result,caml_val_string_len($1,$2));
#ifdef __cplusplus
delete [] $1;
delete $2;
#else
free($1);
free($2);
#endif
}
%enddef
/*
* %cstring_output_allocate(TYPEMAP, RELEASE)
*
* This macro is used to return character data that was
* allocated with new or malloc.
*
* %cstring_output_allocated(char **outx, free($1));
* void foo(char **outx) {
* *outx = (char *) malloc(512);
* sprintf(outx,"blah blah\n");
* }
*/
%define %cstring_output_allocate(TYPEMAP, RELEASE)
%typemap(ignore) TYPEMAP($*1_ltype temp = 0) {
$1 = &temp;
}
%typemap(argout) TYPEMAP {
if (*$1) {
$result = caml_list_append($result,caml_val_string($1));
RELEASE;
} else {
$result = caml_list_append($result,caml_val_ptr($1));
}
}
%enddef
/*
* %cstring_output_allocate_size(TYPEMAP, SIZE, RELEASE)
*
* This macro is used to return character data that was
* allocated with new or malloc.
*
* %cstring_output_allocated(char **outx, int *sz, free($1));
* void foo(char **outx, int *sz) {
* *outx = (char *) malloc(512);
* sprintf(outx,"blah blah\n");
* *sz = strlen(outx);
* }
*/
%define %cstring_output_allocate_size(TYPEMAP, SIZE, RELEASE)
%typemap(ignore) (TYPEMAP, SIZE) ($*1_ltype temp = 0, $*2_ltype tempn) {
$1 = &temp;
$2 = &tempn;
}
%typemap(argout)(TYPEMAP,SIZE) {
if (*$1) {
$result = caml_list_append($result,caml_val_string_len($1,$2));
RELEASE;
} else
$result = caml_list_append($result,caml_val_ptr($1));
}
%enddef

2
SWIG/Lib/ocaml/extra-install.list Normal file
View file

@ -0,0 +1,2 @@
# see top-level Makefile.in
libswigocaml.h

20
SWIG/Lib/ocaml/libswigocaml.h Normal file
View file

@ -0,0 +1,20 @@
/* Ocaml runtime support */
#ifdef __cplusplus
extern "C" {
#endif
typedef int oc_bool;
extern void *nullptr;
extern oc_bool isnull( void *v );
extern void *get_char_ptr( char *str );
extern void *make_ptr_array( int size );
extern void *get_ptr( void *arrayptr, int elt );
extern void set_ptr( void *arrayptr, int elt, void *elt_v );
extern void *offset_ptr( void *ptr, int n );
#ifdef __cplusplus
};
#endif

18
SWIG/Lib/ocaml/libswigocaml.swg Normal file
View file

@ -0,0 +1,18 @@
#include <stdio.h>
#include <stdlib.h>
#include "libswigocaml.h"
/* Ocaml runtime support ... not much here yet */
void *nullptr = 0;
oc_bool isnull( void *v ) { return v ? 0 : 1; }
void *get_char_ptr( char *str ) { return str; }
void *make_ptr_array( int size ) {
return (void *)malloc( sizeof( void * ) * size );
}
void *get_ptr( void *arrayptr, int elt ) {
return ((void **)arrayptr)[elt];
}
void set_ptr( void *arrayptr, int elt, void *elt_v ) {
((void **)arrayptr)[elt] = elt_v;
}
void *offset_ptr( void *p, int n ) { return ((char *)p) + n; }

54
SWIG/Lib/ocaml/mlheading.swg Normal file
View file

@ -0,0 +1,54 @@
open Int32
open Int64
type c_obj =
C_void
| C_bool of bool
| C_char of char
| C_uchar of char
| C_short of int
| C_ushort of int
| C_int of int
| C_uint of int32
| C_int32 of int32
| C_int64 of int64
| C_float of float
| C_double of float
| C_ptr of int64 * int64
| C_array of c_obj array
| C_list of c_obj list
| C_obj of (string -> c_obj -> c_obj)
| C_string of string
| C_enum of c_enum_tag
exception BadArgs of string
exception BadMethodName of c_obj * string * string
exception NotObject of c_obj
exception NotEnumType of c_obj
exception LabelNotFromThisEnum of c_obj
let invoke obj = match obj with C_obj o -> o | _ -> raise (NotObject obj)
let fnhelper fin f arg =
let args = match arg with C_list l -> l | C_void -> [] | _ -> [ arg ] in
match f args with
[] -> C_void
| [ x ] -> (if fin then Gc.finalise
(fun x -> ignore ((invoke x) "~" C_void)) x) ; x
| lst -> C_list lst
let rec get_int x =
match x with
C_char c
| C_uchar c -> (int_of_char c)
| C_short s
| C_ushort s
| C_int s -> s
| C_uint u
| C_int32 u -> (Int32.to_int u)
| C_int64 u -> (Int64.to_int u)
| C_float f -> (int_of_float f)
| C_double d -> (int_of_float d)
| C_ptr (p,q) -> (Int64.to_int p)
| C_obj o -> (try (get_int (o "int" C_void))
with _ -> (get_int (o "&" C_void)))
| _ -> raise (Failure "Can't convert to int")
let addr_of obj = (invoke obj) "&" C_void
let _ = Callback.register "caml_obj_ptr" addr_of

27
SWIG/Lib/ocaml/mliheading.swg Normal file
View file

@ -0,0 +1,27 @@
type c_obj =
C_void
| C_bool of bool
| C_char of char
| C_uchar of char
| C_short of int
| C_ushort of int
| C_int of int
| C_uint of int32
| C_int32 of int32
| C_int64 of int64
| C_float of float
| C_double of float
| C_ptr of int64 * int64
| C_array of c_obj array
| C_list of c_obj list
| C_obj of (string -> c_obj -> c_obj)
| C_string of string
| C_enum of c_enum_tag
exception BadArgs of string
exception BadMethodName of c_obj * string * string
exception NotObject of c_obj
exception NotEnumType of c_obj
exception LabelNotFromThisEnum of c_obj
val invoke : c_obj -> (string -> c_obj -> c_obj)
val get_int : c_obj -> int

32
SWIG/Lib/ocaml/ocaml.i Normal file
View file

@ -0,0 +1,32 @@
/* SWIG Configuration File for Ocaml. -*-c-*-
Modified from mzscheme.i
This file is parsed by SWIG before reading any other interface
file. */
/* Insert ML/MLI Common stuff */
%insert(mli) "mliheading.swg"
%insert(ml) "mlheading.swg"
/* Insert common stuff */
%insert(runtime) "common.swg"
/* Include headers */
%insert(runtime) "ocamldec.swg"
/*#ifndef SWIG_NOINCLUDE*/
%insert(runtime) "ocaml.swg"
/*#endif*/
/* Definitions */
#define SWIG_malloc(size) swig_malloc(size, FUNC_NAME)
#define SWIG_free(mem) free(mem)
/* Guile compatibility kludges */
#define SCM_VALIDATE_VECTOR(argnum, value) (void)0
#define SCM_VALIDATE_LIST(argnum, value) (void)0
/* Read in standard typemaps. */
%include "swig.swg"
%include "typemaps.i"
%include "typecheck.i"
%include "exception.i"

533
SWIG/Lib/ocaml/ocaml.swg Normal file
View file

@ -0,0 +1,533 @@
/* -*-c-*- */
/* SWIG pointer structure */
#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
struct custom_block_contents {
swig_type_info *type;
void *object;
char *delete_fn;
};
static void generic_delete_fn( value v ) {
CAMLparam1(v);
CAMLlocal1(x);
struct custom_block_contents *new_proxy;
value *deleter = NULL;
new_proxy = (struct custom_block_contents *)(Data_custom_val(v));
if( new_proxy->delete_fn )
deleter = caml_named_value(new_proxy->delete_fn);
if( *deleter )
x = callback( *deleter, v );
free( new_proxy->delete_fn );
CAMLreturn0;
}
static struct custom_operations makeptr_custom_ops = {
"SWIG-Wrapped Object",
generic_delete_fn,
custom_compare_default,
custom_hash_default,
custom_serialize_default,
custom_deserialize_default
};
static value _wrap_delete_void( value v ) {
CAMLparam0();
CAMLreturn(Val_unit);
}
/* Cast a pointer if possible; returns 1 if successful */
static int
SWIG_Cast (void *source, swig_type_info *source_type,
void **ptr, swig_type_info *dest_type)
{
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. */
if( !dest_type || !source_type ) {
*ptr = source;
return 0;
} else {
swig_type_info *tc =
SWIG_TypeCheck( (char *)source_type->name, dest_type );
if( tc ) {
*ptr = SWIG_TypeCast( tc, source );
return 0;
} else
return -1;
}
} else {
*ptr = source;
return 0;
}
}
/* Return 0 if successful. */
SWIGSTATIC int
SWIG_GetPtr(void *inptr, void **outptr,
swig_type_info *intype, swig_type_info *outtype) {
CAMLparam0();
if (intype) {
return !SWIG_Cast(inptr, intype,
outptr, outtype);
} else {
*outptr = inptr;
return 0;
}
}
static void caml_print_list( value v );
static void caml_print_val( value v ) {
switch( Tag_val(v) ) {
case C_bool:
if( Bool_val(Field(v,0)) ) fprintf( stderr, "true " );
else fprintf( stderr, "false " );
break;
case C_char:
case C_uchar:
fprintf( stderr, "'%c' (\\%03d) ",
(Int_val(Field(v,0)) >= ' ' &&
Int_val(Field(v,0)) < 127) ? Int_val(Field(v,0)) : '.',
Int_val(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:
fprintf( stderr, "PTR(%p) ", caml_ptr_val(v,0) );
break;
case C_array:
{
unsigned int i;
for( i = 0; i < Wosize_val( Field(v,0) ); i++ )
caml_print_val( Field(Field(v,0),i) );
}
break;
case C_list:
caml_print_list( Field(v,0) );
break;
case C_obj:
fprintf( stderr, "OBJ(%p) ", (void *)Field(v,0) );
break;
case C_string:
fprintf( stderr, "'%s' ", (char *)caml_ptr_val(v,0) );
break;
}
}
static void caml_print_list( value v ) {
CAMLparam1(v);
while( v && Is_block(v) ) {
fprintf( stderr, "[ " );
caml_print_val( Field(v,0) );
fprintf( stderr, "]\n" );
v = Field(v,1);
}
}
static value caml_list_nth( value lst, int n ) {
CAMLparam1(lst);
int i = 0;
while( i < n && lst && Is_block(lst) ) {
i++; lst = Field(lst,1);
}
if( lst == Val_unit ) CAMLreturn(Val_unit);
else CAMLreturn(Field(lst,0));
}
static value caml_list_append( value lst, value elt ) {
CAMLparam2(lst,elt);
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 = alloc_tuple(2);
Store_field(v,1,vt);
v = vt;
} else {
v = lh = alloc_tuple(2);
}
Store_field(v,0,Field(lst,0));
lst = Field(lst,1);
}
if( v && Is_block(v) ) {
vt = alloc_tuple(2);
Store_field(v,1,vt);
v = vt;
} else {
v = lh = alloc_tuple(2);
}
Store_field(v,0,elt);
Store_field(v,1,Val_unit);
CAMLreturn(lh);
}
static int caml_list_length( value lst ) {
CAMLparam1(lst);
int i = 0;
while( lst && Is_block(lst) ) { i++; lst = Field(lst,1); }
CAMLreturn(i);
}
#ifdef __cplusplus
namespace caml {
extern "C"
#endif
value alloc(int,int);
#ifdef __cplusplus
};
#endif
#ifdef __cplusplus
extern "C"
#endif
value caml_swig_alloc(int x,int y) {
#ifdef __cplusplus
using namespace caml;
#endif
return alloc(x,y);
}
static value caml_val_bool( int b ) {
CAMLparam0();
CAMLlocal1(bv);
bv = caml_swig_alloc(1,C_bool);
Store_field(bv,0,Val_bool(b));
CAMLreturn(bv);
}
static value caml_val_char( char c ) {
CAMLparam0();
CAMLlocal1(cv);
cv = caml_swig_alloc(1,C_char);
Store_field(cv,0,Val_int(c));
CAMLreturn(cv);
}
static value caml_val_uchar( unsigned char uc ) {
CAMLparam0();
CAMLlocal1(ucv);
ucv = caml_swig_alloc(1,C_uchar);
Store_field(ucv,0,Val_int(uc));
CAMLreturn(ucv);
}
static value caml_val_short( short s ) {
CAMLparam0();
CAMLlocal1(sv);
sv = caml_swig_alloc(1,C_short);
Store_field(sv,0,Val_int(s));
CAMLreturn(sv);
}
static value caml_val_ushort( unsigned short us ) {
CAMLparam0();
CAMLlocal1(usv);
usv = caml_swig_alloc(1,C_ushort);
Store_field(usv,0,Val_int(us));
CAMLreturn(usv);
}
static value caml_val_int( int i ) {
CAMLparam0();
CAMLlocal1(iv);
iv = caml_swig_alloc(1,C_int);
Store_field(iv,0,Val_int(i));
CAMLreturn(iv);
}
static value caml_val_uint( unsigned int ui ) {
CAMLparam0();
CAMLlocal1(uiv);
uiv = caml_swig_alloc(1,C_int);
Store_field(uiv,0,Val_int(ui));
CAMLreturn(uiv);
}
static value caml_val_long( long l ) {
CAMLparam0();
CAMLlocal1(lv);
lv = caml_swig_alloc(1,C_int64);
Store_field(lv,0,copy_int64(l));
CAMLreturn(lv);
}
static value caml_val_ulong( unsigned long ul ) {
CAMLparam0();
CAMLlocal1(ulv);
ulv = caml_swig_alloc(1,C_int64);
Store_field(ulv,0,copy_int64(ul));
CAMLreturn(ulv);
}
static value caml_val_float( float f ) {
CAMLparam0();
CAMLlocal1(fv);
fv = caml_swig_alloc(1,C_float);
Store_field(fv,0,copy_double(f));
CAMLreturn(fv);
}
static value caml_val_double( double d ) {
CAMLparam0();
CAMLlocal1(fv);
fv = caml_swig_alloc(1,C_double);
Store_field(fv,0,copy_double(d));
CAMLreturn(fv);
}
static value caml_val_ptr( void *p, swig_type_info *info ) {
CAMLparam0();
CAMLlocal1(vv);
vv = caml_swig_alloc(2,C_ptr);
Store_field(vv,0,copy_int64((long)p));
Store_field(vv,1,copy_int64((long)info));
CAMLreturn(vv);
}
static value caml_val_string( char *p ) {
CAMLparam0();
CAMLlocal1(vv);
if( !p ) CAMLreturn(caml_val_ptr( (void *)p, 0 ));
vv = caml_swig_alloc(1,C_string);
Store_field(vv,0,copy_string(p));
CAMLreturn(vv);
}
static value caml_val_string_len( char *p, int len ) {
CAMLparam0();
CAMLlocal1(vv);
if( !p || len < 0 ) CAMLreturn(caml_val_ptr( (void *)p, 0 ));
vv = caml_swig_alloc(1,C_string);
Store_field(vv,0,alloc_string(len));
memcpy(String_val(Field(vv,0)),p,len);
CAMLreturn(vv);
}
static value caml_val_obj( void *v, char *object_type ) {
CAMLparam0();
CAMLreturn(callback2(*caml_named_value("caml_create_object_fn"),
caml_val_ptr(v,SWIG_TypeQuery(object_type)),
copy_string(object_type)));
}
static long caml_long_val_full( value v, char *name ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( Tag_val(v) ) {
case C_bool:
case C_char:
case C_uchar:
case C_short:
case C_ushort:
case C_int:
CAMLreturn(Int_val(Field(v,0)));
case C_uint:
case C_int32:
CAMLreturn(Int32_val(Field(v,0)));
case C_int64:
CAMLreturn((long)Int64_val(Field(v,0)));
case C_float:
case C_double:
CAMLreturn((long)Double_val(Field(v,0)));
case C_string:
CAMLreturn((long)String_val(Field(v,0)));
case C_ptr:
CAMLreturn((long)Int64_val(Field(Field(v,0),0)));
case C_enum: {
CAMLlocal1(ret);
value *enum_to_int = caml_named_value(SWIG_MODULE "_enum_to_int");
if( !name ) failwith( "Not an enum conversion" );
ret = callback2(*enum_to_int,*caml_named_value(name),v);
CAMLreturn(caml_long_val(ret));
}
default:
failwith("No conversion to int");
}
}
static long caml_long_val( value v ) {
return caml_long_val_full(v,0);
}
static double caml_double_val( value v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0.0;
switch( Tag_val(v) ) {
case C_bool:
case C_char:
case C_uchar:
case C_short:
case C_ushort:
case C_int:
CAMLreturn(Int_val(Field(v,0)));
case C_uint:
case C_int32:
CAMLreturn(Int32_val(Field(v,0)));
case C_int64:
CAMLreturn(Int64_val(Field(v,0)));
case C_float:
case C_double:
CAMLreturn(Double_val(Field(v,0)));
default:
fprintf( stderr, "Unknown block tag %d\n", Tag_val(v) );
failwith("No conversion to double");
}
}
static int caml_ptr_val_internal( value v, void **out,
swig_type_info *descriptor ) {
CAMLparam1(v);
void *outptr = NULL;
swig_type_info *outdescr = NULL;
if( !Is_block(v) ) return -1;
switch( Tag_val(v) ) {
case C_obj:
return caml_ptr_val_internal
(callback(*caml_named_value("caml_obj_ptr"),v),out,descriptor);
case C_string:
outptr = (void *)String_val(Field(v,0));
break;
case C_ptr:
outptr = (void *)(long)Int64_val(Field(v,0));
outdescr = (swig_type_info *)(long)Int64_val(Field(v,1));
break;
default:
outptr = (void *)caml_long_val(v);
break;
}
CAMLreturn(SWIG_GetPtr(outptr,out,descriptor,outdescr));
}
static void *caml_ptr_val( value v, swig_type_info *descriptor ) {
CAMLparam0();
void *out = NULL;
if( !caml_ptr_val_internal( v, &out, descriptor ) )
CAMLreturn(out);
else
failwith( "No appropriate conversion found." );
}
static char *caml_string_val( value v ) {
return (char *)caml_ptr_val( v, 0 );
}
static int caml_bool_check( value v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( Tag_val(v) ) {
case C_bool:
case C_ptr:
case C_string:
CAMLreturn(1);
default:
CAMLreturn(0);
}
}
static int caml_int_check( value v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( 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);
}
}
static int caml_float_check( value v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( Tag_val(v) ) {
case C_float:
case C_double:
CAMLreturn(1);
default:
CAMLreturn(0);
}
}
static int caml_ptr_check( value v ) {
CAMLparam1(v);
if( !Is_block(v) ) return 0;
switch( Tag_val(v) ) {
case C_string:
case C_ptr:
case C_int64:
CAMLreturn(1);
default:
CAMLreturn(0);
}
}
#ifdef __cplusplus
}
#endif

106
SWIG/Lib/ocaml/ocamldec.swg Normal file
View file

@ -0,0 +1,106 @@
/* -*-c-*-
* -----------------------------------------------------------------------
* ocaml/ocamldec.swg
* Copyright (C) 2000, 2001 Matthias Koeppe
*
* Ocaml runtime code -- declarations
* ----------------------------------------------------------------------- */
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#ifdef __cplusplus
extern "C" {
#endif
#define alloc caml_alloc
#include <caml/alloc.h>
#include <caml/custom.h>
#include <caml/mlvalues.h>
#include <caml/memory.h>
#include <caml/callback.h>
#include <caml/fail.h>
#include <caml/misc.h>
#undef alloc
#if defined(SWIG_NOINCLUDE)
# define SWIGSTATIC
#elif defined(SWIG_GLOBAL)
# define SWIGSTATIC
#else
# define SWIGSTATIC static
#endif
#define __OCAML__SWIG__MAXVALUES 6
SWIGSTATIC int
SWIG_GetPtr(void *source, void **result, swig_type_info *type, swig_type_info *result_type);
SWIGSTATIC void *
SWIG_MustGetPtr (value v, swig_type_info *type);
static value _wrap_delete_void( value );
static int enum_to_int( char *name, value v );
static value int_to_enum( char *name, int v );
static value caml_list_nth( value lst, int n );
static value caml_list_append( value lst, value elt );
static int caml_list_length( value lst );
static value caml_val_char( char c );
static value caml_val_uchar( unsigned char c );
static value caml_val_short( short s );
static value caml_val_ushort( unsigned short s );
static value caml_val_int( int x );
static value caml_val_uint( unsigned int x );
static value caml_val_long( long x );
static value caml_val_ulong( unsigned long x );
static value caml_val_float( float f );
static value caml_val_double( double d );
static value caml_val_ptr( void *p, swig_type_info *descriptor );
static value caml_val_string( char *str );
static value caml_val_string_len( char *str, int len );
static long caml_long_val( value v );
static double caml_double_val( value v );
static int caml_ptr_val_internal( value v, void **out,
swig_type_info *descriptor );
static void *caml_ptr_val( value v, swig_type_info *descriptor );
static char *caml_string_val( value v );
#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
/* mzschemedec.swg ends here */

17
SWIG/Lib/ocaml/std_common.i Normal file
View file

@ -0,0 +1,17 @@
// -*- C++ -*-
// SWIG typemaps for STL - common utilities
// Art Yerkes
// Modified from: Luigi Ballabio
// Aug 3, 2002
//
// Ocaml implementation
%{
#include <string>
value SwigString_FromString(const std::string& s) {
return caml_val_string((char *)s.c_str());
}
std::string SwigString_AsString(value o) {
return std::string((char *)caml_ptr_val(o,0));
}
%}

65
SWIG/Lib/ocaml/std_complex.i Normal file
View file

@ -0,0 +1,65 @@
// -*- C++ -*-
#ifndef __swig_std_complex_i__
#define __swig_std_complex_i__
#ifdef SWIG
%{
#include <complex>
%}
namespace std
{
template <class T> class complex;
%define specialize_std_complex(T)
%typemap(in) complex<T> {
if (PyComplex_Check($input)) {
$1 = std::complex<T>(PyComplex_RealAsDouble($input),
PyComplex_ImagAsDouble($input));
} else if (PyFloat_Check($input)) {
$1 = std::complex<T>(PyFloat_AsDouble($input), 0);
} else if (PyInt_Check($input)) {
$1 = std::complex<T>(PyInt_AsLong($input), 0);
}
else {
PyErr_SetString(PyExc_TypeError,"Expected a complex");
SWIG_fail;
}
}
%typemap(in) const complex<T>& (std::complex<T> temp) {
if (PyComplex_Check($input)) {
temp = std::complex<T>(PyComplex_RealAsDouble($input),
PyComplex_ImagAsDouble($input));
$1 = &temp;
} else if (PyFloat_Check($input)) {
temp = std::complex<T>(PyFloat_AsDouble($input), 0);
$1 = &temp;
} else if (PyInt_Check($input)) {
temp = std::complex<T>(PyInt_AsLong($input), 0);
$1 = &temp;
} else {
PyErr_SetString(PyExc_TypeError,"Expected a complex");
SWIG_fail;
}
}
%typemap(out) complex<T> {
$result = PyComplex_FromDoubles($1.real(), $1.imag());
}
%typemap(out) const complex<T> & {
$result = PyComplex_FromDoubles($1->real(), $1->imag());
}
%enddef
specialize_std_complex(double);
specialize_std_complex(float);
}
#endif // SWIG
#endif //__swig_std_complex_i__

23
SWIG/Lib/ocaml/std_deque.i Normal file
View file

@ -0,0 +1,23 @@
/* Default std_deque wrapper */
%module std_deque
%rename(__getitem__) std::deque::getitem;
%rename(__setitem__) std::deque::setitem;
%rename(__delitem__) std::deque::delitem;
%rename(__getslice__) std::deque::getslice;
%rename(__setslice__) std::deque::setslice;
%rename(__delslice__) std::deque::delslice;
%extend std::deque {
int __len__() {
return (int) self->size();
}
int __nonzero__() {
return ! self->empty();
}
void append(const T &x) {
self->push_back(x);
}
};
%include "_std_deque.i"

246
SWIG/Lib/ocaml/std_list.i Normal file
View file

@ -0,0 +1,246 @@
// -*- C++ -*-
// SWIG typemaps for std::list types
// Art Yerkes
// Modified from: Jing Cao
// Aug 1st, 2002
//
// Python implementation
%module std_list
%{
#include <list>
#include <stdexcept>
%}
%include "exception.i"
%exception std::list::__getitem__ {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
%exception std::list::__setitem__ {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
%exception std::list::__delitem__ {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
namespace std{
template<class T> class list
{
public:
typedef T &reference;
typedef const T& const_reference;
typedef T &iterator;
typedef const T& const_iterator;
list();
list(unsigned int size, const T& value = T());
list(const list<T> &);
~list();
void assign(unsigned int n, const T& value);
void swap(list<T> &x);
const_reference front();
const_reference back();
const_iterator begin();
const_iterator end();
void resize(unsigned int n, T c = T());
bool empty() const;
void push_front(const T& x);
void push_back(const T& x);
void pop_front();
void pop_back();
void clear();
unsigned int size() const;
unsigned int max_size() const;
void resize(unsigned int n, const T& value);
void remove(const T& value);
void unique();
void reverse();
void sort();
%extend
{
const_reference __getitem__(int i)
{
std::list<T>::iterator first = self->begin();
int size = int(self->size());
if (i<0) i += size;
if (i>=0 && i<size)
{
for (int k=0;k<i;k++)
{
first++;
}
return *first;
}
else throw std::out_of_range("list index out of range");
}
void __setitem__(int i, const T& x)
{
std::list<T>::iterator first = self->begin();
int size = int(self->size());
if (i<0) i += size;
if (i>=0 && i<size)
{
for (int k=0;k<i;k++)
{
first++;
}
*first = x;
}
else throw std::out_of_range("list index out of range");
}
void __delitem__(int i)
{
std::list<T>::iterator first = self->begin();
int size = int(self->size());
if (i<0) i += size;
if (i>=0 && i<size)
{
for (int k=0;k<i;k++)
{
first++;
}
self->erase(first);
}
else throw std::out_of_range("list index out of range");
}
std::list<T> __getslice__(int i,int j)
{
std::list<T>::iterator first = self->begin();
std::list<T>::iterator end = self->end();
int size = int(self->size());
if (i<0) i += size;
if (j<0) j += size;
if (i<0) i = 0;
if (j>size) j = size;
if (i>=j) i=j;
if (i>=0 && i<size && j>=0)
{
for (int k=0;k<i;k++)
{
first++;
}
for (int m=0;m<j;m++)
{
end++;
}
std::list<T> tmp(j-i);
if (j>i) std::copy(first,end,tmp.begin());
return tmp;
}
else throw std::out_of_range("list index out of range");
}
void __delslice__(int i,int j)
{
std::list<T>::iterator first = self->begin();
std::list<T>::iterator end = self->end();
int size = int(self->size());
if (i<0) i += size;
if (j<0) j += size;
if (i<0) i = 0;
if (j>size) j = size;
for (int k=0;k<i;k++)
{
first++;
}
for (int m=0;m<=j;m++)
{
end++;
}
self->erase(first,end);
}
void __setslice__(int i,int j, const std::list<T>& v)
{
std::list<T>::iterator first = self->begin();
std::list<T>::iterator end = self->end();
int size = int(self->size());
if (i<0) i += size;
if (j<0) j += size;
if (i<0) i = 0;
if (j>size) j = size;
for (int k=0;k<i;k++)
{
first++;
}
for (int m=0;m<=j;m++)
{
end++;
}
if (int(v.size()) == j-i)
{
std::copy(v.begin(),v.end(),first);
}
else {
self->erase(first,end);
if (i+1 <= self->size())
{
first = self->begin();
for (int k=0;k<i;k++)
{
first++;
}
self->insert(first,v.begin(),v.end());
}
else self->insert(self->end(),v.begin(),v.end());
}
}
unsigned int __len__()
{
return self->size();
}
bool __nonzero__()
{
return !(self->empty());
}
void append(const T& x)
{
self->push_back(x);
}
void pop()
{
self->pop_back();
}
};
};
}

55
SWIG/Lib/ocaml/std_string.i Normal file
View file

@ -0,0 +1,55 @@
// -*- C++ -*-
// SWIG typemaps for std::string
// Art Yerkes
// Modified from: Luigi Ballabio
// Apr 8, 2002
//
// Ocaml implementation
// ------------------------------------------------------------------------
// std::string is typemapped by value
// This can prevent exporting methods which return a string
// in order for the user to modify it.
// However, I think I'll wait until someone asks for it...
// ------------------------------------------------------------------------
%include exception.i
%{
#include <string>
%}
namespace std {
class string;
/* Overloading check */
%typemap(typecheck) string = char *;
%typemap(typecheck) const string & = char *;
%typemap(in) string {
if (caml_ptr_check($input))
$1 = std::string((char *)caml_ptr_val($input,0));
else
SWIG_exception(SWIG_TypeError, "string expected");
}
%typemap(in) const string & (std::string temp) {
if (caml_ptr_check($input)) {
temp = std::string((char *)caml_ptr_val($input,0));
$1 = &temp;
} else {
SWIG_exception(SWIG_TypeError, "string expected");
}
}
%typemap(out) string {
$result = caml_val_ptr((char *)$1.c_str(),0);
}
%typemap(out) const string & {
$result = caml_val_ptr((char *)$1->c_str(),0);
}
}

90
SWIG/Lib/ocaml/std_vector.i Normal file
View file

@ -0,0 +1,90 @@
// -*- C++ -*-
// SWIG typemaps for std::vector types
// Art Yerkes
// Modified from: Luigi Ballabio
// Apr 8, 2002
//
// Ocaml implementation
%include std_common.i
%include exception.i
// __getitem__ is required to raise an IndexError for for-loops to work
// other methods which can raise are made to throw an IndexError as well
%exception std::vector::__getitem__ {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
%exception std::vector::__setitem__ {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
%exception std::vector::__delitem__ {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
%exception std::vector::pop {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
// ------------------------------------------------------------------------
// std::vector
//
// The aim of all that follows would be to integrate std::vector with
// Python as much as possible, namely, to allow the user to pass and
// be returned Python tuples or lists.
// const declarations are used to guess the intent of the function being
// exported; therefore, the following rationale is applied:
//
// -- f(std::vector<T>), f(const std::vector<T>&), f(const std::vector<T>*):
// the parameter being read-only, either a Python sequence or a
// previously wrapped std::vector<T> can be passed.
// -- f(std::vector<T>&), f(std::vector<T>*):
// the parameter must be modified; therefore, only a wrapped std::vector
// can be passed.
// -- std::vector<T> f():
// the vector is returned by copy; therefore, a Python sequence of T:s
// is returned which is most easily used in other Python functions
// -- std::vector<T>& f(), std::vector<T>* f(), const std::vector<T>& f(),
// const std::vector<T>* f():
// the vector is returned by reference; therefore, a wrapped std::vector
// is returned
// ------------------------------------------------------------------------
%{
#include <vector>
#include <algorithm>
#include <stdexcept>
%}
// exported class
namespace std {
template<class T> class vector {
};
// Partial specialization for vectors of pointers. [ beazley ]
template<class T> class vector<T*> {
};
}

9
SWIG/Lib/ocaml/stl.i Normal file
View file

@ -0,0 +1,9 @@
//
// SWIG typemaps for STL types
// Luigi Ballabio and Manu ???
// Apr 26, 2002
//
%include std_string.i
%include std_vector.i

100
SWIG/Lib/ocaml/swig.ml Normal file
View file

@ -0,0 +1,100 @@
open Pcaml ;;
let lap x y = x :: y
let c_ify e loc =
match e with
<:expr< $int:_$ >> -> <:expr< (C_int $e$) >>
| <:expr< $str:_$ >> -> <:expr< (C_string $e$) >>
| <:expr< $chr:_$ >> -> <:expr< (C_char $e$) >>
| <:expr< $flo:_$ >> -> <:expr< (C_double $e$) >>
| _ -> <:expr< $e$ >>
let rec mk_list args l f =
match args with
[] -> (let loc = l in <:expr< [] >>)
| x :: xs ->
(let loc = MLast.loc_of_expr x in
<:expr< [ ($f x loc$) ] @ ($mk_list xs loc f$) >>)
EXTEND
expr:
[ [ e1 = expr ; "'" ; "[" ; e2 = expr ; "]" ->
<:expr< (invoke $e1$) "[]" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "->" ; e2 = expr LEVEL "simple" ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
<:expr< (invoke $e1$) $e2$ (C_list $mk_list args loc c_ify$) >>
| e1 = expr ; "'" ; "." ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
<:expr< (invoke $e1$) "()" (C_list $mk_list args loc c_ify$) >>
| e1 = expr ; "'" ; "->" ->
<:expr< (invoke ((invoke $e1$) "->" C_void)) >>
| e1 = expr ; "'" ; "++" ->
<:expr< (invoke $e1$) "++" C_void >>
| e1 = expr ; "'" ; "--" ->
<:expr< (invoke $e1$) "--" C_void >>
| e1 = expr ; "'" ; "-" ; e2 = expr ->
<:expr< (invoke $e1$) "-" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "+" ; e2 = expr -> <:expr< (invoke $e1$) "+" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "*" ; e2 = expr -> <:expr< (invoke $e1$) "*" (C_list [ $c_ify e2 loc$ ]) >>
| "'" ; "&" ; e1 = expr ->
<:expr< (invoke $e1$) "&" C_void >>
| "'" ; "!" ; e1 = expr ->
<:expr< (invoke $e1$) "!" C_void >>
| "'" ; "~" ; e1 = expr ->
<:expr< (invoke $e1$) "~" C_void >>
| e1 = expr ; "'" ; "/" ; e2 = expr ->
<:expr< (invoke $e1$) "/" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "%" ; e2 = expr ->
<:expr< (invoke $e1$) "%" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "lsl" ; e2 = expr ->
<:expr< (invoke $e1$) ("<" ^ "<") (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "lsr" ; e2 = expr ->
<:expr< (invoke $e1$) (">" ^ ">") (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "<" ; e2 = expr ->
<:expr< (invoke $e1$) "<" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "<=" ; e2 = expr ->
<:expr< (invoke $e1$) "<=" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; ">" ; e2 = expr ->
<:expr< (invoke $e1$) ">" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; ">=" ; e2 = expr ->
<:expr< (invoke $e1$) ">=" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "==" ; e2 = expr ->
<:expr< (invoke $e1$) "==" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "!=" ; e2 = expr ->
<:expr< (invoke $e1$) "!=" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "&" ; e2 = expr ->
<:expr< (invoke $e1$) "&" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "^" ; e2 = expr ->
<:expr< (invoke $e1$) "^" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "|" ; e2 = expr ->
<:expr< (invoke $e1$) "|" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "&&" ; e2 = expr ->
<:expr< (invoke $e1$) "&&" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "||" ; e2 = expr ->
<:expr< (invoke $e1$) "||" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "=" ; e2 = expr ->
<:expr< (invoke $e1$) "=" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "+=" ; e2 = expr ->
<:expr< (invoke $e1$) "+=" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "-=" ; e2 = expr ->
<:expr< (invoke $e1$) "-=" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "*=" ; e2 = expr ->
<:expr< (invoke $e1$) "*=" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "/=" ; e2 = expr ->
<:expr< (invoke $e1$) "/=" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "%=" ; e2 = expr ->
<:expr< (invoke $e1$) "%=" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "lsl" ; "=" ; e2 = expr ->
<:expr< (invoke $e1$) ("<" ^ "<=") (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "lsr" ; "=" ; e2 = expr ->
<:expr< (invoke $e1$) (">" ^ ">=") (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "&=" ; e2 = expr ->
<:expr< (invoke $e1$) "&=" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "^=" ; e2 = expr ->
<:expr< (invoke $e1$) "^=" (C_list [ $c_ify e2 loc$ ]) >>
| e1 = expr ; "'" ; "|=" ; e2 = expr ->
<:expr< (invoke $e1$) "|=" (C_list [ $c_ify e2 loc$ ]) >>
| "'" ; e = expr -> c_ify e loc
| f = expr ; "'" ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
let l = mk_list args loc c_ify in
<:expr< $f$ (C_list $l$) >>
] ] ;
END ;;

175
SWIG/Lib/ocaml/typecheck.i Normal file
View file

@ -0,0 +1,175 @@
/* -*- C++ -*- */
/* Type checking code adapted from python backend. */
/* ------------------------------------------------------------
* Typechecking rules
* ------------------------------------------------------------ */
%typecheck(SWIG_TYPECHECK_INTEGER) char, signed char, const char &, const signed char & {
if( !Is_block($input) ) $1 = 0;
else {
switch( Tag_val($input) ) {
case C_char: $1 = 1;
default: $1 = 0;
}
}
}
%typecheck(SWIG_TYPECHECK_INTEGER) unsigned char, const unsigned char & {
if( !Is_block($input) ) $1 = 0;
else {
switch( Tag_val($input) ) {
case C_uchar: $1 = 1;
default: $1 = 0;
}
}
}
%typecheck(SWIG_TYPECHECK_INTEGER) short, signed short, const short &, const signed short & {
if( !Is_block($input) ) $1 = 0;
else {
switch( Tag_val($input) ) {
case C_short: $1 = 1;
default: $1 = 0;
}
}
}
%typecheck(SWIG_TYPECHECK_INTEGER) unsigned short, const unsigned short & {
if( !Is_block($input) ) $1 = 0;
else {
switch( Tag_val($input) ) {
case C_ushort: $1 = 1;
default: $1 = 0;
}
}
}
// XXX arty
// Will move enum SWIGTYPE later when I figure out what to do with it...
%typecheck(SWIG_TYPECHECK_INTEGER) int, signed int, const int &, const signed int &, enum SWIGTYPE {
if( !Is_block($input) ) $1 = 0;
else {
switch( Tag_val($input) ) {
case C_int: $1 = 1;
default: $1 = 0;
}
}
}
%typecheck(SWIG_TYPECHECK_INTEGER) unsigned int, const unsigned int & {
if( !Is_block($input) ) $1 = 0;
else {
switch( Tag_val($input) ) {
case C_uint: $1 = 1;
case C_int32: $1 = 1;
default: $1 = 0;
}
}
}
%typecheck(SWIG_TYPECHECK_INTEGER) long, signed long, unsigned long, long long, signed long long, unsigned long long, const long &, const signed long &, const unsigned long &, const long long &, const signed long long &, const unsigned long long & {
if( !Is_block($input) ) $1 = 0;
else {
switch( Tag_val($input) ) {
case C_int64: $1 = 1;
default: $1 = 0;
}
}
}
%typecheck(SWIG_TYPECHECK_INTEGER) bool, oc_bool, BOOL, const bool &, const oc_bool &, const BOOL & {
if( !Is_block($input) ) $1 = 0;
else {
switch( Tag_val($input) ) {
case C_bool: $1 = 1;
default: $1 = 0;
}
}
}
%typecheck(SWIG_TYPECHECK_DOUBLE) float, const float & {
if( !Is_block($input) ) $1 = 0;
else {
switch( Tag_val($input) ) {
case C_float: $1 = 1;
default: $1 = 0;
}
}
}
%typecheck(SWIG_TYPECHECK_DOUBLE) double, const double & {
if( !Is_block($input) ) $1 = 0;
else {
switch( Tag_val($input) ) {
case C_double: $1 = 1;
default: $1 = 0;
}
}
}
%typecheck(SWIG_TYPECHECK_STRING) char * {
if( !Is_block($input) ) $1 = 0;
else {
switch( Tag_val($input) ) {
case C_string: $1 = 1; break;
case C_ptr: {
swig_type_info *typeinfo =
(swig_type_info *)(long)Int64_val(Field($input,1));
$1 = SWIG_TypeCheck("char *",typeinfo) ||
SWIG_TypeCheck("signed char *",typeinfo) ||
SWIG_TypeCheck("unsigned char *",typeinfo) ||
SWIG_TypeCheck("const char *",typeinfo) ||
SWIG_TypeCheck("const signed char *",typeinfo) ||
SWIG_TypeCheck("const unsigned char *",typeinfo) ||
SWIG_TypeCheck("std::string",typeinfo);
} break;
default: $1 = 0; break;
}
}
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] {
void *ptr;
$1 = !caml_ptr_val_internal($input, &ptr,$descriptor);
}
#if 0
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE {
void *ptr;
$1 = !caml_ptr_val_internal($input, &ptr, $&1_descriptor);
}
#endif
%typecheck(SWIG_TYPECHECK_VOIDPTR) void * {
void *ptr;
$1 = !caml_ptr_val_internal($input, &ptr, 0);
}
/* ------------------------------------------------------------
* Exception handling
* ------------------------------------------------------------ */
%typemap(throws) int,
long,
short,
unsigned int,
unsigned long,
unsigned short {
SWIG_exception($1,"Thrown exception from C++ (int)");
}
%typemap(throws) SWIGTYPE CLASS {
$&1_ltype temp = new $1_ltype($1);
SWIG_exception((int)temp,"Thrown exception from C++ (object)");
}
%typemap(throws) SWIGTYPE {
SWIG_exception(0,"Thrown exception from C++ (unknown)");
}
%typemap(throws) char * {
SWIG_exception(0,$1);
}

174
SWIG/Lib/ocaml/typemaps.i Normal file
View file

@ -0,0 +1,174 @@
/* typemaps.i --- ocaml typemaps -*- c -*-
Ocaml conversion by Art Yerkes, modified from mzscheme/typemaps.i
Copyright 2000, 2001 Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>
Based on code written by Oleg Tolmatcev.
$Id$
*/
/* The Ocaml module handles all types uniformly via typemaps. Here
are the definitions. */
/* Pointers */
%typemap(ocaml,in) void * {
$1 = caml_ptr_val($input,$descriptor);
}
%typemap(ocaml,varin) void * {
$1 = ($ltype)caml_ptr_val($input,$descriptor);
}
%typemap(ocaml,in) char *, signed char *, unsigned char *, const char *, const signed char *, const unsigned char * {
$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);
}
%typemap(ocaml,varout) void * {
$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,$descriptor);
}
%typemap(ocaml,out) SWIGTYPE * {
value *fromval = caml_named_value("create_$*1_type_from_ptr");
if( fromval ) {
$result = callback(*fromval,caml_val_ptr((void *)$1,$descriptor));
} else {
$result = caml_val_ptr ((void *)$1,$descriptor);
}
}
%typemap(ocaml,varin) SWIGTYPE * {
$1 = ($ltype)caml_ptr_val($input,$descriptor);
}
%typemap(ocaml,varout) SWIGTYPE * {
value *fromval = caml_named_value("create_$*1_type_from_ptr");
if( fromval ) {
$result = callback(*fromval,caml_val_ptr((void *)$1,$descriptor));
} else {
$result = caml_val_ptr ((void *)$1,$descriptor);
}
}
/* C++ References */
#ifdef __cplusplus
%typemap(ocaml,in) SWIGTYPE & {
$1 = ($ltype) caml_ptr_val($input,$descriptor);
}
%typemap(ocaml,out) SWIGTYPE & {
value *fromval = caml_named_value("create_$*1_ltype_from_ptr");
if( fromval ) {
$result = callback(*fromval,caml_val_ptr((void *) $1,$descriptor));
} else {
$result = caml_val_ptr ((void *) $1,$descriptor);
}
}
#else
%typemap(ocaml,in) SWIGTYPE {
$1 = *(($&1_ltype) caml_ptr_val($input,$descriptor)) ;
}
%typemap(ocaml,out) SWIGTYPE {
void *temp = calloc(1,sizeof($ltype));
value *fromval = caml_named_value("create_$ltype_from_ptr");
*(($ltype *)temp) = $1;
if( fromval ) {
$result = callback(*fromval,caml_val_ptr((void *)temp,$descriptor));
} else {
$result = caml_val_ptr ((void *)temp,$descriptor);
}
}
#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
for simple types. */
%define SIMPLE_MAP(C_NAME, C_TO_MZ, MZ_TO_C)
%typemap(in) C_NAME {
$1 = MZ_TO_C($input);
}
%typemap(varin) C_NAME {
$1 = MZ_TO_C($input);
}
%typemap(out) C_NAME {
$result = C_TO_MZ($1);
}
%typemap(varout) C_NAME {
$result = C_TO_MZ($1);
}
%typemap(in) C_NAME *INPUT (C_NAME temp) {
temp = (C_NAME) MZ_TO_C($input);
$1 = &temp;
}
%typemap(in,numinputs=0) C_NAME *OUTPUT (C_NAME temp) {
$1 = &temp;
}
%typemap(argout) C_NAME *OUTPUT {
caml_list_append(swig_result,(long)*$1);
}
%enddef
SIMPLE_MAP(oc_bool, caml_val_bool, caml_long_val);
SIMPLE_MAP(bool, caml_val_bool, caml_long_val);
SIMPLE_MAP(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(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) value "$1=$input;";
%typemap (out) value "$result=$1;";