/*
 *                     S C H E M E _ C T Y P E . C
 *
 *  Implements three new types which allow to access C variables.
 *
 *  Version      : $Revision$
 *
 *  Created      : Sun Jun 26 17:13:11 1994
 *  Author       : Ulrich Drepper <drepper@mydec>
 *
 *  Last modified: Sun Jun 26 17:57:05 1994
 *  Author       : Ulrich Drepper <drepper@mydec>
 */
#if !defined(lint)
static const char *vcid = "$Id$";
#endif /* lint */

#include "scheme.h"

/* globals */
Scheme_Object *scheme_c_char_type;
Scheme_Object *scheme_c_integer_type;
Scheme_Object *scheme_c_double_type;

/* locals */
static Scheme_Object *scheme_c_char_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *scheme_c_int_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *scheme_c_double_p (int argc, Scheme_Object *argv[]);

void
scheme_init_ctype(Scheme_Env *env)
{
    scheme_c_char_type = scheme_make_type("<c_char>");
    scheme_c_integer_type = scheme_make_type("<c_integer>");
    scheme_c_double_type = scheme_make_type("<c_double>");
    scheme_add_global("<c_char>", scheme_c_char_type, env);
    scheme_add_global("<c_integer>", scheme_c_char_type, env);
    scheme_add_global("<c_double>", scheme_c_char_type, env);
    scheme_add_global("cchar?", scheme_make_prim(scheme_c_char_p), env);
    scheme_add_global("cint?", scheme_make_prim(scheme_c_int_p), env);
    scheme_add_global("cdouble?", scheme_make_prim(scheme_c_double_p), env);
}

Scheme_Object *
scheme_make_c_char(char *ch)
{
    Scheme_Object *scc;

    scc = scheme_alloc_object ();
    SCHEME_TYPE (scc) = scheme_c_char_type;
    SCHEME_C_CHAR_VAL (scc) = ch;
    return scc;
}

Scheme_Object *
scheme_make_c_integer(int *i)
{
    Scheme_Object *scc;

    scc = scheme_alloc_object ();
    SCHEME_TYPE (scc) = scheme_c_integer_type;
    SCHEME_C_INT_VAL (scc) = i;
    return scc;
}

Scheme_Object *
scheme_make_c_double(double *d)
{
    Scheme_Object *scc;

    scc = scheme_alloc_object ();
    SCHEME_TYPE (scc) = scheme_c_double_type;
    SCHEME_C_DOUBLE_VAL (scc) = d;
    return scc;
}

/* locals */
static Scheme_Object *
scheme_c_char_p (int argc, Scheme_Object *argv[])
{
    SCHEME_ASSERT((argc == 1), "cchar?: wrong number of args");
    return SCHEME_C_CHARP(argv[0]) ? scheme_true : scheme_false;
}

static Scheme_Object *
scheme_c_int_p (int argc, Scheme_Object *argv[])
{
    SCHEME_ASSERT((argc == 1), "cint?: wrong number of args");
    return SCHEME_C_CHARP(argv[0]) ? scheme_true : scheme_false;
}

static Scheme_Object *
scheme_c_double_p (int argc, Scheme_Object *argv[])
{
    SCHEME_ASSERT((argc == 1), "cdouble?: wrong number of args");
    return SCHEME_C_CHARP(argv[0]) ? scheme_true : scheme_false;
}
/*
 * Local Variables:
 *  mode:c
 *  c-indent-level:4
 *  c-continued-statement-offset:4
 *  c-continued-brace-offset:0
 *  c-brace-offset:0
 *  c-imaginary-offset:0
 *  c-argdecl-indent:4
 *  c-label-offset:-2
 * End:
 */
