X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Fscheme%2Fao_scheme_read.c;h=7d540aa5af22f26991dacd194371bbc9673215a6;hb=2bcc178f3cbfd346b134bb3fe700b0512f340fea;hp=9ed54b9ffc28be9e36384726c2e6281fd5e8c28e;hpb=d1d98e408311c5ba18138a18f4c88448e4254626;p=fw%2Faltos diff --git a/src/scheme/ao_scheme_read.c b/src/scheme/ao_scheme_read.c index 9ed54b9f..7d540aa5 100644 --- a/src/scheme/ao_scheme_read.c +++ b/src/scheme/ao_scheme_read.c @@ -53,7 +53,7 @@ static const uint16_t lex_classes[128] = { PRINTABLE|WHITE, /* */ PRINTABLE, /* ! */ PRINTABLE|STRINGC, /* " */ - PRINTABLE|POUND, /* # */ + PRINTABLE, /* # */ PRINTABLE, /* $ */ PRINTABLE, /* % */ PRINTABLE, /* & */ @@ -62,7 +62,7 @@ static const uint16_t lex_classes[128] = { PRINTABLE|SPECIAL, /* ) */ PRINTABLE, /* * */ PRINTABLE|SIGN, /* + */ - PRINTABLE|SPECIAL, /* , */ + PRINTABLE|SPECIAL_QUASI, /* , */ PRINTABLE|SIGN, /* - */ PRINTABLE|DOTC|FLOATC, /* . */ PRINTABLE, /* / */ @@ -83,12 +83,12 @@ static const uint16_t lex_classes[128] = { PRINTABLE, /* > */ PRINTABLE, /* ? */ PRINTABLE, /* @ */ - PRINTABLE, /* A */ - PRINTABLE, /* B */ - PRINTABLE, /* C */ - PRINTABLE, /* D */ - PRINTABLE|FLOATC, /* E */ - PRINTABLE, /* F */ + PRINTABLE|HEX_LETTER, /* A */ + PRINTABLE|HEX_LETTER, /* B */ + PRINTABLE|HEX_LETTER, /* C */ + PRINTABLE|HEX_LETTER, /* D */ + PRINTABLE|FLOATC|HEX_LETTER,/* E */ + PRINTABLE|HEX_LETTER, /* F */ PRINTABLE, /* G */ PRINTABLE, /* H */ PRINTABLE, /* I */ @@ -114,13 +114,13 @@ static const uint16_t lex_classes[128] = { PRINTABLE, /* ] */ PRINTABLE, /* ^ */ PRINTABLE, /* _ */ - PRINTABLE|SPECIAL, /* ` */ - PRINTABLE, /* a */ - PRINTABLE, /* b */ - PRINTABLE, /* c */ - PRINTABLE, /* d */ - PRINTABLE|FLOATC, /* e */ - PRINTABLE, /* f */ + PRINTABLE|SPECIAL_QUASI, /* ` */ + PRINTABLE|HEX_LETTER, /* a */ + PRINTABLE|HEX_LETTER, /* b */ + PRINTABLE|HEX_LETTER, /* c */ + PRINTABLE|HEX_LETTER, /* d */ + PRINTABLE|FLOATC|HEX_LETTER,/* e */ + PRINTABLE|HEX_LETTER, /* f */ PRINTABLE, /* g */ PRINTABLE, /* h */ PRINTABLE, /* i */ @@ -244,12 +244,13 @@ 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) @@ -265,6 +266,9 @@ static inline 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,6 +282,31 @@ static const struct namedfloat namedfloats[] = { }; #define NUM_NAMED_FLOATS (sizeof namedfloats / sizeof namedfloats[0]) +#endif + +static int +parse_int(int base) +{ + int cval; + int c; + + token_int = 0; + for (;;) { + c = lexc(); + if ((lex_class & HEX_DIGIT) == 0) { + lex_unget(c); + end_token(); + return NUM; + } + add_token(c); + 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(void) @@ -315,6 +344,7 @@ _lex(void) return QUOTE; case '.': return DOT; +#ifdef AO_SCHEME_FEATURE_QUASI case '`': return QUASIQUOTE; case ',': @@ -327,9 +357,10 @@ _lex(void) lex_unget(c); return UNQUOTE; } +#endif } } - if (lex_class & POUND) { + if (c == '#') { c = lexc(); switch (c) { case 't': @@ -340,8 +371,10 @@ _lex(void) add_token(c); end_token(); return BOOL; +#ifdef AO_SCHEME_FEATURE_VECTOR case '(': return OPEN_VECTOR; +#endif case '\\': for (;;) { int alphabetic; @@ -378,6 +411,12 @@ _lex(void) continue; } return NUM; + case 'x': + return parse_int(16); + case 'o': + return parse_int(8); + case 'b': + return parse_int(2); } } if (lex_class & STRINGC) { @@ -393,23 +432,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 && @@ -418,8 +457,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') { @@ -428,6 +469,7 @@ _lex(void) else epos = token_len + 1; } +#endif if (lex_class & DIGIT) { hasdigit = 1; if (isint) @@ -436,8 +478,14 @@ _lex(void) } add_token (c); c = lexc (); - if ((lex_class & (NOTNAME)) && (c != '.' || !isfloat)) { + if ((lex_class & (NOTNAME)) +#ifdef AO_SCHEME_FEATURE_FLOAT + && (c != '.' || !isfloat) +#endif + ) { +#ifdef AO_SCHEME_FEATURE_FLOAT unsigned int u; +#endif // if (lex_class & ENDOFFILE) // clearerr (f); lex_unget(c); @@ -447,6 +495,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; @@ -456,6 +505,7 @@ _lex(void) token_float = namedfloats[u].value; return FLOAT; } +#endif return NAME; } } @@ -466,7 +516,7 @@ _lex(void) static inline int lex(void) { int parse_token = _lex(); - RDBGI("token %d (%s)\n", parse_token, token_string); + RDBGI("token %d \"%s\"\n", parse_token, token_string); return parse_token; } @@ -490,7 +540,7 @@ 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; @@ -515,32 +565,41 @@ 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) { 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 == OPEN_VECTOR) { + 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++; @@ -565,9 +624,11 @@ 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; +#endif case BOOL: if (token_string[0] == 't') v = _ao_scheme_bool_true; @@ -575,16 +636,18 @@ ao_scheme_read(void) v = _ao_scheme_bool_false; break; case STRING: - string = ao_scheme_string_copy(token_string); + string = ao_scheme_string_make(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++; @@ -593,6 +656,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; @@ -602,6 +666,7 @@ ao_scheme_read(void) case UNQUOTE_SPLICING: v = _ao_scheme_atom_unquote2dsplicing; break; +#endif } break; case CLOSE: @@ -612,8 +677,12 @@ ao_scheme_read(void) v = ao_scheme_cons_poly(ao_scheme_read_cons); --ao_scheme_read_list; read_state = pop_read_stack(); - if (read_state & READ_SAW_VECTOR) +#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) {