/*
* Reader extension
*/
static ScmObj read_uvector(ScmPort *port, const char *tag,
ScmReadContext *ctx)
{
ScmChar c;
ScmObj uv = SCM_UNDEFINED;
SCM_GETC(c, port);
if (c != '(') Scm_Error("bad uniform vector syntax for %s", tag);
ScmObj list = Scm_ReadList(SCM_OBJ(port), ')');
if (strcmp(tag, "s8") == 0) uv = Scm_ListToS8Vector(list, 0);
else if (strcmp(tag, "u8") == 0) uv = Scm_ListToU8Vector(list, 0);
else if (strcmp(tag, "s16") == 0) uv = Scm_ListToS16Vector(list, 0);
else if (strcmp(tag, "u16") == 0) uv = Scm_ListToU16Vector(list, 0);
else if (strcmp(tag, "s32") == 0) uv = Scm_ListToS32Vector(list, 0);
else if (strcmp(tag, "u32") == 0) uv = Scm_ListToU32Vector(list, 0);
else if (strcmp(tag, "s64") == 0) uv = Scm_ListToS64Vector(list, 0);
else if (strcmp(tag, "u64") == 0) uv = Scm_ListToU64Vector(list, 0);
else if (strcmp(tag, "f16") == 0) uv = Scm_ListToF16Vector(list, 0);
else if (strcmp(tag, "f32") == 0) uv = Scm_ListToF32Vector(list, 0);
else if (strcmp(tag, "f64") == 0) uv = Scm_ListToF64Vector(list, 0);
else Scm_Error("invalid unform vector tag: %s", tag);
/* If we are reading source file, let literal uvectors be immutable. */
if (Scm_ReadContextLiteralImmutable(ctx)) {
SCM_UVECTOR_IMMUTABLE_P(uv) = TRUE;
}
return uv;
}
/* Read till the end of char-set syntax and store the chars in BUF.
The surrounding brackets are not stored. The complementing caret
('^' right after opening '[') isn't stored either, but *complementp
holds whether it appeared or not.
Returns TRUE on success.
*/
int read_charset_syntax(ScmPort *input, int bracket_syntax, ScmDString *buf,
int *complementp)
{
#define REAL_BEGIN 1
#define CARET_BEGIN 2
int begin = REAL_BEGIN, complement = FALSE, brackets = 0;
for (;;) {
int ch;
SCM_GETC(ch, input);
if (ch == EOF) return FALSE;
if (begin == REAL_BEGIN && ch == '^') {
complement = TRUE;
begin = CARET_BEGIN;
continue;
}
if (bracket_syntax && begin && ch == ']') {
begin = FALSE;
Scm_DStringPutc(buf, ch);
continue;
}
if (ch == ']' && brackets <= 0) break;
begin = FALSE;
Scm_DStringPutc(buf, ch);
switch (ch) {
case ']': brackets--; break;
case '[': brackets++; break;
case '\\':
SCM_GETC(ch, input);
if (ch == EOF) return FALSE;
Scm_DStringPutc(buf, ch);
break;
}
}
*complementp = complement;
return TRUE;
}
