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|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, /* ; */
86 PRINTABLE|HEX_LETTER, /* A */
87 PRINTABLE|HEX_LETTER, /* B */
88 PRINTABLE|HEX_LETTER, /* C */
89 PRINTABLE|HEX_LETTER, /* D */
90 PRINTABLE|FLOATC|HEX_LETTER,/* E */
91 PRINTABLE|HEX_LETTER, /* F */
117 PRINTABLE|SPECIAL_QUASI, /* ` */
118 PRINTABLE|HEX_LETTER, /* a */
119 PRINTABLE|HEX_LETTER, /* b */
120 PRINTABLE|HEX_LETTER, /* c */
121 PRINTABLE|HEX_LETTER, /* d */
122 PRINTABLE|FLOATC|HEX_LETTER,/* e */
123 PRINTABLE|HEX_LETTER, /* f */
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;
236 if (c < '0' || '7' < c) {
240 v = (v << 3) + c - '0';
249 #ifndef AO_SCHEME_TOKEN_MAX
250 #define AO_SCHEME_TOKEN_MAX 128
253 static char token_string[AO_SCHEME_TOKEN_MAX];
254 static int32_t token_int;
255 static int token_len;
257 static inline void add_token(int c) {
258 if (c && token_len < AO_SCHEME_TOKEN_MAX - 1)
259 token_string[token_len++] = c;
262 static inline void del_token(void) {
267 static inline void end_token(void) {
268 token_string[token_len] = '\0';
271 #ifdef AO_SCHEME_FEATURE_FLOAT
272 static float token_float;
279 static const struct namedfloat namedfloats[] = {
280 { .name = "+inf.0", .value = INFINITY },
281 { .name = "-inf.0", .value = -INFINITY },
282 { .name = "+nan.0", .value = NAN },
283 { .name = "-nan.0", .value = NAN },
286 #define NUM_NAMED_FLOATS (sizeof namedfloats / sizeof namedfloats[0])
298 if ((lex_class & HEX_DIGIT) == 0) {
304 if ('0' <= c && c <= '9')
307 cval = (c | ('a' - 'A')) - 'a' + 10;
308 token_int = token_int * base + cval;
321 if (lex_class & ENDOFFILE)
324 if (lex_class & WHITE)
327 if (lex_class & COMMENT) {
328 while ((c = lexc()) != '\n') {
329 if (lex_class & ENDOFFILE)
335 if (lex_class & (SPECIAL|DOTC)) {
349 #ifdef AO_SCHEME_FEATURE_QUASI
357 return UNQUOTE_SPLICING;
376 #ifdef AO_SCHEME_FEATURE_VECTOR
384 alphabetic = (('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z'));
385 if (token_len == 0) {
400 token_int = token_string[0];
401 else if (!strcmp(token_string, "space"))
403 else if (!strcmp(token_string, "newline"))
405 else if (!strcmp(token_string, "tab"))
407 else if (!strcmp(token_string, "return"))
409 else if (!strcmp(token_string, "formfeed"))
412 ao_scheme_error(AO_SCHEME_INVALID, "invalid character token #\\%s", token_string);
417 return parse_int(16);
424 if (lex_class & STRINGC) {
429 if (lex_class & (STRINGC|ENDOFFILE)) {
436 if (lex_class & PRINTABLE) {
437 #ifdef AO_SCHEME_FEATURE_FLOAT
447 if (!(lex_class & NUMBER)) {
449 #ifdef AO_SCHEME_FEATURE_FLOAT
453 #ifdef AO_SCHEME_FEATURE_FLOAT
454 if (!(lex_class & INTEGER))
456 if (token_len != epos &&
465 #ifdef AO_SCHEME_FEATURE_FLOAT
466 if (c == '.' && epos != 0)
468 if (c == 'e' || c == 'E') {
472 epos = token_len + 1;
475 if (lex_class & DIGIT) {
478 token_int = token_int * 10 + c - '0';
483 if ((lex_class & (NOTNAME))
484 #ifdef AO_SCHEME_FEATURE_FLOAT
485 && (c != '.' || !isfloat)
488 #ifdef AO_SCHEME_FEATURE_FLOAT
491 // if (lex_class & ENDOFFILE)
495 if (isint && hasdigit) {
497 token_int = -token_int;
500 #ifdef AO_SCHEME_FEATURE_FLOAT
501 if (isfloat && hasdigit) {
502 token_float = strtof(token_string, NULL);
505 for (u = 0; u < NUM_NAMED_FLOATS; u++)
506 if (!strcmp(namedfloats[u].name, token_string)) {
507 token_float = namedfloats[u].value;
518 static inline int lex(void)
520 int parse_token = _lex();
521 RDBGI("token %d \"%s\"\n", parse_token, token_string);
525 static int parse_token;
527 int ao_scheme_read_list;
528 struct ao_scheme_cons *ao_scheme_read_cons;
529 struct ao_scheme_cons *ao_scheme_read_cons_tail;
530 struct ao_scheme_cons *ao_scheme_read_stack;
531 static int ao_scheme_read_state;
533 #define READ_IN_QUOTE 0x01
534 #define READ_SAW_DOT 0x02
535 #define READ_DONE_DOT 0x04
536 #define READ_SAW_VECTOR 0x08
539 push_read_stack(int read_state)
541 RDBGI("push read stack %p 0x%x\n", ao_scheme_read_cons, read_state);
543 if (ao_scheme_read_list) {
544 ao_scheme_read_stack = ao_scheme_cons_cons(ao_scheme_cons_poly(ao_scheme_read_cons),
545 ao_scheme_cons(ao_scheme_int_poly(read_state),
546 ao_scheme_cons_poly(ao_scheme_read_stack)));
547 if (!ao_scheme_read_stack)
550 ao_scheme_read_state = read_state;
551 ao_scheme_read_cons = NULL;
552 ao_scheme_read_cons_tail = NULL;
560 if (ao_scheme_read_list) {
561 ao_scheme_read_cons = ao_scheme_poly_cons(ao_scheme_read_stack->car);
562 ao_scheme_read_stack = ao_scheme_poly_cons(ao_scheme_read_stack->cdr);
563 read_state = ao_scheme_poly_int(ao_scheme_read_stack->car);
564 ao_scheme_read_stack = ao_scheme_poly_cons(ao_scheme_read_stack->cdr);
565 for (ao_scheme_read_cons_tail = ao_scheme_read_cons;
566 ao_scheme_read_cons_tail && ao_scheme_read_cons_tail->cdr;
567 ao_scheme_read_cons_tail = ao_scheme_poly_cons(ao_scheme_read_cons_tail->cdr))
570 read_state = ao_scheme_read_state;
571 ao_scheme_read_cons = NULL;
572 ao_scheme_read_cons_tail = NULL;
573 ao_scheme_read_stack = NULL;
574 ao_scheme_read_state = 0;
577 RDBGI("pop read stack %p %d\n", ao_scheme_read_cons, read_state);
581 #ifdef AO_SCHEME_FEATURE_VECTOR
582 #define is_open(t) ((t) == OPEN || (t) == OPEN_VECTOR)
584 #define is_open(t) ((t) == OPEN)
590 struct ao_scheme_atom *atom;
591 struct ao_scheme_string *string;
593 ao_poly v = AO_SCHEME_NIL;
595 ao_scheme_read_list = 0;
597 ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = NULL;
600 while (is_open(parse_token)) {
601 #ifdef AO_SCHEME_FEATURE_VECTOR
602 if (parse_token == OPEN_VECTOR)
603 read_state |= READ_SAW_VECTOR;
605 if (!push_read_stack(read_state))
606 return AO_SCHEME_NIL;
607 ao_scheme_read_list++;
612 switch (parse_token) {
615 if (ao_scheme_read_list)
616 ao_scheme_error(AO_SCHEME_EOF, "unexpected end of file");
617 return _ao_scheme_atom_eof;
620 atom = ao_scheme_atom_intern(token_string);
622 v = ao_scheme_atom_poly(atom);
627 v = ao_scheme_integer_poly(token_int);
629 #ifdef AO_SCHEME_FEATURE_FLOAT
631 v = ao_scheme_float_get(token_float);
635 if (token_string[0] == 't')
636 v = _ao_scheme_bool_true;
638 v = _ao_scheme_bool_false;
641 string = ao_scheme_string_new(token_string);
643 v = ao_scheme_string_poly(string);
648 #ifdef AO_SCHEME_FEATURE_QUASI
651 case UNQUOTE_SPLICING:
653 if (!push_read_stack(read_state))
654 return AO_SCHEME_NIL;
655 ao_scheme_read_list++;
656 read_state = READ_IN_QUOTE;
657 switch (parse_token) {
659 v = _ao_scheme_atom_quote;
661 #ifdef AO_SCHEME_FEATURE_QUASI
663 v = _ao_scheme_atom_quasiquote;
666 v = _ao_scheme_atom_unquote;
668 case UNQUOTE_SPLICING:
669 v = _ao_scheme_atom_unquote2dsplicing;
675 if (!ao_scheme_read_list) {
679 v = ao_scheme_cons_poly(ao_scheme_read_cons);
680 --ao_scheme_read_list;
681 read_state = pop_read_stack();
682 #ifdef AO_SCHEME_FEATURE_VECTOR
683 if (read_state & READ_SAW_VECTOR) {
684 v = ao_scheme_vector_poly(ao_scheme_list_to_vector(ao_scheme_poly_cons(v)));
685 read_state &= ~READ_SAW_VECTOR;
690 if (!ao_scheme_read_list) {
691 ao_scheme_error(AO_SCHEME_INVALID, ". outside of cons");
692 return AO_SCHEME_NIL;
694 if (!ao_scheme_read_cons) {
695 ao_scheme_error(AO_SCHEME_INVALID, ". first in cons");
696 return AO_SCHEME_NIL;
698 read_state |= READ_SAW_DOT;
702 /* loop over QUOTE ends */
704 if (!ao_scheme_read_list)
707 if (read_state & READ_DONE_DOT) {
708 ao_scheme_error(AO_SCHEME_INVALID, ". not last in cons");
709 return AO_SCHEME_NIL;
712 if (read_state & READ_SAW_DOT) {
713 read_state |= READ_DONE_DOT;
714 ao_scheme_read_cons_tail->cdr = v;
716 struct ao_scheme_cons *read = ao_scheme_cons_cons(v, AO_SCHEME_NIL);
718 return AO_SCHEME_NIL;
720 if (ao_scheme_read_cons_tail)
721 ao_scheme_read_cons_tail->cdr = ao_scheme_cons_poly(read);
723 ao_scheme_read_cons = read;
724 ao_scheme_read_cons_tail = read;
727 if (!(read_state & READ_IN_QUOTE) || !ao_scheme_read_cons->cdr)
730 v = ao_scheme_cons_poly(ao_scheme_read_cons);
731 --ao_scheme_read_list;
732 read_state = pop_read_stack();