X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Fscheme%2Fao_scheme_read.c;h=a26965f2056aa73ef1fbb6e89839f986004bb13a;hb=16061947d4376b41e596d87f97ec53ec29d17644;hp=30e29441ff29aa0ccdf41a52e6e143bba3ef37b5;hpb=1133130986a78628ea297ce1f6a023baf4382d8f;p=fw%2Faltos diff --git a/src/scheme/ao_scheme_read.c b/src/scheme/ao_scheme_read.c index 30e29441..a26965f2 100644 --- a/src/scheme/ao_scheme_read.c +++ b/src/scheme/ao_scheme_read.c @@ -18,147 +18,147 @@ #include static const uint16_t lex_classes[128] = { - IGNORE, /* ^@ */ - IGNORE, /* ^A */ - IGNORE, /* ^B */ - IGNORE, /* ^C */ - IGNORE, /* ^D */ - IGNORE, /* ^E */ - IGNORE, /* ^F */ - IGNORE, /* ^G */ - IGNORE, /* ^H */ - WHITE, /* ^I */ - WHITE, /* ^J */ - WHITE, /* ^K */ - WHITE, /* ^L */ - WHITE, /* ^M */ - IGNORE, /* ^N */ - IGNORE, /* ^O */ - IGNORE, /* ^P */ - IGNORE, /* ^Q */ - IGNORE, /* ^R */ - IGNORE, /* ^S */ - IGNORE, /* ^T */ - IGNORE, /* ^U */ - IGNORE, /* ^V */ - IGNORE, /* ^W */ - IGNORE, /* ^X */ - IGNORE, /* ^Y */ - IGNORE, /* ^Z */ - IGNORE, /* ^[ */ - IGNORE, /* ^\ */ - IGNORE, /* ^] */ - IGNORE, /* ^^ */ - IGNORE, /* ^_ */ - PRINTABLE|WHITE, /* */ - PRINTABLE, /* ! */ - PRINTABLE|STRINGC, /* " */ - PRINTABLE|POUND, /* # */ - PRINTABLE, /* $ */ - PRINTABLE, /* % */ - PRINTABLE, /* & */ - PRINTABLE|SPECIAL, /* ' */ - PRINTABLE|SPECIAL, /* ( */ - PRINTABLE|SPECIAL, /* ) */ - PRINTABLE, /* * */ - PRINTABLE|SIGN, /* + */ - PRINTABLE|SPECIAL, /* , */ - PRINTABLE|SIGN, /* - */ - PRINTABLE|DOTC|FLOATC, /* . */ - PRINTABLE, /* / */ - PRINTABLE|DIGIT, /* 0 */ - PRINTABLE|DIGIT, /* 1 */ - PRINTABLE|DIGIT, /* 2 */ - PRINTABLE|DIGIT, /* 3 */ - PRINTABLE|DIGIT, /* 4 */ - PRINTABLE|DIGIT, /* 5 */ - PRINTABLE|DIGIT, /* 6 */ - PRINTABLE|DIGIT, /* 7 */ - PRINTABLE|DIGIT, /* 8 */ - PRINTABLE|DIGIT, /* 9 */ - PRINTABLE, /* : */ - PRINTABLE|COMMENT, /* ; */ - PRINTABLE, /* < */ - PRINTABLE, /* = */ - PRINTABLE, /* > */ - PRINTABLE, /* ? */ - PRINTABLE, /* @ */ - PRINTABLE, /* A */ - PRINTABLE, /* B */ - PRINTABLE, /* C */ - PRINTABLE, /* D */ - PRINTABLE|FLOATC, /* E */ - PRINTABLE, /* F */ - PRINTABLE, /* G */ - PRINTABLE, /* H */ - PRINTABLE, /* I */ - PRINTABLE, /* J */ - PRINTABLE, /* K */ - PRINTABLE, /* L */ - PRINTABLE, /* M */ - PRINTABLE, /* N */ - PRINTABLE, /* O */ - PRINTABLE, /* P */ - PRINTABLE, /* Q */ - PRINTABLE, /* R */ - PRINTABLE, /* S */ - PRINTABLE, /* T */ - PRINTABLE, /* U */ - PRINTABLE, /* V */ - PRINTABLE, /* W */ - PRINTABLE, /* X */ - PRINTABLE, /* Y */ - PRINTABLE, /* Z */ - PRINTABLE, /* [ */ - PRINTABLE|BACKSLASH, /* \ */ - PRINTABLE, /* ] */ - PRINTABLE, /* ^ */ - PRINTABLE, /* _ */ - PRINTABLE|SPECIAL, /* ` */ - PRINTABLE, /* a */ - PRINTABLE, /* b */ - PRINTABLE, /* c */ - PRINTABLE, /* d */ - PRINTABLE|FLOATC, /* e */ - PRINTABLE, /* f */ - PRINTABLE, /* g */ - PRINTABLE, /* h */ - PRINTABLE, /* i */ - PRINTABLE, /* j */ - PRINTABLE, /* k */ - PRINTABLE, /* l */ - PRINTABLE, /* m */ - PRINTABLE, /* n */ - PRINTABLE, /* o */ - PRINTABLE, /* p */ - PRINTABLE, /* q */ - PRINTABLE, /* r */ - PRINTABLE, /* s */ - PRINTABLE, /* t */ - PRINTABLE, /* u */ - PRINTABLE, /* v */ - PRINTABLE, /* w */ - PRINTABLE, /* x */ - PRINTABLE, /* y */ - PRINTABLE, /* z */ - PRINTABLE, /* { */ - PRINTABLE, /* | */ - PRINTABLE, /* } */ - PRINTABLE, /* ~ */ - IGNORE, /* ^? */ + IGNORE, /* ^@ */ + IGNORE, /* ^A */ + IGNORE, /* ^B */ + IGNORE, /* ^C */ + IGNORE, /* ^D */ + IGNORE, /* ^E */ + IGNORE, /* ^F */ + IGNORE, /* ^G */ + IGNORE, /* ^H */ + WHITE, /* ^I */ + WHITE, /* ^J */ + WHITE, /* ^K */ + WHITE, /* ^L */ + WHITE, /* ^M */ + IGNORE, /* ^N */ + IGNORE, /* ^O */ + IGNORE, /* ^P */ + IGNORE, /* ^Q */ + IGNORE, /* ^R */ + IGNORE, /* ^S */ + IGNORE, /* ^T */ + IGNORE, /* ^U */ + IGNORE, /* ^V */ + IGNORE, /* ^W */ + IGNORE, /* ^X */ + IGNORE, /* ^Y */ + IGNORE, /* ^Z */ + IGNORE, /* ^[ */ + IGNORE, /* ^\ */ + IGNORE, /* ^] */ + IGNORE, /* ^^ */ + IGNORE, /* ^_ */ + PRINTABLE|WHITE, /* */ + PRINTABLE, /* ! */ + PRINTABLE|STRINGC, /* " */ + PRINTABLE, /* # */ + PRINTABLE, /* $ */ + PRINTABLE, /* % */ + PRINTABLE, /* & */ + PRINTABLE|SPECIAL, /* ' */ + PRINTABLE|SPECIAL, /* ( */ + PRINTABLE|SPECIAL, /* ) */ + PRINTABLE, /* * */ + PRINTABLE|SIGN, /* + */ + PRINTABLE|SPECIAL_QUASI, /* , */ + PRINTABLE|SIGN, /* - */ + PRINTABLE|SPECIAL|FLOATC, /* . */ + PRINTABLE, /* / */ + PRINTABLE|DIGIT, /* 0 */ + PRINTABLE|DIGIT, /* 1 */ + PRINTABLE|DIGIT, /* 2 */ + PRINTABLE|DIGIT, /* 3 */ + PRINTABLE|DIGIT, /* 4 */ + PRINTABLE|DIGIT, /* 5 */ + PRINTABLE|DIGIT, /* 6 */ + PRINTABLE|DIGIT, /* 7 */ + PRINTABLE|DIGIT, /* 8 */ + PRINTABLE|DIGIT, /* 9 */ + PRINTABLE, /* : */ + PRINTABLE|COMMENT, /* ; */ + PRINTABLE, /* < */ + PRINTABLE, /* = */ + PRINTABLE, /* > */ + PRINTABLE, /* ? */ + PRINTABLE, /* @ */ + PRINTABLE|ALPHA|HEX_LETTER, /* A */ + PRINTABLE|ALPHA|HEX_LETTER, /* B */ + PRINTABLE|ALPHA|HEX_LETTER, /* C */ + PRINTABLE|ALPHA|HEX_LETTER, /* D */ + PRINTABLE|ALPHA|FLOATC|HEX_LETTER,/* E */ + PRINTABLE|ALPHA|HEX_LETTER, /* F */ + PRINTABLE|ALPHA, /* G */ + PRINTABLE|ALPHA, /* H */ + PRINTABLE|ALPHA, /* I */ + PRINTABLE|ALPHA, /* J */ + PRINTABLE|ALPHA, /* K */ + PRINTABLE|ALPHA, /* L */ + PRINTABLE|ALPHA, /* M */ + PRINTABLE|ALPHA, /* N */ + PRINTABLE|ALPHA, /* O */ + PRINTABLE|ALPHA, /* P */ + PRINTABLE|ALPHA, /* Q */ + PRINTABLE|ALPHA, /* R */ + PRINTABLE|ALPHA, /* S */ + PRINTABLE|ALPHA, /* T */ + PRINTABLE|ALPHA, /* U */ + PRINTABLE|ALPHA, /* V */ + PRINTABLE|ALPHA, /* W */ + PRINTABLE|ALPHA, /* X */ + PRINTABLE|ALPHA, /* Y */ + PRINTABLE|ALPHA, /* Z */ + PRINTABLE, /* [ */ + PRINTABLE, /* \ */ + PRINTABLE, /* ] */ + PRINTABLE, /* ^ */ + PRINTABLE, /* _ */ + PRINTABLE|SPECIAL_QUASI, /* ` */ + PRINTABLE|ALPHA|HEX_LETTER, /* a */ + PRINTABLE|ALPHA|HEX_LETTER, /* b */ + PRINTABLE|ALPHA|HEX_LETTER, /* c */ + PRINTABLE|ALPHA|HEX_LETTER, /* d */ + PRINTABLE|ALPHA|FLOATC|HEX_LETTER,/* e */ + PRINTABLE|ALPHA|HEX_LETTER, /* f */ + PRINTABLE|ALPHA, /* g */ + PRINTABLE|ALPHA, /* h */ + PRINTABLE|ALPHA, /* i */ + PRINTABLE|ALPHA, /* j */ + PRINTABLE|ALPHA, /* k */ + PRINTABLE|ALPHA, /* l */ + PRINTABLE|ALPHA, /* m */ + PRINTABLE|ALPHA, /* n */ + PRINTABLE|ALPHA, /* o */ + PRINTABLE|ALPHA, /* p */ + PRINTABLE|ALPHA, /* q */ + PRINTABLE|ALPHA, /* r */ + PRINTABLE|ALPHA, /* s */ + PRINTABLE|ALPHA, /* t */ + PRINTABLE|ALPHA, /* u */ + PRINTABLE|ALPHA, /* v */ + PRINTABLE|ALPHA, /* w */ + PRINTABLE|ALPHA, /* x */ + PRINTABLE|ALPHA, /* y */ + PRINTABLE|ALPHA, /* z */ + PRINTABLE, /* { */ + PRINTABLE, /* | */ + PRINTABLE, /* } */ + PRINTABLE, /* ~ */ + IGNORE, /* ^? */ }; static int lex_unget_c; static inline int -lex_get(void) +lex_get(FILE *in) { int c; if (lex_unget_c) { c = lex_unget_c; lex_unget_c = 0; } else { - c = ao_scheme_getc(); + c = getc(in); } return c; } @@ -173,11 +173,11 @@ lex_unget(int c) static uint16_t lex_class; static int -lexc(void) +lexc(FILE *in) { int c; do { - c = lex_get(); + c = lex_get(in); if (c == EOF) { c = 0; lex_class = ENDOFFILE; @@ -190,32 +190,35 @@ lexc(void) } static int -lex_quoted(void) +lex_quoted(FILE *in) { int c; int v; int count; - c = lex_get(); + c = lex_get(in); if (c == EOF) { + eof: lex_class = ENDOFFILE; return 0; } lex_class = 0; c &= 0x7f; switch (c) { - case 'n': - return '\n'; - case 'f': - return '\f'; + case 'a': + return '\a'; case 'b': return '\b'; + case 't': + return '\t'; + case 'n': + return '\n'; case 'r': return '\r'; + case 'f': + return '\f'; case 'v': return '\v'; - case 't': - return '\t'; case '0': case '1': case '2': @@ -227,9 +230,9 @@ lex_quoted(void) v = c - '0'; count = 1; while (count <= 3) { - c = lex_get(); + c = lex_get(in); if (c == EOF) - return EOF; + goto eof; c &= 0x7f; if (c < '0' || '7' < c) { lex_unget(c); @@ -244,27 +247,30 @@ lex_quoted(void) } } +#ifndef AO_SCHEME_TOKEN_MAX #define AO_SCHEME_TOKEN_MAX 128 +#endif static char token_string[AO_SCHEME_TOKEN_MAX]; static int32_t token_int; static int token_len; -static float token_float; -static inline void add_token(int c) { - if (c && token_len < AO_SCHEME_TOKEN_MAX - 1) - token_string[token_len++] = c; +static void start_token(void) { + token_len = 0; } -static inline void del_token(void) { - if (token_len > 0) - token_len--; +static void add_token(int c) { + if (c && token_len < AO_SCHEME_TOKEN_MAX - 1) + token_string[token_len++] = c; } -static inline void end_token(void) { +static void end_token(void) { token_string[token_len] = '\0'; } +#ifdef AO_SCHEME_FEATURE_FLOAT +static float token_float; + struct namedfloat { const char *name; float value; @@ -278,15 +284,38 @@ static const struct namedfloat namedfloats[] = { }; #define NUM_NAMED_FLOATS (sizeof namedfloats / sizeof namedfloats[0]) +#endif static int -_lex(void) +parse_int(FILE *in, int base) { + int cval; int c; - token_len = 0; + token_int = 0; for (;;) { - c = lexc(); + c = lexc(in); + if ((lex_class & HEX_DIGIT) == 0) { + lex_unget(c); + return NUM; + } + if ('0' <= c && c <= '9') + cval = c - '0'; + else + cval = (c | ('a' - 'A')) - 'a' + 10; + token_int = token_int * base + cval; + } + return NUM; +} + +static int +_lex(FILE *in) +{ + int c; + + start_token(); + for (;;) { + c = lexc(in); if (lex_class & ENDOFFILE) return END; @@ -294,16 +323,14 @@ _lex(void) continue; if (lex_class & COMMENT) { - while ((c = lexc()) != '\n') { + while ((c = lexc(in)) != '\n') { if (lex_class & ENDOFFILE) return END; } continue; } - if (lex_class & (SPECIAL|DOTC)) { - add_token(c); - end_token(); + if (lex_class & SPECIAL) { switch (c) { case '(': case '[': @@ -315,42 +342,40 @@ _lex(void) return QUOTE; case '.': return DOT; +#ifdef AO_SCHEME_FEATURE_QUASI case '`': return QUASIQUOTE; case ',': - c = lexc(); + c = lexc(in); if (c == '@') { - add_token(c); - end_token(); return UNQUOTE_SPLICING; } else { lex_unget(c); return UNQUOTE; } +#endif } } - if (lex_class & POUND) { - c = lexc(); + if (c == '#') { + c = lexc(in); switch (c) { case 't': - add_token(c); - end_token(); - return BOOL; + return TRUE_TOKEN; case 'f': - add_token(c); - end_token(); - return BOOL; + return FALSE_TOKEN; +#ifdef AO_SCHEME_FEATURE_VECTOR + case '(': + return OPEN_VECTOR; +#endif case '\\': for (;;) { - int alphabetic; - c = lexc(); - alphabetic = (('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')); + c = lexc(in); if (token_len == 0) { add_token(c); - if (!alphabetic) + if (!(lex_class & ALPHA)) break; } else { - if (alphabetic) + if (lex_class & ALPHA) add_token(c); else { lex_unget(c); @@ -376,13 +401,19 @@ _lex(void) continue; } return NUM; + case 'x': + return parse_int(in, 16); + case 'o': + return parse_int(in, 8); + case 'b': + return parse_int(in, 2); } } if (lex_class & STRINGC) { for (;;) { - c = lexc(); - if (lex_class & BACKSLASH) - c = lex_quoted(); + c = lexc(in); + if (c == '\\') + c = lex_quoted(in); if (lex_class & (STRINGC|ENDOFFILE)) { end_token(); return STRING; @@ -391,23 +422,23 @@ _lex(void) } } if (lex_class & PRINTABLE) { - int isfloat; - int hasdigit; - int isneg; - int isint; - int epos; - - isfloat = 1; - isint = 1; - hasdigit = 0; +#ifdef AO_SCHEME_FEATURE_FLOAT + int isfloat = 1; + int epos = 0; +#endif + int hasdigit = 0; + int isneg = 0; + int isint = 1; + token_int = 0; - isneg = 0; - epos = 0; for (;;) { if (!(lex_class & NUMBER)) { isint = 0; +#ifdef AO_SCHEME_FEATURE_FLOAT isfloat = 0; +#endif } else { +#ifdef AO_SCHEME_FEATURE_FLOAT if (!(lex_class & INTEGER)) isint = 0; if (token_len != epos && @@ -416,8 +447,10 @@ _lex(void) isint = 0; isfloat = 0; } +#endif if (c == '-') isneg = 1; +#ifdef AO_SCHEME_FEATURE_FLOAT if (c == '.' && epos != 0) isfloat = 0; if (c == 'e' || c == 'E') { @@ -426,6 +459,7 @@ _lex(void) else epos = token_len + 1; } +#endif if (lex_class & DIGIT) { hasdigit = 1; if (isint) @@ -433,11 +467,15 @@ _lex(void) } } add_token (c); - c = lexc (); - if ((lex_class & (NOTNAME)) && (c != '.' || !isfloat)) { + c = lexc (in); + if ((lex_class & (NOTNAME)) +#ifdef AO_SCHEME_FEATURE_FLOAT + && (c != '.' || !isfloat) +#endif + ) { +#ifdef AO_SCHEME_FEATURE_FLOAT unsigned int u; -// if (lex_class & ENDOFFILE) -// clearerr (f); +#endif lex_unget(c); end_token (); if (isint && hasdigit) { @@ -445,6 +483,7 @@ _lex(void) token_int = -token_int; return NUM; } +#ifdef AO_SCHEME_FEATURE_FLOAT if (isfloat && hasdigit) { token_float = strtof(token_string, NULL); return FLOAT; @@ -454,6 +493,7 @@ _lex(void) token_float = namedfloats[u].value; return FLOAT; } +#endif return NAME; } } @@ -461,10 +501,10 @@ _lex(void) } } -static inline int lex(void) +static inline int lex(FILE *in) { - int parse_token = _lex(); - RDBGI("token %d (%s)\n", parse_token, token_string); + int parse_token = _lex(in); + RDBGI("token %d \"%s\"\n", parse_token, token_string); return parse_token; } @@ -474,10 +514,12 @@ int ao_scheme_read_list; struct ao_scheme_cons *ao_scheme_read_cons; struct ao_scheme_cons *ao_scheme_read_cons_tail; struct ao_scheme_cons *ao_scheme_read_stack; +static int ao_scheme_read_state; #define READ_IN_QUOTE 0x01 #define READ_SAW_DOT 0x02 #define READ_DONE_DOT 0x04 +#define READ_SAW_VECTOR 0x08 static int push_read_stack(int read_state) @@ -486,11 +528,12 @@ push_read_stack(int read_state) RDBG_IN(); if (ao_scheme_read_list) { ao_scheme_read_stack = ao_scheme_cons_cons(ao_scheme_cons_poly(ao_scheme_read_cons), - ao_scheme__cons(ao_scheme_int_poly(read_state), + ao_scheme_cons(ao_scheme_int_poly(read_state), ao_scheme_cons_poly(ao_scheme_read_stack))); if (!ao_scheme_read_stack) return 0; - } + } else + ao_scheme_read_state = read_state; ao_scheme_read_cons = NULL; ao_scheme_read_cons_tail = NULL; return 1; @@ -510,34 +553,46 @@ pop_read_stack(void) ao_scheme_read_cons_tail = ao_scheme_poly_cons(ao_scheme_read_cons_tail->cdr)) ; } else { - ao_scheme_read_cons = 0; - ao_scheme_read_cons_tail = 0; - ao_scheme_read_stack = 0; + read_state = ao_scheme_read_state; + ao_scheme_read_cons = NULL; + ao_scheme_read_cons_tail = NULL; + ao_scheme_read_stack = NULL; + ao_scheme_read_state = 0; } RDBG_OUT(); RDBGI("pop read stack %p %d\n", ao_scheme_read_cons, read_state); return read_state; } +#ifdef AO_SCHEME_FEATURE_VECTOR +#define is_open(t) ((t) == OPEN || (t) == OPEN_VECTOR) +#else +#define is_open(t) ((t) == OPEN) +#endif + ao_poly -ao_scheme_read(void) +ao_scheme_read(FILE *in) { struct ao_scheme_atom *atom; - char *string; + struct ao_scheme_string *string; int read_state; ao_poly v = AO_SCHEME_NIL; ao_scheme_read_list = 0; read_state = 0; - ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = 0; + ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = NULL; for (;;) { - parse_token = lex(); - while (parse_token == OPEN) { + parse_token = lex(in); + while (is_open(parse_token)) { +#ifdef AO_SCHEME_FEATURE_VECTOR + if (parse_token == OPEN_VECTOR) + read_state |= READ_SAW_VECTOR; +#endif if (!push_read_stack(read_state)) return AO_SCHEME_NIL; ao_scheme_read_list++; read_state = 0; - parse_token = lex(); + parse_token = lex(in); } switch (parse_token) { @@ -557,26 +612,30 @@ ao_scheme_read(void) case NUM: v = ao_scheme_integer_poly(token_int); break; +#ifdef AO_SCHEME_FEATURE_FLOAT case FLOAT: v = ao_scheme_float_get(token_float); break; - case BOOL: - if (token_string[0] == 't') - v = _ao_scheme_bool_true; - else - v = _ao_scheme_bool_false; +#endif + case TRUE_TOKEN: + v = _ao_scheme_bool_true; + break; + case FALSE_TOKEN: + v = _ao_scheme_bool_false; break; case STRING: - string = ao_scheme_string_copy(token_string); + string = ao_scheme_string_new(token_string); if (string) v = ao_scheme_string_poly(string); else v = AO_SCHEME_NIL; break; case QUOTE: +#ifdef AO_SCHEME_FEATURE_QUASI case QUASIQUOTE: case UNQUOTE: case UNQUOTE_SPLICING: +#endif if (!push_read_stack(read_state)) return AO_SCHEME_NIL; ao_scheme_read_list++; @@ -585,6 +644,7 @@ ao_scheme_read(void) case QUOTE: v = _ao_scheme_atom_quote; break; +#ifdef AO_SCHEME_FEATURE_QUASI case QUASIQUOTE: v = _ao_scheme_atom_quasiquote; break; @@ -594,6 +654,7 @@ ao_scheme_read(void) case UNQUOTE_SPLICING: v = _ao_scheme_atom_unquote2dsplicing; break; +#endif } break; case CLOSE: @@ -604,6 +665,12 @@ ao_scheme_read(void) v = ao_scheme_cons_poly(ao_scheme_read_cons); --ao_scheme_read_list; read_state = pop_read_stack(); +#ifdef AO_SCHEME_FEATURE_VECTOR + if (read_state & READ_SAW_VECTOR) { + v = ao_scheme_vector_poly(ao_scheme_list_to_vector(ao_scheme_poly_cons(v))); + read_state &= ~READ_SAW_VECTOR; + } +#endif break; case DOT: if (!ao_scheme_read_list) {