altos/lisp: Add apply

[fw/altos] / src / lisp / ao_lisp_read.c

diff --git a/src/lisp/ao_lisp_read.c b/src/lisp/ao_lisp_read.c
index 550f62c2c19d94c3c5431ea2fa0eb0fedf1a330e..8c06e19898f93c2300e60711396063f1666eb50a 100644 (file)
--- a/src/lisp/ao_lisp_read.c
+++ b/src/lisp/ao_lisp_read.c
@@ -51,18 +51,18 @@ static const uint16_t       lex_classes[128] = {
        PRINTABLE|WHITE,        /*    */
        PRINTABLE,              /* ! */
        PRINTABLE|STRINGC,      /* " */
-       PRINTABLE|COMMENT,      /* # */
+       PRINTABLE|POUND,        /* # */
        PRINTABLE,              /* $ */
        PRINTABLE,              /* % */
        PRINTABLE,              /* & */
-       PRINTABLE|QUOTEC,       /* ' */
-       PRINTABLE|BRA,          /* ( */
-       PRINTABLE|KET,          /* ) */
+       PRINTABLE|SPECIAL,      /* ' */
+       PRINTABLE|SPECIAL,      /* ( */
+       PRINTABLE|SPECIAL,      /* ) */
        PRINTABLE,              /* * */
        PRINTABLE|SIGN,         /* + */
        PRINTABLE,              /* , */
        PRINTABLE|SIGN,         /* - */
-       PRINTABLE|DOTC,         /* . */
+       PRINTABLE|SPECIAL,      /* . */
        PRINTABLE,              /* / */
        PRINTABLE|DIGIT,        /* 0 */
        PRINTABLE|DIGIT,        /* 1 */
@@ -142,7 +142,7 @@ static const uint16_t       lex_classes[128] = {
        PRINTABLE,              /*  { */
        PRINTABLE|VBAR,         /*  | */
        PRINTABLE,              /*  } */
-       PRINTABLE|TWIDDLE,      /*  ~ */
+       PRINTABLE,              /*  ~ */
        IGNORE,                 /*  ^? */
 };
 
@@ -168,16 +168,38 @@ lex_unget(int c)
                lex_unget_c = c;
 }
 
+static uint16_t        lex_class;
+
 static int
-lex_quoted (void)
+lexc(void)
+{
+       int     c;
+       do {
+               c = lex_get();
+               if (c == EOF) {
+                       c = 0;
+                       lex_class = ENDOFFILE;
+               } else {
+                       c &= 0x7f;
+                       lex_class = lex_classes[c];
+               }
+       } while (lex_class & IGNORE);
+       return c;
+}
+
+static int
+lex_quoted(void)
 {
        int     c;
        int     v;
        int     count;
 
        c = lex_get();
-       if (c == EOF)
-               return EOF;
+       if (c == EOF) {
+               lex_class = ENDOFFILE;
+               return 0;
+       }
+       lex_class = 0;
        c &= 0x7f;
        switch (c) {
        case 'n':
@@ -220,32 +242,6 @@ lex_quoted (void)
        }
 }
 
-static uint16_t        lex_class;
-
-static int
-lexc(void)
-{
-       int     c;
-       do {
-               c = lex_get();
-               if (c == EOF) {
-                       lex_class = ENDOFFILE;
-                       c = 0;
-               } else {
-                       c &= 0x7f;
-                       lex_class = lex_classes[c];
-                       if (lex_class & BACKSLASH) {
-                               c = lex_quoted();
-                               if (c == EOF)
-                                       lex_class = ENDOFFILE;
-                               else
-                                       lex_class = PRINTABLE;
-                       }
-               }
-       } while (lex_class & IGNORE);
-       return c;
-}
-
 #define AO_LISP_TOKEN_MAX      32
 
 static char    token_string[AO_LISP_TOKEN_MAX];
@@ -283,30 +279,76 @@ _lex(void)
                        continue;
                }
 
-               if (lex_class & (BRA|KET|QUOTEC)) {
+               if (lex_class & SPECIAL) {
                        add_token(c);
                        end_token();
                        switch (c) {
                        case '(':
+                       case '[':
                                return OPEN;
                        case ')':
+                       case ']':
                                return CLOSE;
                        case '\'':
                                return QUOTE;
+                       case '.':
+                               return DOT;
                        }
                }
-               if (lex_class & (DOTC)) {
-                       add_token(c);
-                       end_token();
-                       return DOT;
-               }
-               if (lex_class & TWIDDLE) {
-                       token_int = lexc();
-                       return NUM;
+               if (lex_class & POUND) {
+                       c = lexc();
+                       switch (c) {
+                       case 't':
+                               add_token(c);
+                               end_token();
+                               return BOOL;
+                       case 'f':
+                               add_token(c);
+                               end_token();
+                               return BOOL;
+                       case '\\':
+                               for (;;) {
+                                       int alphabetic;
+                                       c = lexc();
+                                       alphabetic = (('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z'));
+                                       if (token_len == 0) {
+                                               add_token(c);
+                                               if (!alphabetic)
+                                                       break;
+                                       } else {
+                                               if (alphabetic)
+                                                       add_token(c);
+                                               else {
+                                                       lex_unget(c);
+                                                       break;
+                                               }
+                                       }
+                               }
+                               end_token();
+                               if (token_len == 1)
+                                       token_int = token_string[0];
+                               else if (!strcmp(token_string, "space"))
+                                       token_int = ' ';
+                               else if (!strcmp(token_string, "newline"))
+                                       token_int = '\n';
+                               else if (!strcmp(token_string, "tab"))
+                                       token_int = '\t';
+                               else if (!strcmp(token_string, "return"))
+                                       token_int = '\r';
+                               else if (!strcmp(token_string, "formfeed"))
+                                       token_int = '\f';
+                               else {
+                                       ao_lisp_error(AO_LISP_INVALID, "invalid character token #\\%s", token_string);
+                                       continue;
+                               }
+                               return NUM;
+                       }
                }
                if (lex_class & STRINGC) {
                        for (;;) {
                                c = lexc();
+                               if (lex_class & BACKSLASH)
+                                       c = lex_quoted();
                                if (lex_class & (STRINGC|ENDOFFILE)) {
                                        end_token();
                                        return STRING;
@@ -457,6 +499,12 @@ ao_lisp_read(void)
                case NUM:
                        v = ao_lisp_int_poly(token_int);
                        break;
+               case BOOL:
+                       if (token_string[0] == 't')
+                               v = _ao_lisp_bool_true;
+                       else
+                               v = _ao_lisp_bool_false;
+                       break;
                case STRING:
                        string = ao_lisp_string_copy(token_string);
                        if (string)
@@ -468,7 +516,7 @@ ao_lisp_read(void)
                        if (!push_read_stack(cons, read_state))
                                return AO_LISP_NIL;
                        cons++;
-                       read_state |= READ_IN_QUOTE;
+                       read_state = READ_IN_QUOTE;
                        v = _ao_lisp_atom_quote;
                        break;
                case CLOSE: