altos/lisp: Add non-cons cdr support

The cdr of a cons can be any value; add support for lexing and
printing them.

Signed-off-by: Keith Packard <keithp@keithp.com>

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index 980514ccb826afe15d74f6f350a6295e9c4b19f8..79f8fcc3a9835713a25b604ab57516967db9a06e 100644 (file)
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -499,7 +499,10 @@ ao_lisp_stack_fetch(int id) {
 extern const struct ao_lisp_type ao_lisp_cons_type;
 
 struct ao_lisp_cons *
-ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr);
+ao_lisp_cons_cons(ao_poly car, ao_poly cdr);
+
+ao_poly
+ao_lisp__cons(ao_poly car, ao_poly cdr);
 
 extern struct ao_lisp_cons *ao_lisp_cons_free_list;
 

diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c
index 902f60e2e9b6f83b355264e875ad865096a1ab48..5a960873222500a9834a15b99bf6260211ac11ba 100644 (file)
--- a/src/lisp/ao_lisp_builtin.c
+++ b/src/lisp/ao_lisp_builtin.c
@@ -190,11 +190,9 @@ ao_lisp_cons(struct ao_lisp_cons *cons)
        ao_poly car, cdr;
        if(!ao_lisp_check_argc(_ao_lisp_atom_cons, cons, 2, 2))
                return AO_LISP_NIL;
-       if (!ao_lisp_check_argt(_ao_lisp_atom_cons, cons, 1, AO_LISP_CONS, 1))
-               return AO_LISP_NIL;
        car = ao_lisp_arg(cons, 0);
        cdr = ao_lisp_arg(cons, 1);
-       return ao_lisp_cons_poly(ao_lisp_cons_cons(car, ao_lisp_poly_cons(cdr)));
+       return ao_lisp__cons(car, cdr);
 }
 
 ao_poly
@@ -247,14 +245,12 @@ ao_lisp_set(struct ao_lisp_cons *cons)
 ao_poly
 ao_lisp_setq(struct ao_lisp_cons *cons)
 {
-       struct ao_lisp_cons     *expand = 0;
        if (!ao_lisp_check_argc(_ao_lisp_atom_setq, cons, 2, 2))
                return AO_LISP_NIL;
-       expand = ao_lisp_cons_cons(_ao_lisp_atom_set,
-                                  ao_lisp_cons_cons(ao_lisp_cons_poly(ao_lisp_cons_cons(_ao_lisp_atom_quote,
-                                                                      ao_lisp_cons_cons(cons->car, NULL))),
-                                                    ao_lisp_poly_cons(cons->cdr)));
-       return ao_lisp_cons_poly(expand);
+       return ao_lisp__cons(_ao_lisp_atom_set,
+                            ao_lisp__cons(ao_lisp__cons(_ao_lisp_atom_quote,
+                                                        ao_lisp__cons(cons->car, AO_LISP_NIL)),
+                                          cons->cdr));
 }
 
 ao_poly

diff --git a/src/lisp/ao_lisp_cons.c b/src/lisp/ao_lisp_cons.c
index d2b60c9a6561b06f1ec926d864d0c9934de951af..81a16a7ae05ff1bbf859b96d26e402a2b33542df 100644 (file)
--- a/src/lisp/ao_lisp_cons.c
+++ b/src/lisp/ao_lisp_cons.c
@@ -72,7 +72,7 @@ const struct ao_lisp_type ao_lisp_cons_type = {
 struct ao_lisp_cons *ao_lisp_cons_free_list;
 
 struct ao_lisp_cons *
-ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr)
+ao_lisp_cons_cons(ao_poly car, ao_poly cdr)
 {
        struct ao_lisp_cons     *cons;
 
@@ -81,18 +81,24 @@ ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr)
                ao_lisp_cons_free_list = ao_lisp_poly_cons(cons->cdr);
        } else {
                ao_lisp_poly_stash(0, car);
-               ao_lisp_cons_stash(0, cdr);
+               ao_lisp_poly_stash(1, cdr);
                cons = ao_lisp_alloc(sizeof (struct ao_lisp_cons));
                car = ao_lisp_poly_fetch(0);
-               cdr = ao_lisp_cons_fetch(0);
+               cdr = ao_lisp_poly_fetch(1);
                if (!cons)
                        return NULL;
        }
        cons->car = car;
