swig/Lib/mzscheme/typemaps.i

/*
 --------------------------------------------------
 argout typemaps
 convert arguments from C to Scheme
 --------------------------------------------------
 */

%{
#define MAXVALUES 6
%}

%typemap(mzscheme, argout)
    int *M_OUTPUT,
    unsigned int *M_OUTPUT,
    short *M_OUTPUT,
    unsigned short *M_OUTPUT
{
    Scheme_Object *s;
    s = scheme_make_integer(*$target);
    m_output_helper(_values, s, &_lenv);
}

%typemap(mzscheme, argout)
    long *M_OUTPUT
{
    Scheme_Object *s;
    s = scheme_make_integer_value(*$target);
    m_output_helper(_values, s, &_lenv);
}


%typemap(mzscheme, argout)
    unsigned long *M_OUTPUT
{
    Scheme_Object *s;
    s = scheme_make_integer_value_from_unsigned(*$target);
    m_output_helper(_values, s, &_lenv);
}


%typemap(mzscheme, argout)
    char *M_OUTPUT,
    unsigned char *M_OUTPUT
{
    Scheme_Object *s;
    s = scheme_make_string_without_copying(*$target);
    m_output_helper(_values, s, &_lenv);
}

%typemap(mzscheme, argout)
float *M_OUTPUT,
double *M_OUTPUT
{
    Scheme_Object *s;
    s = scheme_make_double(*$target);
    m_output_helper(_values, s, &_lenv);
}

%{
void m_output_helper(Scheme_Object **target, Scheme_Object *s, int *_lenv) {
    target[*_lenv] = s;
    (*_lenv)++;
}
%}

/*
 -------------------------------------------------
 Check the type of the MzScheme arguments and
 convert function arguments from a MzScheme to a C
 representation.
 -------------------------------------------------
 */

%typemap(mzscheme, in) char {
    if(!SCHEME_CHARP($source))
	scheme_wrong_type("$name", "character", $argnum, argc, argv);
    $target = SCHEME_CHAR_VAL($source);
}

%typemap(mzscheme, in) unsigned char {
    if(!SCHEME_CHARP($source))
	scheme_wrong_type("$name", "character", $argnum, argc, argv);
    $target = SCHEME_CHAR_VAL($source);
}

%typemap(mzscheme, in) char * {
    if(!SCHEME_STRINGP($source))
	scheme_wrong_type("$name", "string", $argnum, argc, argv);
    $target = SCHEME_STR_VAL($source);
}

%typemap(mzscheme, in) char [ANY] {
    if(!SCHEME_STRINGP($source))
	scheme_wrong_type("$name", "string", $argnum, argc, argv);
    $target = SCHEME_STR_VAL($source);
}

%typemap(mzscheme, in) int {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    $target = SCHEME_INT_VAL($source);
}

%typemap(mzscheme, in) long {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    scheme_get_int_val($source, &$target);
}

%typemap(mzscheme, in) short {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    $target = SCHEME_INT_VAL($source);
}

%typemap(mzscheme, in) unsigned int {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    $target = SCHEME_INT_VAL($source);
}

%typemap(mzscheme, in) unsigned long {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    scheme_get_unsigned_int_val($source, &$target);
}

%typemap(mzscheme, in) unsigned short {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    $target = SCHEME_INT_VAL($source);
}
/*
%typemap(mzscheme, in) long long {
    if(!SCHEME_INTP($source))
    scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    scheme_get_int_val($source, &$target);
}
*/
%typemap(mzscheme, in) float {
    if(!SCHEME_DBLP($source))
	scheme_wrong_type("$name", "double", $argnum, argc, argv);
    $target = SCHEME_DBL_VAL($source);
}

