/* * 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; }