void register_procs(void)
{
gh_new_procedure("tortoise-reset", tortoise_reset, 0, 0, 0);
gh_new_procedure("tortoise-pendown", tortoise_pendown, 0, 0, 0);
gh_new_procedure("tortoise-penup", tortoise_penup, 0, 0, 0);
gh_new_procedure("tortoise-turn", tortoise_turn, 1, 0, 0);
gh_new_procedure("tortoise-move", tortoise_move, 1, 0, 0);
}
void register_field_smobs(void)
{
#ifdef HAVE_SCM_MAKE_SMOB_TYPE
scm_tc16_smob_field_smob = scm_make_smob_type("field", 0);
scm_set_smob_free(scm_tc16_smob_field_smob, free_field_smob);
scm_set_smob_print(scm_tc16_smob_field_smob, print_field_smob);
#else /* old way to register smobs */
MAKE_SMOBFUNS(field_smob);
REGISTER_SMOBFUNS(field_smob);
#endif
gh_new_procedure("field?", field_p, 1, 0, 0);
gh_new_procedure("rscalar-field?", rscalar_field_p, 1, 0, 0);
gh_new_procedure("cscalar-field?", cscalar_field_p, 1, 0, 0);
gh_new_procedure("cvector-field?", cvector_field_p, 1, 0, 0);
}
void register_matrix_smobs(void)
{
#ifdef HAVE_SCM_MAKE_SMOB_TYPE
scm_tc16_smob_evectmatrix = scm_make_smob_type("evectmatrix", 0);
scm_set_smob_free(scm_tc16_smob_evectmatrix, free_evectmatrix);
scm_set_smob_print(scm_tc16_smob_evectmatrix, print_evectmatrix);
scm_tc16_smob_sqmatrix = scm_make_smob_type("sqmatrix", 0);
scm_set_smob_free(scm_tc16_smob_sqmatrix, free_sqmatrix);
scm_set_smob_print(scm_tc16_smob_sqmatrix, print_sqmatrix);
#else /* old way to register smobs */
MAKE_SMOBFUNS(evectmatrix);
MAKE_SMOBFUNS(sqmatrix);
REGISTER_SMOBFUNS(evectmatrix);
REGISTER_SMOBFUNS(sqmatrix);
#endif
gh_new_procedure("evectmatrix?", evectmatrix_p, 1, 0, 0);
gh_new_procedure("sqmatrix?", sqmatrix_p, 1, 0, 0);
}
/**
** Define a vararg scheme procedure.
*/
global SCM gh_new_procedureN(char* proc_name, SCM (*fn) ())
{
return gh_new_procedure(proc_name,fn,0,0,1);
}
repv gh_new_procedure5_0(const char *proc_name, repv (*fn)(repv, repv, repv, repv, repv))
{
return gh_new_procedure (proc_name, fn, 5, 0, 0);
}
repv gh_new_procedure2_2(const char *proc_name, repv (*fn)(repv, repv, repv, repv))
{
return gh_new_procedure (proc_name, fn, 2, 2, 0);
}
repv gh_new_procedure1_1(const char *proc_name, repv (*fn)(repv, repv))
{
return gh_new_procedure (proc_name, fn, 1, 1, 0);
}
repv gh_new_procedure0_0(const char *proc_name, repv (*fn)(void))
{
return gh_new_procedure (proc_name, fn, 0, 0, 0);
}