/* If OBJ is a primitive object (roughly, immediate or number), write it to
PORT. Assumes the caller locks the PORT.
Returns the # of characters written, or #f if OBJ is not a primitive object.
*/
ScmObj Scm__WritePrimitive(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
{
#define CASE_ITAG_RET(obj, str) \
case SCM_ITAG(obj): \
Scm_PutzUnsafe(str, -1, port); \
return SCM_MAKE_INT(sizeof(str)-1);
if (SCM_IMMEDIATEP(obj)) {
switch (SCM_ITAG(obj)) {
CASE_ITAG_RET(SCM_FALSE, "#f");
CASE_ITAG_RET(SCM_TRUE, "#t");
CASE_ITAG_RET(SCM_NIL, "()");
CASE_ITAG_RET(SCM_EOF, "#<eof>");
CASE_ITAG_RET(SCM_UNDEFINED, "#<undef>");
CASE_ITAG_RET(SCM_UNBOUND, "#<unbound>");
default:
Scm_Panic("write: unknown itag object: %08x", SCM_WORD(obj));
}
}
else if (SCM_INTP(obj)) {
char buf[SPBUFSIZ];
int k = snprintf(buf, SPBUFSIZ, "%ld", SCM_INT_VALUE(obj));
Scm_PutzUnsafe(buf, -1, port);
return SCM_MAKE_INT(k);
}
else if (SCM_CHARP(obj)) {
size_t k = write_char(SCM_CHAR_VALUE(obj), port, ctx);
return SCM_MAKE_INT(k);
}
else if (SCM_NUMBERP(obj)) {
return SCM_MAKE_INT(Scm_PrintNumber(port, obj, NULL));
}
return SCM_FALSE;
}
/* If OBJ is a primitive object (roughly, immediate or number), write it to
PORT. Assumes the caller locks the PORT.
Returns the # of characters written, or #f if OBJ is not a primitive object.
*/
ScmObj Scm__WritePrimitive(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
{
const ScmWriteControls *wp = Scm_GetWriteControls(ctx, port->writeState);
#define CASE_ITAG_RET(obj, str) \
case SCM_ITAG(obj): \
Scm_PutzUnsafe(str, -1, port); \
return SCM_MAKE_INT(sizeof(str)-1);
if (SCM_IMMEDIATEP(obj)) {
switch (SCM_ITAG(obj)) {
CASE_ITAG_RET(SCM_FALSE, "#f");
CASE_ITAG_RET(SCM_TRUE, "#t");
CASE_ITAG_RET(SCM_NIL, "()");
CASE_ITAG_RET(SCM_EOF, "#<eof>");
CASE_ITAG_RET(SCM_UNDEFINED, "#<undef>");
CASE_ITAG_RET(SCM_UNBOUND, "#<unbound>");
default:
Scm_Panic("write: unknown itag object: %08x", SCM_WORD(obj));
}
}
else if (SCM_INTP(obj) && wp->printBase == 10 && !wp->printRadix) {
/* Shortcut to avoid allocation */
char buf[SPBUFSIZ];
int k = snprintf(buf, SPBUFSIZ, "%ld", SCM_INT_VALUE(obj));
Scm_PutzUnsafe(buf, -1, port);
return SCM_MAKE_INT(k);
}
else if (SCM_CHARP(obj)) {
size_t k = write_char(SCM_CHAR_VALUE(obj), port, ctx);
return SCM_MAKE_INT(k);
}
else if (SCM_NUMBERP(obj)) {
ScmNumberFormat fmt;
Scm_NumberFormatInit(&fmt);
fmt.radix = wp->printBase;
if (wp->printRadix) fmt.flags |= SCM_NUMBER_FORMAT_ALT_RADIX;
return SCM_MAKE_INT(Scm_PrintNumber(port, obj, &fmt));
}
/* PVREF only appears in pattern temlate in the current macro expander.
It will be go away once we rewrite the expander. */
else if (SCM_PVREF_P(obj)) {
char buf[SPBUFSIZ];
int k = snprintf(buf, SPBUFSIZ, "#<pvar %ld.%ld>",
SCM_PVREF_LEVEL(obj), SCM_PVREF_COUNT(obj));
Scm_PutzUnsafe(buf, -1, port);
return SCM_MAKE_INT(k);
}
return SCM_FALSE;
}
