suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

use symbols for printout of primitive types

Browse Source 
svn: r12894
This commit is contained in:
Eli Barzilay 2008-12-19 01:44:08 +00:00
parent 7532556b31
commit d1e5dd842e
2 changed files with 46 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/foreign/foreign.c
View File

@ -2623,6 +2623,28 @@ static Scheme_Object *foreign_ffi_callback(int argc, Scheme_Object *argv[])
return (Scheme_Object*)data;
}
/*****************************************************************************/
void ctype_printer(Scheme_Object *ctype, int dis, Scheme_Print_Params *pp)
{
char *str;
if (!SCHEME_CTYPEP(ctype))
scheme_wrong_type("Scheme->C", "C-type", 0, 1, &ctype);
if (CTYPE_PRIMP(ctype)) {
scheme_print_bytes(pp, "#<ctype:", 0, 8);
ctype = CTYPE_BASETYPE(ctype);
if (SCHEME_SYMBOLP(ctype)) {
str = SCHEME_SYM_VAL(ctype);
scheme_print_bytes(pp, str, 0, strlen(str));
} else {
scheme_print_bytes(pp, "cstruct", 0, 7);
}
scheme_print_bytes(pp, ">", 0, 1);
} else {
scheme_print_bytes(pp, "#<ctype>", 0, 8);
}
}
/*****************************************************************************/
/* Initialization */
@ -2642,6 +2664,7 @@ void scheme_init_foreign(Scheme_Env *env)
GC_register_traversers(ctype_tag, ctype_SIZE, ctype_MARK, ctype_FIXUP, 1, 0);
GC_register_traversers(ffi_callback_tag, ffi_callback_SIZE, ffi_callback_MARK, ffi_callback_FIXUP, 1, 0);
#endif
scheme_set_type_printer(ctype_tag, ctype_printer);
MZ_REGISTER_STATIC(opened_libs);
opened_libs = scheme_make_hash_table(SCHEME_hash_string);
MZ_REGISTER_STATIC(default_sym);

23
src/foreign/foreign.ssc
View File

@ -2061,6 +2061,28 @@ void free_cl_cif_args(void *ignored, void *p)
return (Scheme_Object*)data;
}
/*****************************************************************************/
void ctype_printer(Scheme_Object *ctype, int dis, Scheme_Print_Params *pp)
{
char *str;
if (!SCHEME_CTYPEP(ctype))
scheme_wrong_type("Scheme->C", "C-type", 0, 1, &ctype);
if (CTYPE_PRIMP(ctype)) {
scheme_print_bytes(pp, "#<ctype:", 0, 8);
ctype = CTYPE_BASETYPE(ctype);
if (SCHEME_SYMBOLP(ctype)) {
str = SCHEME_SYM_VAL(ctype);
scheme_print_bytes(pp, str, 0, strlen(str));
} else {
scheme_print_bytes(pp, "cstruct", 0, 7);
}
scheme_print_bytes(pp, ">", 0, 1);
} else {
scheme_print_bytes(pp, "#<ctype>", 0, 8);
}
}
/*****************************************************************************/
/* Initialization */
@ -2079,6 +2101,7 @@ void scheme_init_foreign(Scheme_Env *env)
(cadr x)"_MARK, " (cadr x)"_FIXUP, 1, 0);"))
(reverse cstructs)):}
#endif
scheme_set_type_printer(ctype_tag, ctype_printer);
MZ_REGISTER_STATIC(opened_libs);
opened_libs = scheme_make_hash_table(SCHEME_hash_string);
{:(for-each