2 * Copyright © 2016 Keith Packard <keithp@keithp.com>
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation, either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * General Public License for more details.
16 #include "ao_lisp_read.h"
19 static const uint16_t lex_classes[128] = {
52 PRINTABLE|WHITE, /* */
54 PRINTABLE|STRINGC, /* " */
55 PRINTABLE|POUND, /* # */
59 PRINTABLE|SPECIAL, /* ' */
60 PRINTABLE|SPECIAL, /* ( */
61 PRINTABLE|SPECIAL, /* ) */
63 PRINTABLE|SIGN, /* + */
64 PRINTABLE|SPECIAL, /* , */
65 PRINTABLE|SIGN, /* - */
66 PRINTABLE|DOTC|FLOATC, /* . */
68 PRINTABLE|DIGIT, /* 0 */
69 PRINTABLE|DIGIT, /* 1 */
70 PRINTABLE|DIGIT, /* 2 */
71 PRINTABLE|DIGIT, /* 3 */
72 PRINTABLE|DIGIT, /* 4 */
73 PRINTABLE|DIGIT, /* 5 */
74 PRINTABLE|DIGIT, /* 6 */
75 PRINTABLE|DIGIT, /* 7 */
76 PRINTABLE|DIGIT, /* 8 */
77 PRINTABLE|DIGIT, /* 9 */
79 PRINTABLE|COMMENT, /* ; */
89 PRINTABLE|FLOATC, /* E */
112 PRINTABLE|BACKSLASH, /* \ */
116 PRINTABLE|SPECIAL, /* ` */
121 PRINTABLE|FLOATC, /* e */
150 static int lex_unget_c;
172 static uint16_t lex_class;
182 lex_class = ENDOFFILE;
185 lex_class = lex_classes[c];
187 } while (lex_class & IGNORE);
200 lex_class = ENDOFFILE;
233 if (c < '0' || '7' < c) {
237 v = (v << 3) + c - '0';
246 #define AO_LISP_TOKEN_MAX 32
248 static char token_string[AO_LISP_TOKEN_MAX];
249 static int32_t token_int;
250 static int token_len;
251 static float token_float;
253 static inline void add_token(int c) {
254 if (c && token_len < AO_LISP_TOKEN_MAX - 1)
255 token_string[token_len++] = c;
258 static inline void del_token(void) {
263 static inline void end_token(void) {
264 token_string[token_len] = '\0';
272 static const struct namedfloat namedfloats[] = {
273 { .name = "+inf.0", .value = INFINITY },
274 { .name = "-inf.0", .value = -INFINITY },
275 { .name = "+nan.0", .value = NAN },
276 { .name = "-nan.0", .value = NAN },
279 #define NUM_NAMED_FLOATS (sizeof namedfloats / sizeof namedfloats[0])
289 if (lex_class & ENDOFFILE)
292 if (lex_class & WHITE)
295 if (lex_class & COMMENT) {
296 while ((c = lexc()) != '\n') {
297 if (lex_class & ENDOFFILE)
303 if (lex_class & (SPECIAL|DOTC)) {
324 return UNQUOTE_SPLICING;
331 if (lex_class & POUND) {
346 alphabetic = (('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z'));
347 if (token_len == 0) {
362 token_int = token_string[0];
363 else if (!strcmp(token_string, "space"))
365 else if (!strcmp(token_string, "newline"))
367 else if (!strcmp(token_string, "tab"))
369 else if (!strcmp(token_string, "return"))
371 else if (!strcmp(token_string, "formfeed"))
374 ao_lisp_error(AO_LISP_INVALID, "invalid character token #\\%s", token_string);
380 if (lex_class & STRINGC) {
383 if (lex_class & BACKSLASH)
385 if (lex_class & (STRINGC|ENDOFFILE)) {
392 if (lex_class & PRINTABLE) {
406 if (!(lex_class & NUMBER)) {
410 if (!(lex_class & INTEGER))
412 if (token_len != epos &&
420 if (c == '.' && epos != 0)
422 if (c == 'e' || c == 'E') {
426 epos = token_len + 1;
428 if (lex_class & DIGIT) {
431 token_int = token_int * 10 + c - '0';
436 if ((lex_class & (NOTNAME)) && (c != '.' || !isfloat)) {
438 // if (lex_class & ENDOFFILE)
442 if (isint && hasdigit) {
444 token_int = -token_int;
447 if (isfloat && hasdigit) {
448 token_float = atof(token_string);
451 for (u = 0; u < NUM_NAMED_FLOATS; u++)
452 if (!strcmp(namedfloats[u].name, token_string)) {
453 token_float = namedfloats[u].value;
463 static inline int lex(void)
465 int parse_token = _lex();
466 DBGI("token %d (%s)\n", parse_token, token_string);
470 static int parse_token;
472 struct ao_lisp_cons *ao_lisp_read_cons;
473 struct ao_lisp_cons *ao_lisp_read_cons_tail;
474 struct ao_lisp_cons *ao_lisp_read_stack;
476 #define READ_IN_QUOTE 0x01
477 #define READ_SAW_DOT 0x02
478 #define READ_DONE_DOT 0x04
481 push_read_stack(int cons, int read_state)
483 DBGI("push read stack %p 0x%x\n", ao_lisp_read_cons, read_state);
486 ao_lisp_read_stack = ao_lisp_cons_cons(ao_lisp_cons_poly(ao_lisp_read_cons),
487 ao_lisp__cons(ao_lisp_int_poly(read_state),
488 ao_lisp_cons_poly(ao_lisp_read_stack)));
489 if (!ao_lisp_read_stack)
492 ao_lisp_read_cons = NULL;
493 ao_lisp_read_cons_tail = NULL;
498 pop_read_stack(int cons)
502 ao_lisp_read_cons = ao_lisp_poly_cons(ao_lisp_read_stack->car);
503 ao_lisp_read_stack = ao_lisp_poly_cons(ao_lisp_read_stack->cdr);
504 read_state = ao_lisp_poly_int(ao_lisp_read_stack->car);
505 ao_lisp_read_stack = ao_lisp_poly_cons(ao_lisp_read_stack->cdr);
506 for (ao_lisp_read_cons_tail = ao_lisp_read_cons;
507 ao_lisp_read_cons_tail && ao_lisp_read_cons_tail->cdr;
508 ao_lisp_read_cons_tail = ao_lisp_poly_cons(ao_lisp_read_cons_tail->cdr))
511 ao_lisp_read_cons = 0;
512 ao_lisp_read_cons_tail = 0;
513 ao_lisp_read_stack = 0;
516 DBGI("pop read stack %p %d\n", ao_lisp_read_cons, read_state);
523 struct ao_lisp_atom *atom;
532 ao_lisp_read_cons = ao_lisp_read_cons_tail = ao_lisp_read_stack = 0;
535 while (parse_token == OPEN) {
536 if (!push_read_stack(cons, read_state))
543 switch (parse_token) {
547 ao_lisp_error(AO_LISP_EOF, "unexpected end of file");
548 return _ao_lisp_atom_eof;
551 atom = ao_lisp_atom_intern(token_string);
553 v = ao_lisp_atom_poly(atom);
558 v = ao_lisp_integer_poly(token_int);
561 v = ao_lisp_float_get(token_float);
564 if (token_string[0] == 't')
565 v = _ao_lisp_bool_true;
567 v = _ao_lisp_bool_false;
570 string = ao_lisp_string_copy(token_string);
572 v = ao_lisp_string_poly(string);
579 case UNQUOTE_SPLICING:
580 if (!push_read_stack(cons, read_state))
583 read_state = READ_IN_QUOTE;
584 switch (parse_token) {
586 v = _ao_lisp_atom_quote;
589 v = _ao_lisp_atom_quasiquote;
592 v = _ao_lisp_atom_unquote;
594 case UNQUOTE_SPLICING:
595 v = _ao_lisp_atom_unquote2dsplicing;
604 v = ao_lisp_cons_poly(ao_lisp_read_cons);
606 read_state = pop_read_stack(cons);
610 ao_lisp_error(AO_LISP_INVALID, ". outside of cons");
613 if (!ao_lisp_read_cons) {
614 ao_lisp_error(AO_LISP_INVALID, ". first in cons");
617 read_state |= READ_SAW_DOT;
621 /* loop over QUOTE ends */
626 if (read_state & READ_DONE_DOT) {
627 ao_lisp_error(AO_LISP_INVALID, ". not last in cons");
631 if (read_state & READ_SAW_DOT) {
632 read_state |= READ_DONE_DOT;
633 ao_lisp_read_cons_tail->cdr = v;
635 struct ao_lisp_cons *read = ao_lisp_cons_cons(v, AO_LISP_NIL);
639 if (ao_lisp_read_cons_tail)
640 ao_lisp_read_cons_tail->cdr = ao_lisp_cons_poly(read);
642 ao_lisp_read_cons = read;
643 ao_lisp_read_cons_tail = read;
646 if (!(read_state & READ_IN_QUOTE) || !ao_lisp_read_cons->cdr)
649 v = ao_lisp_cons_poly(ao_lisp_read_cons);
651 read_state = pop_read_stack(cons);