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.
15 #include "ao_scheme.h"
16 #include "ao_scheme_read.h"
20 static const uint16_t lex_classes[128] = {
53 PRINTABLE|WHITE, /* */
55 PRINTABLE|STRINGC, /* " */
56 PRINTABLE|POUND, /* # */
60 PRINTABLE|SPECIAL, /* ' */
61 PRINTABLE|SPECIAL, /* ( */
62 PRINTABLE|SPECIAL, /* ) */
64 PRINTABLE|SIGN, /* + */
65 PRINTABLE|SPECIAL, /* , */
66 PRINTABLE|SIGN, /* - */
67 PRINTABLE|DOTC|FLOATC, /* . */
69 PRINTABLE|DIGIT, /* 0 */
70 PRINTABLE|DIGIT, /* 1 */
71 PRINTABLE|DIGIT, /* 2 */
72 PRINTABLE|DIGIT, /* 3 */
73 PRINTABLE|DIGIT, /* 4 */
74 PRINTABLE|DIGIT, /* 5 */
75 PRINTABLE|DIGIT, /* 6 */
76 PRINTABLE|DIGIT, /* 7 */
77 PRINTABLE|DIGIT, /* 8 */
78 PRINTABLE|DIGIT, /* 9 */
80 PRINTABLE|COMMENT, /* ; */
90 PRINTABLE|FLOATC, /* E */
113 PRINTABLE|BACKSLASH, /* \ */
117 PRINTABLE|SPECIAL, /* ` */
122 PRINTABLE|FLOATC, /* e */
151 static int lex_unget_c;
161 c = ao_scheme_getc();
173 static uint16_t lex_class;
183 lex_class = ENDOFFILE;
186 lex_class = lex_classes[c];
188 } while (lex_class & IGNORE);
201 lex_class = ENDOFFILE;
234 if (c < '0' || '7' < c) {
238 v = (v << 3) + c - '0';
247 #define AO_SCHEME_TOKEN_MAX 32
249 static char token_string[AO_SCHEME_TOKEN_MAX];
250 static int32_t token_int;
251 static int token_len;
252 static float token_float;
254 static inline void add_token(int c) {
255 if (c && token_len < AO_SCHEME_TOKEN_MAX - 1)
256 token_string[token_len++] = c;
259 static inline void del_token(void) {
264 static inline void end_token(void) {
265 token_string[token_len] = '\0';
273 static const struct namedfloat namedfloats[] = {
274 { .name = "+inf.0", .value = INFINITY },
275 { .name = "-inf.0", .value = -INFINITY },
276 { .name = "+nan.0", .value = NAN },
277 { .name = "-nan.0", .value = NAN },
280 #define NUM_NAMED_FLOATS (sizeof namedfloats / sizeof namedfloats[0])
290 if (lex_class & ENDOFFILE)
293 if (lex_class & WHITE)
296 if (lex_class & COMMENT) {
297 while ((c = lexc()) != '\n') {
298 if (lex_class & ENDOFFILE)
304 if (lex_class & (SPECIAL|DOTC)) {
325 return UNQUOTE_SPLICING;
332 if (lex_class & POUND) {
347 alphabetic = (('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z'));
348 if (token_len == 0) {
363 token_int = token_string[0];
364 else if (!strcmp(token_string, "space"))
366 else if (!strcmp(token_string, "newline"))
368 else if (!strcmp(token_string, "tab"))
370 else if (!strcmp(token_string, "return"))
372 else if (!strcmp(token_string, "formfeed"))
375 ao_scheme_error(AO_SCHEME_INVALID, "invalid character token #\\%s", token_string);
381 if (lex_class & STRINGC) {
384 if (lex_class & BACKSLASH)
386 if (lex_class & (STRINGC|ENDOFFILE)) {
393 if (lex_class & PRINTABLE) {
407 if (!(lex_class & NUMBER)) {
411 if (!(lex_class & INTEGER))
413 if (token_len != epos &&
421 if (c == '.' && epos != 0)
423 if (c == 'e' || c == 'E') {
427 epos = token_len + 1;
429 if (lex_class & DIGIT) {
432 token_int = token_int * 10 + c - '0';
437 if ((lex_class & (NOTNAME)) && (c != '.' || !isfloat)) {
439 // if (lex_class & ENDOFFILE)
443 if (isint && hasdigit) {
445 token_int = -token_int;
448 if (isfloat && hasdigit) {
449 token_float = strtof(token_string, NULL);
452 for (u = 0; u < NUM_NAMED_FLOATS; u++)
453 if (!strcmp(namedfloats[u].name, token_string)) {
454 token_float = namedfloats[u].value;
464 static inline int lex(void)
466 int parse_token = _lex();
467 RDBGI("token %d (%s)\n", parse_token, token_string);
471 static int parse_token;
473 struct ao_scheme_cons *ao_scheme_read_cons;
474 struct ao_scheme_cons *ao_scheme_read_cons_tail;
475 struct ao_scheme_cons *ao_scheme_read_stack;
477 #define READ_IN_QUOTE 0x01
478 #define READ_SAW_DOT 0x02
479 #define READ_DONE_DOT 0x04
482 push_read_stack(int cons, int read_state)
484 RDBGI("push read stack %p 0x%x\n", ao_scheme_read_cons, read_state);
487 ao_scheme_read_stack = ao_scheme_cons_cons(ao_scheme_cons_poly(ao_scheme_read_cons),
488 ao_scheme__cons(ao_scheme_int_poly(read_state),
489 ao_scheme_cons_poly(ao_scheme_read_stack)));
490 if (!ao_scheme_read_stack)
493 ao_scheme_read_cons = NULL;
494 ao_scheme_read_cons_tail = NULL;
499 pop_read_stack(int cons)
503 ao_scheme_read_cons = ao_scheme_poly_cons(ao_scheme_read_stack->car);
504 ao_scheme_read_stack = ao_scheme_poly_cons(ao_scheme_read_stack->cdr);
505 read_state = ao_scheme_poly_int(ao_scheme_read_stack->car);
506 ao_scheme_read_stack = ao_scheme_poly_cons(ao_scheme_read_stack->cdr);
507 for (ao_scheme_read_cons_tail = ao_scheme_read_cons;
508 ao_scheme_read_cons_tail && ao_scheme_read_cons_tail->cdr;
509 ao_scheme_read_cons_tail = ao_scheme_poly_cons(ao_scheme_read_cons_tail->cdr))
512 ao_scheme_read_cons = 0;
513 ao_scheme_read_cons_tail = 0;
514 ao_scheme_read_stack = 0;
517 RDBGI("pop read stack %p %d\n", ao_scheme_read_cons, read_state);
524 struct ao_scheme_atom *atom;
528 ao_poly v = AO_SCHEME_NIL;
532 ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = 0;
535 while (parse_token == OPEN) {
536 if (!push_read_stack(cons, read_state))
537 return AO_SCHEME_NIL;
543 switch (parse_token) {
547 ao_scheme_error(AO_SCHEME_EOF, "unexpected end of file");
548 return _ao_scheme_atom_eof;
551 atom = ao_scheme_atom_intern(token_string);
553 v = ao_scheme_atom_poly(atom);
558 v = ao_scheme_integer_poly(token_int);
561 v = ao_scheme_float_get(token_float);
564 if (token_string[0] == 't')
565 v = _ao_scheme_bool_true;
567 v = _ao_scheme_bool_false;
570 string = ao_scheme_string_copy(token_string);
572 v = ao_scheme_string_poly(string);
579 case UNQUOTE_SPLICING:
580 if (!push_read_stack(cons, read_state))
581 return AO_SCHEME_NIL;
583 read_state = READ_IN_QUOTE;
584 switch (parse_token) {
586 v = _ao_scheme_atom_quote;
589 v = _ao_scheme_atom_quasiquote;
592 v = _ao_scheme_atom_unquote;
594 case UNQUOTE_SPLICING:
595 v = _ao_scheme_atom_unquote2dsplicing;
604 v = ao_scheme_cons_poly(ao_scheme_read_cons);
606 read_state = pop_read_stack(cons);
610 ao_scheme_error(AO_SCHEME_INVALID, ". outside of cons");
611 return AO_SCHEME_NIL;
613 if (!ao_scheme_read_cons) {
614 ao_scheme_error(AO_SCHEME_INVALID, ". first in cons");
615 return AO_SCHEME_NIL;
617 read_state |= READ_SAW_DOT;
621 /* loop over QUOTE ends */
626 if (read_state & READ_DONE_DOT) {
627 ao_scheme_error(AO_SCHEME_INVALID, ". not last in cons");
628 return AO_SCHEME_NIL;
631 if (read_state & READ_SAW_DOT) {
632 read_state |= READ_DONE_DOT;
633 ao_scheme_read_cons_tail->cdr = v;
635 struct ao_scheme_cons *read = ao_scheme_cons_cons(v, AO_SCHEME_NIL);
637 return AO_SCHEME_NIL;
639 if (ao_scheme_read_cons_tail)
640 ao_scheme_read_cons_tail->cdr = ao_scheme_cons_poly(read);
642 ao_scheme_read_cons = read;
643 ao_scheme_read_cons_tail = read;
646 if (!(read_state & READ_IN_QUOTE) || !ao_scheme_read_cons->cdr)
649 v = ao_scheme_cons_poly(ao_scheme_read_cons);
651 read_state = pop_read_stack(cons);