%typemap(mzscheme, in) double {
    if(SCHEME_DBLP($source))
	$target = SCHEME_DBL_VAL($source);
    else if(SCHEME_REALP($source))
	$target = scheme_real_to_double($source);
    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
/*
%typemap(mzscheme, in) long double {
    if(SCHEME_DBLP($source))
	$target = SCHEME_DBL_VAL($source);
    else if(SCHEME_REALP($source))
	$target = scheme_real_to_double($source);
    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
*/

/*
 ------------------------------------
 in typemaps for pass-by-reference
 ------------------------------------
 */

%typemap(mzscheme, in) unsigned char *(unsigned char temp) {
    if(!SCHEME_CHARP($source))
	scheme_wrong_type("$name", "character", $argnum, argc, argv);
    temp = SCHEME_STR_VAL($source);
    $target = &temp;
}

%typemap(mzscheme, in) int *(int temp) {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    temp = (int)SCHEME_INT_VAL($source);
    $target = &temp;
}

%typemap(mzscheme, in) long *(long temp) {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    scheme_get_int_val($source, &temp);
    $target = &temp;

}

%typemap(mzscheme, in) short *(short temp) {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    temp = (short)SCHEME_INT_VAL($source);
    $target = &temp;
}

%typemap(mzscheme, in) unsigned int *(unsigned temp) {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    temp = (unsigned)SCHEME_INT_VAL($source);
    $target = &temp;
}

%typemap(mzscheme, in) unsigned long *(unsigned long temp) {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    scheme_get_unsigned_int_val($source, &temp);
    $target = &temp;
}

%typemap(mzscheme, in) unsigned short *(unsigned short temp) {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    temp = (unsigned short)SCHEME_INT_VAL($source);
    $target = &temp;

}
/*
%typemap(mzscheme, in) long long *(long long temp) {
    if(!SCHEME_INTP($source))
    scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    scheme_get_int_val($source, &temp);
    $target = &temp;
}
*/
%typemap(mzscheme, in) float *(float temp) {
    if(!SCHEME_DBLP($source))
	scheme_wrong_type("$name", "double", $argnum, argc, argv);
    temp = (float)SCHEME_DBL_VAL($source);
    $target = &temp;

}

%typemap(mzscheme, in) double *(double temp) {
    if(SCHEME_DBLP($source)) {
	temp = (double)SCHEME_DBL_VAL($source);
	$target = &temp;
    }
    else if(SCHEME_REALP($source)) {
	temp = (double)scheme_real_to_double($source);
	$target = &temp;
    }
    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
/*
%typemap(mzscheme, in) long double *(long double temp) {
    if(SCHEME_DBLP($source)) {
	temp = (long double)SCHEME_DBL_VAL($source);
	$target = &temp;
    }
    else if(SCHEME_REALP($source)) {
	temp = (long double)scheme_real_to_double($source);
	$target = &temp;
    }
    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
*/

/*
 ------------------------------------
 convert return type from C to Scheme
 ------------------------------------
 */

%typemap(mzscheme, out) char {
    $target = scheme_make_character($source);
}

%typemap(mzscheme, out) unsigned char {
    $target = scheme_make_character($source);
}

%typemap(mzscheme, out) char * {
    $target = scheme_make_string_without_copying($source);
}

%typemap(mzscheme, out) char [ANY] {
    $target = scheme_make_string_without_copying($source);
}

%typemap(mzscheme, out) int {
    $target = scheme_make_integer_value($source);
}

%typemap(mzscheme, out) long {
    $target = scheme_make_integer_value($source);
}

%typemap(mzscheme, out) short {
    $target = scheme_make_integer_value($source);
}
/*
%typemap(mzscheme, out) long long {
    $target = scheme_make_integer_value($source);
}
*/
%typemap(mzscheme, out) unsigned int {
    $target = scheme_make_integer_value_from_unsigned($source);
}

%typemap(mzscheme, out) unsigned long {
    $target = scheme_make_integer_value_from_unsigned($source);
}

%typemap(mzscheme, out) unsigned short {
    $target = scheme_make_integer_value_from_unsigned($source);
}

%typemap(mzscheme, out) float {
    $target = scheme_make_double($source);
}

%typemap(mzscheme, out) double {
    $target = scheme_make_double($source);
}
/*
%typemap(mzscheme, out) long double {
    $target = scheme_make_double($source);
}
*/

/*
 -----------------------------------
 convert pointers from C to MzScheme
 -----------------------------------
 */

%typemap(mzscheme, out) int * {
    $target = scheme_make_integer_value(*$source);
}

%typemap(mzscheme, out) long * {
    $target = scheme_make_integer_value(*$source);
}

%typemap(mzscheme, out) short * {
    $target = scheme_make_integer_value(*$source);
}

/*
%typemap(mzscheme, out) long long * {
    $target = scheme_make_integer_value(*$source);
}
*/
%typemap(mzscheme, out) unsigned int * {
    $target = scheme_make_integer_value_from_unsigned(*$source);
}

%typemap(mzscheme, out) unsigned long * {
    $target = scheme_make_integer_value_from_unsigned(*$source);
}

%typemap(mzscheme, out) unsigned short * {
    $target = scheme_make_integer_value_from_unsigned(*$source);
}

%typemap(mzscheme, out) float * {
    $target = scheme_make_double(*$source);
}

%typemap(mzscheme, out) double * {
    $target = scheme_make_double(*$source);
}
/*
%typemap(mzscheme, out) long double * {
    $target = scheme_make_double(*$source);
}
*/

/*
 ------------------------------------------------------------
 Typemaps for accessing a global C variable from MzScheme
 ------------------------------------------------------------
 */

%typemap(mzscheme, varin) char {
    if(!SCHEME_CHARP($source))
	scheme_wrong_type("$name", "character", $argnum, argc, argv);
    $target = SCHEME_CHAR_VAL($source);
}

%typemap(mzscheme, varin) unsigned char {
    if(!SCHEME_CHARP($source))
	scheme_wrong_type("$name", "character", $argnum, argc, argv);
    $target = SCHEME_CHAR_VAL($source);
}

%typemap(mzscheme, varin) char * {
    if(!SCHEME_STRINGP($source))
	scheme_wrong_type("$name", "string", $argnum, argc, argv);
    $target = SCHEME_STR_VAL($source);
}

%typemap(mzscheme, varin) char [ANY] {
    if(!SCHEME_STRINGP($source))
	scheme_wrong_type("$name", "string", $argnum, argc, argv);
    $target = SCHEME_STR_VAL($source);
}

%typemap(mzscheme, varin) int {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    $target = SCHEME_INT_VAL($source);
}

%typemap(mzscheme, varin) long {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    scheme_get_int_val($source, &$target);
}

%typemap(mzscheme, varin) short {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    $target = SCHEME_INT_VAL($source);
}

%typemap(mzscheme, varin) unsigned int {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    $target = SCHEME_INT_VAL($source);
}

%typemap(mzscheme, varin) unsigned long {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    scheme_get_unsigned_int_val($source, &$target);
}

%typemap(mzscheme, varin) unsigned short {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    $target = SCHEME_INT_VAL($source);
}
/*
%typemap(mzscheme, varin) long long {
    if(!SCHEME_INTP($source))
    scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    scheme_get_int_val($source, &$target);
}
*/
%typemap(mzscheme, varin) float {
    if(!SCHEME_DBLP($source))
	scheme_wrong_type("$name", "double", $argnum, argc, argv);
    $target = SCHEME_DBL_VAL($source);
}

%typemap(mzscheme, varin) double {
    if(SCHEME_DBLP($source))
	$target = SCHEME_DBL_VAL($source);
    else if(SCHEME_REALP($source))
	$target = scheme_real_to_double($source);
    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
/*
%typemap(mzscheme, varin) long double {
    if(SCHEME_DBLP($source))
	$target = SCHEME_DBL_VAL($source);
    else if(SCHEME_REALP($source))
	$target = scheme_real_to_double($source);
    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
*/

/*
 ------------------------------------
 global pointer variable
 ------------------------------------
 */

%typemap(mzscheme, varin) unsigned char *(unsigned char temp) {
    if(!SCHEME_CHARP($source))
	scheme_wrong_type("$name", "character", $argnum, argc, argv);
    temp = SCHEME_STR_VAL($source);
    $target = &temp;
}

%typemap(mzscheme, varin) int *(int temp) {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    temp = (int)SCHEME_INT_VAL($source);
    $target = &temp;
}

%typemap(mzscheme, varin) long *(long temp) {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    scheme_get_int_val($source, &temp);
    $target = &temp;

}

%typemap(mzscheme, varin) short *(short temp) {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    temp = (short)SCHEME_INT_VAL($source);
    $target = &temp;
}

%typemap(mzscheme, varin) unsigned int *(unsigned temp) {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    temp = (unsigned)SCHEME_INT_VAL($source);
    $target = &temp;
}

%typemap(mzscheme, varin) unsigned long *(unsigned long temp) {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    scheme_get_unsigned_int_val($source, &temp);
    $target = &temp;
}

%typemap(mzscheme, varin) unsigned short *(unsigned short temp) {
    if(!SCHEME_INTP($source))
	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    temp = (unsigned short)SCHEME_INT_VAL($source);
    $target = &temp;

}
/*
%typemap(mzscheme, varin) long long *(long long temp) {
    if(!SCHEME_INTP($source))
    scheme_wrong_type("$name", "integer", $argnum, argc, argv);
    scheme_get_int_val($source, &temp);
    $target = &temp;
}
*/
%typemap(mzscheme, varin) float *(float temp) {
    if(!SCHEME_DBLP($source))
	scheme_wrong_type("$name", "double", $argnum, argc, argv);
    temp = (float)SCHEME_DBL_VAL($source);
    $target = &temp;

}

%typemap(mzscheme, varin) double *(double temp) {
    if(SCHEME_DBLP($source)) {
	temp = (double)SCHEME_DBL_VAL($source);
	$target = &temp;
    }
    else if(SCHEME_REALP($source)) {
	temp = (double)scheme_real_to_double($source);
	$target = &temp;
    }
    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
/*
%typemap(mzscheme, varin) long double *(long double temp) {
    if(SCHEME_DBLP($source)) {
	temp = (long double)SCHEME_DBL_VAL($source);
	$target = &temp;
    }
    else if(SCHEME_REALP($source)) {
	temp = (long double)scheme_real_to_double($source);
	$target = &temp;
    }
    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
*/


/*
 -----------------------------------
 convert a variable from C to Scheme
 -----------------------------------
 */

%typemap(mzscheme, varout) char {
    $target = scheme_make_character($source);
}

%typemap(mzscheme, varout) unsigned char {
    $target = scheme_make_character($source);
}

%typemap(mzscheme, varout) char * {
    $target = scheme_make_string_without_copying($source);
}

%typemap(mzscheme, varout) char [ANY] {
    $target = scheme_make_string_without_copying($source);
}

%typemap(mzscheme, varout) int {
    $target = scheme_make_integer_value($source);
}

%typemap(mzscheme, varout) long {
    $target = scheme_make_integer_value($source);
}

%typemap(mzscheme, varout) short {
    $target = scheme_make_integer_value($source);
}
/*
%typemap(mzscheme, varout) long long {
    $target = scheme_make_integer_value($source);
}
*/
%typemap(mzscheme, varout) unsigned int {
    $target = scheme_make_integer_value_from_unsigned($source);
}

%typemap(mzscheme, varout) unsigned long {
    $target = scheme_make_integer_value_from_unsigned($source);
}

%typemap(mzscheme, varout) unsigned short {
    $target = scheme_make_integer_value_from_unsigned($source);
}

%typemap(mzscheme, varout) float {
    $target = scheme_make_double($source);
}

%typemap(mzscheme, varout) double {
    $target = scheme_make_double($source);
}
/*
%typemap(mzscheme, varout) long double {
    $target = scheme_make_double($source);
}
*/

/*
 -----------------------------------
 convert a pointer variable from C to MzScheme
 -----------------------------------
 */

%typemap(mzscheme, varout) int * {
    $target = scheme_make_integer_value(*$source);
}

%typemap(mzscheme, varout) long * {
    $target = scheme_make_integer_value(*$source);
}

%typemap(mzscheme, varout) short * {
    $target = scheme_make_integer_value(*$source);
}

/*
%typemap(mzscheme, varout) long long * {
    $target = scheme_make_integer_value(*$source);
}
*/
%typemap(mzscheme, varout) unsigned int * {
    $target = scheme_make_integer_value_from_unsigned(*$source);
}

%typemap(mzscheme, varout) unsigned long * {
    $target = scheme_make_integer_value_from_unsigned(*$source);
}

%typemap(mzscheme, varout) unsigned short * {
    $target = scheme_make_integer_value_from_unsigned(*$source);
}

%typemap(mzscheme, varout) float * {
    $target = scheme_make_double(*$source);
}

%typemap(mzscheme, varout) double * {
    $target = scheme_make_double(*$source);
}
/*
%typemap(mzscheme, varout) long double * {
    $target = scheme_make_double(*$source);
}
*/