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, /* " */
60 PRINTABLE|SPECIAL, /* ' */
61 PRINTABLE|SPECIAL, /* ( */
62 PRINTABLE|SPECIAL, /* ) */
64 PRINTABLE|SIGN, /* + */
65 PRINTABLE|SPECIAL_QUASI, /* , */
66 PRINTABLE|SIGN, /* - */
67 PRINTABLE|SPECIAL|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, /* ; */
86 PRINTABLE|ALPHA|HEX_LETTER, /* A */
87 PRINTABLE|ALPHA|HEX_LETTER, /* B */
88 PRINTABLE|ALPHA|HEX_LETTER, /* C */
89 PRINTABLE|ALPHA|HEX_LETTER, /* D */
90 PRINTABLE|ALPHA|FLOATC|HEX_LETTER,/* E */
91 PRINTABLE|ALPHA|HEX_LETTER, /* F */
92 PRINTABLE|ALPHA, /* G */
93 PRINTABLE|ALPHA, /* H */
94 PRINTABLE|ALPHA, /* I */
95 PRINTABLE|ALPHA, /* J */
96 PRINTABLE|ALPHA, /* K */
97 PRINTABLE|ALPHA, /* L */
98 PRINTABLE|ALPHA, /* M */
99 PRINTABLE|ALPHA, /* N */
100 PRINTABLE|ALPHA, /* O */
101 PRINTABLE|ALPHA, /* P */
102 PRINTABLE|ALPHA, /* Q */
103 PRINTABLE|ALPHA, /* R */
104 PRINTABLE|ALPHA, /* S */
105 PRINTABLE|ALPHA, /* T */
106 PRINTABLE|ALPHA, /* U */
107 PRINTABLE|ALPHA, /* V */
108 PRINTABLE|ALPHA, /* W */
109 PRINTABLE|ALPHA, /* X */
110 PRINTABLE|ALPHA, /* Y */
111 PRINTABLE|ALPHA, /* Z */
117 PRINTABLE|SPECIAL_QUASI, /* ` */
118 PRINTABLE|ALPHA|HEX_LETTER, /* a */
119 PRINTABLE|ALPHA|HEX_LETTER, /* b */
120 PRINTABLE|ALPHA|HEX_LETTER, /* c */
121 PRINTABLE|ALPHA|HEX_LETTER, /* d */
122 PRINTABLE|ALPHA|FLOATC|HEX_LETTER,/* e */
123 PRINTABLE|ALPHA|HEX_LETTER, /* f */
124 PRINTABLE|ALPHA, /* g */
125 PRINTABLE|ALPHA, /* h */
126 PRINTABLE|ALPHA, /* i */
127 PRINTABLE|ALPHA, /* j */
128 PRINTABLE|ALPHA, /* k */
129 PRINTABLE|ALPHA, /* l */
130 PRINTABLE|ALPHA, /* m */
131 PRINTABLE|ALPHA, /* n */
132 PRINTABLE|ALPHA, /* o */
133 PRINTABLE|ALPHA, /* p */
134 PRINTABLE|ALPHA, /* q */
135 PRINTABLE|ALPHA, /* r */
136 PRINTABLE|ALPHA, /* s */
137 PRINTABLE|ALPHA, /* t */
138 PRINTABLE|ALPHA, /* u */
139 PRINTABLE|ALPHA, /* v */
140 PRINTABLE|ALPHA, /* w */
141 PRINTABLE|ALPHA, /* x */
142 PRINTABLE|ALPHA, /* y */
143 PRINTABLE|ALPHA, /* z */
151 static int lex_unget_c;
153 #ifndef ao_scheme_getc
154 #define ao_scheme_getc(f) getc(f)
165 c = ao_scheme_getc(in);
177 static uint16_t lex_class;
187 lex_class = ENDOFFILE;
190 lex_class = lex_classes[c];
192 } while (lex_class & IGNORE);
206 lex_class = ENDOFFILE;
241 if (c < '0' || '7' < c) {
245 v = (v << 3) + c - '0';
254 #ifndef AO_SCHEME_TOKEN_MAX
255 #define AO_SCHEME_TOKEN_MAX 128
258 static char token_string[AO_SCHEME_TOKEN_MAX];
259 static int32_t token_int;
260 static int token_len;
262 static void start_token(void) {
266 static void add_token(int c) {
267 if (c && token_len < AO_SCHEME_TOKEN_MAX - 1)
268 token_string[token_len++] = c;
271 static void end_token(void) {
272 token_string[token_len] = '\0';
275 #ifdef AO_SCHEME_FEATURE_FLOAT
276 static float token_float;
283 static const struct namedfloat namedfloats[] = {
284 { .name = "+inf.0", .value = INFINITY },
285 { .name = "-inf.0", .value = -INFINITY },
286 { .name = "+nan.0", .value = NAN },
287 { .name = "-nan.0", .value = NAN },
290 #define NUM_NAMED_FLOATS (sizeof namedfloats / sizeof namedfloats[0])
294 parse_int(FILE *in, int base)
302 if ((lex_class & HEX_DIGIT) == 0) {
306 if ('0' <= c && c <= '9')
309 cval = (c | ('a' - 'A')) - 'a' + 10;
310 token_int = token_int * base + cval;
323 if (lex_class & ENDOFFILE)
326 if (lex_class & WHITE)
329 if (lex_class & COMMENT) {
330 while ((c = lexc(in)) != '\n') {
331 if (lex_class & ENDOFFILE)
337 if (lex_class & SPECIAL) {
349 #ifdef AO_SCHEME_FEATURE_QUASI
355 return UNQUOTE_SPLICING;
370 #ifdef AO_SCHEME_FEATURE_VECTOR
377 if (token_len == 0) {
379 if (!(lex_class & ALPHA))
382 if (lex_class & ALPHA)
392 token_int = token_string[0];
393 else if (!strcmp(token_string, "space"))
395 else if (!strcmp(token_string, "newline"))
397 else if (!strcmp(token_string, "tab"))
399 else if (!strcmp(token_string, "return"))
401 else if (!strcmp(token_string, "formfeed"))
404 ao_scheme_error(AO_SCHEME_INVALID, "invalid character token #\\%s", token_string);
409 return parse_int(in, 16);
411 return parse_int(in, 8);
413 return parse_int(in, 2);
416 if (lex_class & STRINGC) {
421 if (lex_class & (STRINGC|ENDOFFILE)) {
428 if (lex_class & PRINTABLE) {
429 #ifdef AO_SCHEME_FEATURE_FLOAT
439 if (!(lex_class & NUMBER)) {
441 #ifdef AO_SCHEME_FEATURE_FLOAT
445 #ifdef AO_SCHEME_FEATURE_FLOAT
446 if (!(lex_class & INTEGER))
448 if (token_len != epos &&
457 #ifdef AO_SCHEME_FEATURE_FLOAT
458 if (c == '.' && epos != 0)
460 if (c == 'e' || c == 'E') {
464 epos = token_len + 1;
467 if (lex_class & DIGIT) {
470 token_int = token_int * 10 + c - '0';
475 if ((lex_class & (NOTNAME))
476 #ifdef AO_SCHEME_FEATURE_FLOAT
477 && (c != '.' || !isfloat)
480 #ifdef AO_SCHEME_FEATURE_FLOAT
485 if (isint && hasdigit) {
487 token_int = -token_int;
490 #ifdef AO_SCHEME_FEATURE_FLOAT
491 if (isfloat && hasdigit) {
492 token_float = strtof(token_string, NULL);
495 for (u = 0; u < NUM_NAMED_FLOATS; u++)
496 if (!strcmp(namedfloats[u].name, token_string)) {
497 token_float = namedfloats[u].value;
508 static inline int lex(FILE *in)
510 int parse_token = _lex(in);
511 RDBGI("token %d \"%s\"\n", parse_token, token_string);
515 static int parse_token;
517 int ao_scheme_read_list;
518 struct ao_scheme_cons *ao_scheme_read_cons;
519 struct ao_scheme_cons *ao_scheme_read_cons_tail;
520 struct ao_scheme_cons *ao_scheme_read_stack;
521 static int ao_scheme_read_state;
523 #define READ_IN_QUOTE 0x01
524 #define READ_SAW_DOT 0x02
525 #define READ_DONE_DOT 0x04
526 #define READ_SAW_VECTOR 0x08
529 push_read_stack(int read_state)
531 RDBGI("push read stack %p 0x%x\n", ao_scheme_read_cons, read_state);
533 if (ao_scheme_read_list) {
534 ao_scheme_read_stack = ao_scheme_cons_cons(ao_scheme_cons_poly(ao_scheme_read_cons),
535 ao_scheme_cons(ao_scheme_int_poly(read_state),
536 ao_scheme_cons_poly(ao_scheme_read_stack)));
537 if (!ao_scheme_read_stack)
540 ao_scheme_read_state = read_state;
541 ao_scheme_read_cons = NULL;
542 ao_scheme_read_cons_tail = NULL;
550 if (ao_scheme_read_list) {
551 ao_scheme_read_cons = ao_scheme_poly_cons(ao_scheme_read_stack->car);
552 ao_scheme_read_stack = ao_scheme_poly_cons(ao_scheme_read_stack->cdr);
553 read_state = ao_scheme_poly_int(ao_scheme_read_stack->car);
554 ao_scheme_read_stack = ao_scheme_poly_cons(ao_scheme_read_stack->cdr);
555 for (ao_scheme_read_cons_tail = ao_scheme_read_cons;
556 ao_scheme_read_cons_tail && ao_scheme_read_cons_tail->cdr;
557 ao_scheme_read_cons_tail = ao_scheme_poly_cons(ao_scheme_read_cons_tail->cdr))
560 read_state = ao_scheme_read_state;
561 ao_scheme_read_cons = NULL;
562 ao_scheme_read_cons_tail = NULL;
563 ao_scheme_read_stack = NULL;
564 ao_scheme_read_state = 0;
567 RDBGI("pop read stack %p %d\n", ao_scheme_read_cons, read_state);
571 #ifdef AO_SCHEME_FEATURE_VECTOR
572 #define is_open(t) ((t) == OPEN || (t) == OPEN_VECTOR)
574 #define is_open(t) ((t) == OPEN)
578 ao_scheme_read(FILE *in)
580 struct ao_scheme_atom *atom;
581 struct ao_scheme_string *string;
583 ao_poly v = AO_SCHEME_NIL;
585 ao_scheme_read_list = 0;
587 ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = NULL;
589 parse_token = lex(in);
590 while (is_open(parse_token)) {
591 #ifdef AO_SCHEME_FEATURE_VECTOR
592 if (parse_token == OPEN_VECTOR)
593 read_state |= READ_SAW_VECTOR;
595 if (!push_read_stack(read_state))
596 return AO_SCHEME_NIL;
597 ao_scheme_read_list++;
599 parse_token = lex(in);
602 switch (parse_token) {
605 if (ao_scheme_read_list)
606 ao_scheme_error(AO_SCHEME_EOF, "unexpected end of file");
607 return _ao_scheme_atom_eof;
610 atom = ao_scheme_atom_intern(token_string);
612 v = ao_scheme_atom_poly(atom);
617 v = ao_scheme_integer_poly(token_int);
619 #ifdef AO_SCHEME_FEATURE_FLOAT
621 v = ao_scheme_float_get(token_float);
625 v = _ao_scheme_bool_true;
628 v = _ao_scheme_bool_false;
631 string = ao_scheme_string_new(token_string);
633 v = ao_scheme_string_poly(string);
638 #ifdef AO_SCHEME_FEATURE_QUASI
641 case UNQUOTE_SPLICING:
643 if (!push_read_stack(read_state))
644 return AO_SCHEME_NIL;
645 ao_scheme_read_list++;
646 read_state = READ_IN_QUOTE;
647 switch (parse_token) {
649 v = _ao_scheme_atom_quote;
651 #ifdef AO_SCHEME_FEATURE_QUASI
653 v = _ao_scheme_atom_quasiquote;
656 v = _ao_scheme_atom_unquote;
658 case UNQUOTE_SPLICING:
659 v = _ao_scheme_atom_unquote2dsplicing;
665 if (!ao_scheme_read_list) {
669 v = ao_scheme_cons_poly(ao_scheme_read_cons);
670 --ao_scheme_read_list;
671 read_state = pop_read_stack();
672 #ifdef AO_SCHEME_FEATURE_VECTOR
673 if (read_state & READ_SAW_VECTOR) {
674 v = ao_scheme_vector_poly(ao_scheme_list_to_vector(ao_scheme_poly_cons(v)));
675 read_state &= ~READ_SAW_VECTOR;
680 if (!ao_scheme_read_list) {
681 ao_scheme_error(AO_SCHEME_INVALID, ". outside of cons");
682 return AO_SCHEME_NIL;
684 if (!ao_scheme_read_cons) {
685 ao_scheme_error(AO_SCHEME_INVALID, ". first in cons");
686 return AO_SCHEME_NIL;
688 read_state |= READ_SAW_DOT;
692 /* loop over QUOTE ends */
694 if (!ao_scheme_read_list)
697 if (read_state & READ_DONE_DOT) {
698 ao_scheme_error(AO_SCHEME_INVALID, ". not last in cons");
699 return AO_SCHEME_NIL;
702 if (read_state & READ_SAW_DOT) {
703 read_state |= READ_DONE_DOT;
704 ao_scheme_read_cons_tail->cdr = v;
706 struct ao_scheme_cons *read = ao_scheme_cons_cons(v, AO_SCHEME_NIL);
708 return AO_SCHEME_NIL;
710 if (ao_scheme_read_cons_tail)
711 ao_scheme_read_cons_tail->cdr = ao_scheme_cons_poly(read);
713 ao_scheme_read_cons = read;
714 ao_scheme_read_cons_tail = read;
717 if (!(read_state & READ_IN_QUOTE) || !ao_scheme_read_cons->cdr)
720 v = ao_scheme_cons_poly(ao_scheme_read_cons);
721 --ao_scheme_read_list;
722 read_state = pop_read_stack();