-       cons->cdr = ao_lisp_cons_poly(cdr);
+       cons->cdr = cdr;
        return cons;
 }
 
+ao_poly
+ao_lisp__cons(ao_poly car, ao_poly cdr)
+{
+       return ao_lisp_cons_poly(ao_lisp_cons_cons(car, cdr));
+}
+
 void
 ao_lisp_cons_free(struct ao_lisp_cons *cons)
 {
@@ -114,8 +120,15 @@ ao_lisp_cons_print(ao_poly c)
                if (!first)
                        printf(" ");
                ao_lisp_poly_print(cons->car);
-               cons = ao_lisp_poly_cons(cons->cdr);
-               first = 0;
+               c = cons->cdr;
+               if (ao_lisp_poly_type(c) == AO_LISP_CONS) {
+                       cons = ao_lisp_poly_cons(c);
+                       first = 0;
+               } else {
+                       printf(" . ");
+                       ao_lisp_poly_print(c);
+                       cons = NULL;
+               }
        }
        printf(")");
 }

diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index 3be7c9c4fa68c2fb29b60ec6f8b10ec6216ae705..3e68d14af3c73734738d724538fe614e9b5ee673 100644 (file)
--- a/src/lisp/ao_lisp_eval.c
+++ b/src/lisp/ao_lisp_eval.c
@@ -210,7 +210,7 @@ ao_lisp_eval_formal(void)
        }
 
        /* Append formal to list of values */
-       formal = ao_lisp_cons_poly(ao_lisp_cons_cons(ao_lisp_v, NULL));
+       formal = ao_lisp__cons(ao_lisp_v, AO_LISP_NIL);
        if (!formal)
                return 0;
 

diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index d067ea07ef14cbd87511a83e687bd5a8ed8c1b9b..d7c8d7a66dc5999c82436df0ecda201cb59efe4c 100644 (file)
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -437,7 +437,7 @@ dump_busy(void)
 #define DUMP_BUSY()
 #endif
 
