X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_read.c;h=0ca12a81f6fcc843c24ba2f046970f7e8a83a37c;hp=5115f46e28af8b989c3ca199f852298c4ae70cb6;hb=ed6967cef5d82baacafe1c23229f44d58c838326;hpb=5f8f0ed5cd5d4b4f793c602ed09f9b4bdb98f7e8 diff --git a/src/lisp/ao_lisp_read.c b/src/lisp/ao_lisp_read.c index 5115f46e..0ca12a81 100644 --- a/src/lisp/ao_lisp_read.c +++ b/src/lisp/ao_lisp_read.c @@ -14,6 +14,8 @@ #include "ao_lisp.h" #include "ao_lisp_read.h" +#include +#include static const uint16_t lex_classes[128] = { IGNORE, /* ^@ */ @@ -60,9 +62,9 @@ static const uint16_t lex_classes[128] = { PRINTABLE|SPECIAL, /* ) */ PRINTABLE, /* * */ PRINTABLE|SIGN, /* + */ - PRINTABLE, /* , */ + PRINTABLE|SPECIAL, /* , */ PRINTABLE|SIGN, /* - */ - PRINTABLE|SPECIAL, /* . */ + PRINTABLE|DOTC|FLOATC, /* . */ PRINTABLE, /* / */ PRINTABLE|DIGIT, /* 0 */ PRINTABLE|DIGIT, /* 1 */ @@ -85,7 +87,7 @@ static const uint16_t lex_classes[128] = { PRINTABLE, /* B */ PRINTABLE, /* C */ PRINTABLE, /* D */ - PRINTABLE, /* E */ + PRINTABLE|FLOATC, /* E */ PRINTABLE, /* F */ PRINTABLE, /* G */ PRINTABLE, /* H */ @@ -112,12 +114,12 @@ static const uint16_t lex_classes[128] = { PRINTABLE, /* ] */ PRINTABLE, /* ^ */ PRINTABLE, /* _ */ - PRINTABLE, /* ` */ + PRINTABLE|SPECIAL, /* ` */ PRINTABLE, /* a */ PRINTABLE, /* b */ PRINTABLE, /* c */ PRINTABLE, /* d */ - PRINTABLE, /* e */ + PRINTABLE|FLOATC, /* e */ PRINTABLE, /* f */ PRINTABLE, /* g */ PRINTABLE, /* h */ @@ -140,7 +142,7 @@ static const uint16_t lex_classes[128] = { PRINTABLE, /* y */ PRINTABLE, /* z */ PRINTABLE, /* { */ - PRINTABLE|VBAR, /* | */ + PRINTABLE, /* | */ PRINTABLE, /* } */ PRINTABLE, /* ~ */ IGNORE, /* ^? */ @@ -247,16 +249,36 @@ lex_quoted(void) static char token_string[AO_LISP_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_LISP_TOKEN_MAX - 1) token_string[token_len++] = c; } +static inline void del_token(void) { + if (token_len > 0) + token_len--; +} + static inline void end_token(void) { token_string[token_len] = '\0'; } +struct namedfloat { + const char *name; + float value; +}; + +static const struct namedfloat namedfloats[] = { + { .name = "+inf.0", .value = INFINITY }, + { .name = "-inf.0", .value = -INFINITY }, + { .name = "+nan.0", .value = NAN }, + { .name = "-nan.0", .value = NAN }, +}; + +#define NUM_NAMED_FLOATS (sizeof namedfloats / sizeof namedfloats[0]) + static int _lex(void) { @@ -279,7 +301,7 @@ _lex(void) continue; } - if (lex_class & SPECIAL) { + if (lex_class & (SPECIAL|DOTC)) { add_token(c); end_token(); switch (c) { @@ -293,6 +315,18 @@ _lex(void) return QUOTE; case '.': return DOT; + case '`': + return QUASIQUOTE; + case ',': + c = lexc(); + if (c == '@') { + add_token(c); + end_token(); + return UNQUOTE_SPLICING; + } else { + lex_unget(c); + return UNQUOTE; + } } } if (lex_class & POUND) { @@ -357,47 +391,72 @@ _lex(void) } } if (lex_class & PRINTABLE) { - int isnum; + int isfloat; int hasdigit; int isneg; + int isint; + int epos; - isnum = 1; + isfloat = 1; + isint = 1; hasdigit = 0; token_int = 0; isneg = 0; + epos = 0; for (;;) { if (!(lex_class & NUMBER)) { - isnum = 0; + isint = 0; + isfloat = 0; } else { - if (token_len != 0 && + if (!(lex_class & INTEGER)) + isint = 0; + if (token_len != epos && (lex_class & SIGN)) { - isnum = 0; + isint = 0; + isfloat = 0; } if (c == '-') isneg = 1; + if (c == '.' && epos != 0) + isfloat = 0; + if (c == 'e' || c == 'E') { + if (token_len == 0) + isfloat = 0; + else + epos = token_len + 1; + } if (lex_class & DIGIT) { hasdigit = 1; - if (isnum) + if (isint) token_int = token_int * 10 + c - '0'; } } add_token (c); c = lexc (); - if (lex_class & (NOTNAME)) { + if ((lex_class & (NOTNAME)) && (c != '.' || !isfloat)) { + unsigned int u; // if (lex_class & ENDOFFILE) // clearerr (f); lex_unget(c); end_token (); - if (isnum && hasdigit) { + if (isint && hasdigit) { if (isneg) token_int = -token_int; return NUM; } + if (isfloat && hasdigit) { + token_float = strtof(token_string, NULL); + return FLOAT; + } + for (u = 0; u < NUM_NAMED_FLOATS; u++) + if (!strcmp(namedfloats[u].name, token_string)) { + token_float = namedfloats[u].value; + return FLOAT; + } return NAME; } } - } } } @@ -405,7 +464,7 @@ _lex(void) static inline int lex(void) { int parse_token = _lex(); - DBGI("token %d (%s)\n", parse_token, token_string); + RDBGI("token %d (%s)\n", parse_token, token_string); return parse_token; } @@ -422,8 +481,8 @@ struct ao_lisp_cons *ao_lisp_read_stack; static int push_read_stack(int cons, int read_state) { - DBGI("push read stack %p 0x%x\n", ao_lisp_read_cons, read_state); - DBG_IN(); + RDBGI("push read stack %p 0x%x\n", ao_lisp_read_cons, read_state); + RDBG_IN(); if (cons) { ao_lisp_read_stack = ao_lisp_cons_cons(ao_lisp_cons_poly(ao_lisp_read_cons), ao_lisp__cons(ao_lisp_int_poly(read_state), @@ -454,8 +513,8 @@ pop_read_stack(int cons) ao_lisp_read_cons_tail = 0; ao_lisp_read_stack = 0; } - DBG_OUT(); - DBGI("pop read stack %p %d\n", ao_lisp_read_cons, read_state); + RDBG_OUT(); + RDBGI("pop read stack %p %d\n", ao_lisp_read_cons, read_state); return read_state; } @@ -466,8 +525,7 @@ ao_lisp_read(void) char *string; int cons; int read_state; - ao_poly v; - + ao_poly v = AO_LISP_NIL; cons = 0; read_state = 0; @@ -499,6 +557,9 @@ ao_lisp_read(void) case NUM: v = ao_lisp_integer_poly(token_int); break; + case FLOAT: + v = ao_lisp_float_get(token_float); + break; case BOOL: if (token_string[0] == 't') v = _ao_lisp_bool_true; @@ -513,11 +574,27 @@ ao_lisp_read(void) v = AO_LISP_NIL; break; case QUOTE: + case QUASIQUOTE: + case UNQUOTE: + case UNQUOTE_SPLICING: if (!push_read_stack(cons, read_state)) return AO_LISP_NIL; cons++; read_state = READ_IN_QUOTE; - v = _ao_lisp_atom_quote; + switch (parse_token) { + case QUOTE: + v = _ao_lisp_atom_quote; + break; + case QUASIQUOTE: + v = _ao_lisp_atom_quasiquote; + break; + case UNQUOTE: + v = _ao_lisp_atom_unquote; + break; + case UNQUOTE_SPLICING: + v = _ao_lisp_atom_unquote2dsplicing; + break; + } break; case CLOSE: if (!cons) {