-static const struct ao_lisp_type const *ao_lisp_types[AO_LISP_NUM_TYPE] = {
+static const struct ao_lisp_type *ao_lisp_types[AO_LISP_NUM_TYPE] = {
        [AO_LISP_CONS] = &ao_lisp_cons_type,
        [AO_LISP_INT] = NULL,
        [AO_LISP_STRING] = &ao_lisp_string_type,

diff --git a/src/lisp/ao_lisp_read.c b/src/lisp/ao_lisp_read.c
index 84ef2a616bb09fdbdb9cebba3d4a2e889c14762b..550f62c2c19d94c3c5431ea2fa0eb0fedf1a330e 100644 (file)
--- a/src/lisp/ao_lisp_read.c
+++ b/src/lisp/ao_lisp_read.c
@@ -62,7 +62,7 @@ static const uint16_t lex_classes[128] = {
        PRINTABLE|SIGN,         /* + */
        PRINTABLE,              /* , */
        PRINTABLE|SIGN,         /* - */
-       PRINTABLE,              /* . */
+       PRINTABLE|DOTC,         /* . */
        PRINTABLE,              /* / */
        PRINTABLE|DIGIT,        /* 0 */
        PRINTABLE|DIGIT,        /* 1 */
@@ -262,7 +262,7 @@ static inline void end_token(void) {
 }
 
 static int
-lex(void)
+_lex(void)
 {
        int     c;
 
@@ -295,6 +295,11 @@ lex(void)
                                return QUOTE;
                        }
                }
+               if (lex_class & (DOTC)) {
+                       add_token(c);
+                       end_token();
+                       return DOT;
+               }
                if (lex_class & TWIDDLE) {
                        token_int = lexc();
                        return NUM;
@@ -355,21 +360,32 @@ lex(void)
        }
 }
 
+static inline int lex(void)
+{
+       int     parse_token = _lex();
+       DBGI("token %d (%s)\n", parse_token, token_string);
+       return parse_token;
+}
+
 static int parse_token;
 
 struct ao_lisp_cons    *ao_lisp_read_cons;
 struct ao_lisp_cons    *ao_lisp_read_cons_tail;
 struct ao_lisp_cons    *ao_lisp_read_stack;
 
+#define READ_IN_QUOTE  0x01
+#define READ_SAW_DOT   0x02
+#define READ_DONE_DOT  0x04
+
 static int
-push_read_stack(int cons, int in_quote)
+push_read_stack(int cons, int read_state)
 {
-       DBGI("push read stack %p %d\n", ao_lisp_read_cons, in_quote);
+       DBGI("push read stack %p 0x%x\n", ao_lisp_read_cons, read_state);
        DBG_IN();
        if (cons) {
                ao_lisp_read_stack = ao_lisp_cons_cons(ao_lisp_cons_poly(ao_lisp_read_cons),
-                                              ao_lisp_cons_cons(ao_lisp_int_poly(in_quote),
-                                                                ao_lisp_read_stack));
+                                                      ao_lisp__cons(ao_lisp_int_poly(read_state),
+                                                                    ao_lisp_cons_poly(ao_lisp_read_stack)));
                if (!ao_lisp_read_stack)
                        return 0;
        }
@@ -381,11 +397,11 @@ push_read_stack(int cons, int in_quote)
 static int
 pop_read_stack(int cons)
 {
-       int     in_quote = 0;
+       int     read_state = 0;
        if (cons) {
                ao_lisp_read_cons = ao_lisp_poly_cons(ao_lisp_read_stack->car);
                ao_lisp_read_stack = ao_lisp_poly_cons(ao_lisp_read_stack->cdr);
-               in_quote = ao_lisp_poly_int(ao_lisp_read_stack->car);
+               read_state = ao_lisp_poly_int(ao_lisp_read_stack->car);
                ao_lisp_read_stack = ao_lisp_poly_cons(ao_lisp_read_stack->cdr);
                for (ao_lisp_read_cons_tail = ao_lisp_read_cons;
                     ao_lisp_read_cons_tail && ao_lisp_read_cons_tail->cdr;
@@ -397,8 +413,8 @@ pop_read_stack(int cons)
                ao_lisp_read_stack = 0;
        }
        DBG_OUT();
-       DBGI("pop read stack %p %d\n", ao_lisp_read_cons, in_quote);
-       return in_quote;
+       DBGI("pop read stack %p %d\n", ao_lisp_read_cons, read_state);
+       return read_state;
 }
 
 ao_poly
@@ -407,23 +423,21 @@ ao_lisp_read(void)
        struct ao_lisp_atom     *atom;
        char                    *string;
        int                     cons;
-       int                     in_quote;
+       int                     read_state;
        ao_poly                 v;
 
-       parse_token = lex();
-       DBGI("token %d (%s)\n", parse_token, token_string);
 
        cons = 0;
-       in_quote = 0;
+       read_state = 0;
        ao_lisp_read_cons = ao_lisp_read_cons_tail = ao_lisp_read_stack = 0;
        for (;;) {
+               parse_token = lex();
                while (parse_token == OPEN) {
-                       if (!push_read_stack(cons, in_quote))
+                       if (!push_read_stack(cons, read_state))
                                return AO_LISP_NIL;
                        cons++;
-                       in_quote = 0;
+                       read_state = 0;
                        parse_token = lex();
-                       DBGI("token %d (%s)\n", parse_token, token_string);
                }
 
                switch (parse_token) {
@@ -451,10 +465,10 @@ ao_lisp_read(void)
                                v = AO_LISP_NIL;
                        break;
                case QUOTE:
-                       if (!push_read_stack(cons, in_quote))
+                       if (!push_read_stack(cons, read_state))
                                return AO_LISP_NIL;
                        cons++;
-                       in_quote = 1;
+                       read_state |= READ_IN_QUOTE;
                        v = _ao_lisp_atom_quote;
                        break;
                case CLOSE:
@@ -464,8 +478,19 @@ ao_lisp_read(void)
                        }
                        v = ao_lisp_cons_poly(ao_lisp_read_cons);
                        --cons;
-                       in_quote = pop_read_stack(cons);
+                       read_state = pop_read_stack(cons);
                        break;
+               case DOT:
+                       if (!cons) {
+                               ao_lisp_error(AO_LISP_INVALID, ". outside of cons");
+                               return AO_LISP_NIL;
+                       }
+                       if (!ao_lisp_read_cons) {
+                               ao_lisp_error(AO_LISP_INVALID, ". first in cons");
+                               return AO_LISP_NIL;
+                       }
+                       read_state |= READ_SAW_DOT;
+                       continue;
                }
 
                /* loop over QUOTE ends */
@@ -473,26 +498,33 @@ ao_lisp_read(void)
                        if (!cons)
                                return v;
 
-                       struct ao_lisp_cons     *read = ao_lisp_cons_cons(v, NULL);
-                       if (!read)
+                       if (read_state & READ_DONE_DOT) {
+                               ao_lisp_error(AO_LISP_INVALID, ". not last in cons");
                                return AO_LISP_NIL;
+                       }
 
-                       if (ao_lisp_read_cons_tail)
-                               ao_lisp_read_cons_tail->cdr = ao_lisp_cons_poly(read);
-                       else
-                               ao_lisp_read_cons = read;
-                       ao_lisp_read_cons_tail = read;
+                       if (read_state & READ_SAW_DOT) {
+                               read_state |= READ_DONE_DOT;
+                               ao_lisp_read_cons_tail->cdr = v;
+                       } else {
+                               struct ao_lisp_cons     *read = ao_lisp_cons_cons(v, AO_LISP_NIL);
+                               if (!read)
+                                       return AO_LISP_NIL;
 
-                       if (!in_quote || !ao_lisp_read_cons->cdr)
+                               if (ao_lisp_read_cons_tail)
+                                       ao_lisp_read_cons_tail->cdr = ao_lisp_cons_poly(read);
+                               else
+                                       ao_lisp_read_cons = read;
+                               ao_lisp_read_cons_tail = read;
+                       }
+
+                       if (!(read_state & READ_IN_QUOTE) || !ao_lisp_read_cons->cdr)
                                break;
 
                        v = ao_lisp_cons_poly(ao_lisp_read_cons);
                        --cons;
-                       in_quote = pop_read_stack(cons);
+                       read_state = pop_read_stack(cons);
                }
-
-               parse_token = lex();
-               DBGI("token %d (%s)\n", parse_token, token_string);
        }
        return v;
 }

diff --git a/src/lisp/ao_lisp_read.h b/src/lisp/ao_lisp_read.h
index 1c994d56fd60b0468c4fc6db356331f05c95daf8..30dcac3f4bf10e7102763ada337340e304ff4b46 100644 (file)
--- a/src/lisp/ao_lisp_read.h
+++ b/src/lisp/ao_lisp_read.h
@@ -22,6 +22,7 @@
 # define QUOTE 4
 # define STRING        5
 # define NUM   6
+# define DOT   7
 
 /*
  * character classes
@@ -42,8 +43,9 @@
 # define VBAR          0x00001000      /* | */
 # define TWIDDLE       0x00002000      /* ~ */
 # define STRINGC       0x00004000      /* " */
+# define DOTC          0x00008000      /* . */
 
-# define NOTNAME       (STRINGC|TWIDDLE|VBAR|QUOTEC|COMMENT|ENDOFFILE|WHITE|KET|BRA)
+# define NOTNAME       (STRINGC|TWIDDLE|VBAR|QUOTEC|COMMENT|ENDOFFILE|WHITE|KET|BRA|DOTC)
 # define NUMBER                (DIGIT|SIGN)
 
 #endif /* _AO_LISP_READ_H_ */

diff --git a/src/lisp/ao_lisp_string.c b/src/lisp/ao_lisp_string.c
index cd7b27a97f1f67f7136f03f650cbf2aacaba0511..af23f7b327f3404d24e06394b65a1b4bcadeddf9 100644 (file)
--- a/src/lisp/ao_lisp_string.c
+++ b/src/lisp/ao_lisp_string.c
@@ -103,7 +103,7 @@ ao_lisp_string_unpack(char *a)
                ao_lisp_cons_stash(0, cons);
                ao_lisp_cons_stash(1, tail);
                ao_lisp_string_stash(0, a);
-               struct ao_lisp_cons     *n = ao_lisp_cons_cons(ao_lisp_int_poly(c), NULL);
+               struct ao_lisp_cons     *n = ao_lisp_cons_cons(ao_lisp_int_poly(c), AO_LISP_NIL);
                a = ao_lisp_string_fetch(0);
                cons = ao_lisp_cons_fetch(0);
                tail = ao_lisp_cons_fetch(1);