altos/lisp: working on lexical scoping

Not working yet

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

diff --git a/src/lisp/Makefile b/src/lisp/Makefile
index be19b432f7e58183b95198f461412a264ba3ddb6..f7edbe41c829d50d2af55b3ecad949db85eda320 100644 (file)
--- a/src/lisp/Makefile
+++ b/src/lisp/Makefile
@@ -18,7 +18,9 @@ SRCS=\
        ao_lisp_builtin.c \
        ao_lisp_read.c \
        ao_lisp_frame.c \
        ao_lisp_builtin.c \
        ao_lisp_read.c \
        ao_lisp_frame.c \

-       ao_lisp_error.c
+       ao_lisp_lambda.c \
+       ao_lisp_eval.c \
+       ao_lisp_error.c 

 
 OBJS=$(SRCS:.c=.o)
 
 
 OBJS=$(SRCS:.c=.o)
 

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index 17f1e0f55540dbc5e55db4cfaf35ca0d3d1474b4..6a35d8ce3f0493104e4dd683a2762bb3f7dd654e 100644 (file)
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -42,7 +42,9 @@ extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST];
 #define _ao_lisp_atom_car      _atom("car")
 #define _ao_lisp_atom_cdr      _atom("cdr")
 #define _ao_lisp_atom_cons     _atom("cons")
 #define _ao_lisp_atom_car      _atom("car")
 #define _ao_lisp_atom_cdr      _atom("cdr")
 #define _ao_lisp_atom_cons     _atom("cons")

+#define _ao_lisp_atom_last     _atom("last")

 #define _ao_lisp_atom_cond     _atom("cond")
 #define _ao_lisp_atom_cond     _atom("cond")

+#define _ao_lisp_atom_lambda   _atom("lambda")

 #else
 #include "ao_lisp_const.h"
 #ifndef AO_LISP_POOL
 #else
 #include "ao_lisp_const.h"
 #ifndef AO_LISP_POOL


@@ -66,7 +68,8 @@ extern uint8_t                ao_lisp_pool[AO_LISP_POOL];
 #define AO_LISP_ATOM           4
 #define AO_LISP_BUILTIN                5
 #define AO_LISP_FRAME          6
 #define AO_LISP_ATOM           4
 #define AO_LISP_BUILTIN                5
 #define AO_LISP_FRAME          6

-#define AO_LISP_NUM_TYPE       7
+#define AO_LISP_LAMBDA         7
+#define AO_LISP_NUM_TYPE       8

 
 #define AO_LISP_NIL    0
 
 
 #define AO_LISP_NIL    0
 


@@ -114,8 +117,8 @@ ao_lisp_poly(const void *addr, ao_poly type) {
 }
 
 struct ao_lisp_type {
 }
 
 struct ao_lisp_type {

-       void    (*mark)(void *addr);

        int     (*size)(void *addr);
        int     (*size)(void *addr);

+       void    (*mark)(void *addr);

        void    (*move)(void *addr);
 };
 
        void    (*move)(void *addr);
 };
 


@@ -153,10 +156,47 @@ ao_lisp_frame_poly(struct ao_lisp_frame *frame) {
        return ao_lisp_poly(frame, AO_LISP_OTHER);
 }
 
        return ao_lisp_poly(frame, AO_LISP_OTHER);
 }
 

-#define AO_LISP_LAMBDA 0
-#define AO_LISP_NLAMBDA        1
-#define AO_LISP_MACRO  2
-#define AO_LISP_LEXPR  3
+struct ao_lisp_stack {
+       ao_poly                 prev;
+       uint8_t                 state;
+       uint8_t                 macro;
+       ao_poly                 sexprs;
+       ao_poly                 values;
+       ao_poly                 values_tail;
+       ao_poly                 frame;
+       ao_poly                 macro_frame;
+       ao_poly                 list;
+};
+
+enum eval_state {
+       eval_sexpr,
+       eval_val,
+       eval_formal,
+       eval_exec,
+       eval_lambda_done,
+       eval_cond,
+       eval_cond_test
+};
+
+static inline struct ao_lisp_stack *
+ao_lisp_poly_stack(ao_poly p)
+{
+       return ao_lisp_ref(p);
+}
+
+static inline ao_poly
+ao_lisp_stack_poly(struct ao_lisp_stack *stack)
+{
+       return ao_lisp_poly(stack, AO_LISP_OTHER);
+}
+
+extern struct ao_lisp_stack    *ao_lisp_stack;
+extern ao_poly                 ao_lisp_v;
+
+#define AO_LISP_FUNC_LAMBDA    0
+#define AO_LISP_FUNC_NLAMBDA   1
+#define AO_LISP_FUNC_MACRO     2
+#define AO_LISP_FUNC_LEXPR     3

 
 struct ao_lisp_builtin {
        uint8_t         type;
 
 struct ao_lisp_builtin {
        uint8_t         type;


@@ -165,9 +205,14 @@ struct ao_lisp_builtin {
 };
 
 enum ao_lisp_builtin_id {
 };
 
 enum ao_lisp_builtin_id {

+       builtin_lambda,
+       builtin_lexpr,
+       builtin_nlambda,
+       builtin_macro,

        builtin_car,
        builtin_cdr,
        builtin_cons,
        builtin_car,
        builtin_cdr,
        builtin_cons,

+       builtin_last,

        builtin_quote,
        builtin_set,
        builtin_setq,
        builtin_quote,
        builtin_set,
        builtin_setq,


@@ -184,7 +229,7 @@ enum ao_lisp_builtin_id {
        builtin_greater,
        builtin_less_equal,
        builtin_greater_equal,
        builtin_greater,
        builtin_less_equal,
        builtin_greater_equal,

-       builtin_last
+       _builtin_last

 };
 
 typedef ao_poly (*ao_lisp_func_t)(struct ao_lisp_cons *cons);
 };
 
 typedef ao_poly (*ao_lisp_func_t)(struct ao_lisp_cons *cons);


@@ -197,6 +242,25 @@ ao_lisp_func(struct ao_lisp_builtin *b)
        return ao_lisp_builtins[b->func];
 }
 
        return ao_lisp_builtins[b->func];
 }
 

+struct ao_lisp_lambda {
+       uint8_t         type;
+       uint8_t         args;
+       ao_poly         code;
+       ao_poly         frame;
+};
+
+static inline struct ao_lisp_lambda *
+ao_lisp_poly_lambda(ao_poly poly)
+{
+       return ao_lisp_ref(poly);
+}
+
+static inline ao_poly
+ao_lisp_lambda_poly(struct ao_lisp_lambda *lambda)
+{
+       return ao_lisp_poly(lambda, AO_LISP_OTHER);
+}
+

 static inline void *
 ao_lisp_poly_other(ao_poly poly) {
        return ao_lisp_ref(poly);
 static inline void *
 ao_lisp_poly_other(ao_poly poly) {
        return ao_lisp_ref(poly);


@@ -360,9 +424,9 @@ ao_lisp_string_patom(ao_poly s);
 /* atom */
 extern const struct ao_lisp_type ao_lisp_atom_type;
 
 /* atom */
 extern const struct ao_lisp_type ao_lisp_atom_type;
 

-extern struct ao_lisp_atom *ao_lisp_atoms;
-
-extern struct ao_lisp_frame *ao_lisp_frame_current;
+extern struct ao_lisp_atom     *ao_lisp_atoms;
+extern struct ao_lisp_frame    *ao_lisp_frame_global;
+extern struct ao_lisp_frame    *ao_lisp_frame_current;

 
 void
 ao_lisp_atom_print(ao_poly a);
 
 void
 ao_lisp_atom_print(ao_poly a);


@@ -420,6 +484,9 @@ ao_lisp_check_argt(ao_poly name, struct ao_lisp_cons *cons, int argc, int type,
 ao_poly
 ao_lisp_arg(struct ao_lisp_cons *cons, int argc);
 
 ao_poly
 ao_lisp_arg(struct ao_lisp_cons *cons, int argc);
 

+char *
+ao_lisp_args_name(uint8_t args);
+

 /* read */
 ao_poly
 ao_lisp_read(void);
 /* read */
 ao_poly
 ao_lisp_read(void);


@@ -440,9 +507,69 @@ ao_lisp_frame_new(int num);
 struct ao_lisp_frame *
 ao_lisp_frame_add(struct ao_lisp_frame *frame, ao_poly atom, ao_poly val);
 
 struct ao_lisp_frame *
 ao_lisp_frame_add(struct ao_lisp_frame *frame, ao_poly atom, ao_poly val);
 

+void
+ao_lisp_frame_print(ao_poly p);
+
+/* lambda */
+extern const struct ao_lisp_type ao_lisp_lambda_type;
+
+struct ao_lisp_lambda *
+ao_lisp_lambda_new(ao_poly cons);
+
+void
+ao_lisp_lambda_print(ao_poly lambda);
+
+ao_poly
+ao_lisp_lambda(struct ao_lisp_cons *cons);
+
+ao_poly
+ao_lisp_lexpr(struct ao_lisp_cons *cons);
+
+ao_poly
+ao_lisp_nlambda(struct ao_lisp_cons *cons);
+
+ao_poly
+ao_lisp_macro(struct ao_lisp_cons *cons);
+
+ao_poly
+ao_lisp_lambda_eval(struct ao_lisp_lambda *lambda,
+                   struct ao_lisp_cons *cons);
+

 /* error */
 
 /* error */
 

+void
+ao_lisp_stack_print(void);
+

 ao_poly
 ao_lisp_error(int error, char *format, ...);
 
 ao_poly
 ao_lisp_error(int error, char *format, ...);
 

+/* debugging macros */
+
+#if DBG_EVAL
+#define DBG_CODE       1
+int ao_lisp_stack_depth;
+#define DBG_DO(a)      a
+#define DBG_INDENT()   do { int _s; for(_s = 0; _s < ao_lisp_stack_depth; _s++) printf("  "); } while(0)
+#define DBG_IN()       (++ao_lisp_stack_depth)
+#define DBG_OUT()      (--ao_lisp_stack_depth)
+#define DBG_RESET()    (ao_lisp_stack_depth = 0)
+#define DBG(...)       printf(__VA_ARGS__)
+#define DBGI(...)      do { DBG("%4d: ", __LINE__); DBG_INDENT(); DBG(__VA_ARGS__); } while (0)
+#define DBG_CONS(a)    ao_lisp_cons_print(ao_lisp_cons_poly(a))
+#define DBG_POLY(a)    ao_lisp_poly_print(a)
+#define OFFSET(a)      ((a) ? (int) ((uint8_t *) a - ao_lisp_pool) : -1)
+#define DBG_STACK()    ao_lisp_stack_print()
+#else
+#define DBG_DO(a)
+#define DBG_INDENT()
+#define DBG_IN()
+#define DBG_OUT()
+#define DBG(...)
+#define DBGI(...)
+#define DBG_CONS(a)
+#define DBG_POLY(a)
+#define DBG_RESET()
+#define DBG_STACK()
+#endif
+

 #endif /* _AO_LISP_H_ */
 #endif /* _AO_LISP_H_ */

diff --git a/src/lisp/ao_lisp_atom.c b/src/lisp/ao_lisp_atom.c
index 41ba97f5d7f5b674948d9da00324cdb0d97f5f10..d7cb19960c46b4482cf1fa0cd7e2cef1fa416edb 100644 (file)
--- a/src/lisp/ao_lisp_atom.c
+++ b/src/lisp/ao_lisp_atom.c
@@ -89,8 +89,8 @@ ao_lisp_atom_intern(char *name)
        return atom;
 }
 
        return atom;
 }
 

-static struct ao_lisp_frame    *ao_lisp_frame_global;
-struct ao_lisp_frame           *ao_lisp_frame_current;
+struct ao_lisp_frame   *ao_lisp_frame_global;
+struct ao_lisp_frame   *ao_lisp_frame_current;

 
 static void
 ao_lisp_atom_init(void)
 
 static void
 ao_lisp_atom_init(void)

diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c
index 49b6c37dd47bf0ca837df2b93994053bea617695..c38ba1652c2877eee2ef74a241d901e8d21c68a6 100644 (file)
--- a/src/lisp/ao_lisp_builtin.c
+++ b/src/lisp/ao_lisp_builtin.c
@@ -39,11 +39,71 @@ const struct ao_lisp_type ao_lisp_builtin_type = {
        .move = builtin_move
 };
 
        .move = builtin_move
 };
 

+#ifdef AO_LISP_MAKE_CONST
+char *ao_lisp_builtin_name(enum ao_lisp_builtin_id b) {
+       return "???";
+}
+char *ao_lisp_args_name(uint8_t args) {
+       return "???";
+}
+#else
+static const ao_poly builtin_names[] = {
+       [builtin_lambda] = _ao_lisp_atom_lambda,
+       [builtin_lexpr] = _ao_lisp_atom_lexpr,
+       [builtin_nlambda] = _ao_lisp_atom_nlambda,
+       [builtin_macro] = _ao_lisp_atom_macro,
+       [builtin_car] = _ao_lisp_atom_car,
+       [builtin_cdr] = _ao_lisp_atom_cdr,
+       [builtin_cons] = _ao_lisp_atom_cons,
+       [builtin_last] = _ao_lisp_atom_last,
+       [builtin_quote] = _ao_lisp_atom_quote,
+       [builtin_set] = _ao_lisp_atom_set,
+       [builtin_setq] = _ao_lisp_atom_setq,
+       [builtin_cond] = _ao_lisp_atom_cond,
+       [builtin_print] = _ao_lisp_atom_print,
+       [builtin_patom] = _ao_lisp_atom_patom,
+       [builtin_plus] = _ao_lisp_atom_2b,
+       [builtin_minus] = _ao_lisp_atom_2d,
+       [builtin_times] = _ao_lisp_atom_2a,
+       [builtin_divide] = _ao_lisp_atom_2f,
+       [builtin_mod] = _ao_lisp_atom_25,
+       [builtin_equal] = _ao_lisp_atom_3d,
+       [builtin_less] = _ao_lisp_atom_3c,
+       [builtin_greater] = _ao_lisp_atom_3e,
+       [builtin_less_equal] = _ao_lisp_atom_3c3d,
+       [builtin_greater_equal] = _ao_lisp_atom_3e3d,
+};
+
+static char *
+ao_lisp_builtin_name(enum ao_lisp_builtin_id b) {
+       if (0 <= b && b < _builtin_last)
+               return ao_lisp_poly_atom(builtin_names[b])->name;
+       return "???";
+}
+
+static const ao_poly ao_lisp_args_atoms[] = {
+       [AO_LISP_FUNC_LAMBDA] = _ao_lisp_atom_lambda,
+       [AO_LISP_FUNC_LEXPR] = _ao_lisp_atom_lexpr,
+       [AO_LISP_FUNC_NLAMBDA] = _ao_lisp_atom_nlambda,
+       [AO_LISP_FUNC_MACRO] = _ao_lisp_atom_macro,
+};
+
+char *
+ao_lisp_args_name(uint8_t args)
+{
+       if (args < sizeof ao_lisp_args_atoms / sizeof ao_lisp_args_atoms[0])
+               return ao_lisp_poly_atom(ao_lisp_args_atoms[args])->name;
+       return "(unknown)";
+}
+#endif
+

 void
 ao_lisp_builtin_print(ao_poly b)
 {
 void
 ao_lisp_builtin_print(ao_poly b)
 {

-       (void) b;
-       printf("[builtin]");
+       struct ao_lisp_builtin *builtin = ao_lisp_poly_builtin(b);
+       printf("[builtin %s %s]",
+              ao_lisp_args_name(builtin->args),
+              ao_lisp_builtin_name(builtin->func));

 }
 
 ao_poly
 }
 
 ao_poly


@@ -116,6 +176,24 @@ ao_lisp_cons(struct ao_lisp_cons *cons)
        return ao_lisp_cons_poly(ao_lisp_cons_cons(car, ao_lisp_poly_cons(cdr)));
 }
 
        return ao_lisp_cons_poly(ao_lisp_cons_cons(car, ao_lisp_poly_cons(cdr)));
 }
 

+ao_poly
+ao_lisp_last(struct ao_lisp_cons *cons)
+{
+       ao_poly l;
+       if (!ao_lisp_check_argc(_ao_lisp_atom_last, cons, 1, 1))
+               return AO_LISP_NIL;
+       if (!ao_lisp_check_argt(_ao_lisp_atom_last, cons, 0, AO_LISP_CONS, 1))
+               return AO_LISP_NIL;
+       l = ao_lisp_arg(cons, 0);
+       while (l) {
+               struct ao_lisp_cons *list = ao_lisp_poly_cons(l);
+               if (!list->cdr)
+                       return list->car;
+               l = list->cdr;
+       }
+       return AO_LISP_NIL;
+}
+

 ao_poly
 ao_lisp_quote(struct ao_lisp_cons *cons)
 {
 ao_poly
 ao_lisp_quote(struct ao_lisp_cons *cons)
 {


@@ -151,15 +229,6 @@ ao_lisp_setq(struct ao_lisp_cons *cons)
 ao_poly
 ao_lisp_cond(struct ao_lisp_cons *cons)
 {
 ao_poly
 ao_lisp_cond(struct ao_lisp_cons *cons)
 {

-       int                     argc;
-       struct ao_lisp_cons     *arg;
-
-       argc = 0;
-       for (arg = cons, argc = 0; arg; arg = ao_lisp_poly_cons(arg->cdr), argc++) {
-               if (ao_lisp_poly_type(arg->car) != AO_LISP_CONS)
-                       return ao_lisp_error(AO_LISP_INVALID, "%s: invalid type for arg %d",
-                                            ao_lisp_poly_atom(_ao_lisp_atom_cond)->name, argc);
-       }

        ao_lisp_set_cond(cons);
        return AO_LISP_NIL;
 }
        ao_lisp_set_cond(cons);
        return AO_LISP_NIL;
 }


@@ -380,9 +449,14 @@ ao_lisp_greater_equal(struct ao_lisp_cons *cons)
 }
 
 ao_lisp_func_t ao_lisp_builtins[] = {
 }
 
 ao_lisp_func_t ao_lisp_builtins[] = {

+       [builtin_lambda] = ao_lisp_lambda,
+       [builtin_lexpr] = ao_lisp_lexpr,
+       [builtin_nlambda] = ao_lisp_nlambda,
+       [builtin_macro] = ao_lisp_macro,

        [builtin_car] = ao_lisp_car,
        [builtin_cdr] = ao_lisp_cdr,
        [builtin_cons] = ao_lisp_cons,
        [builtin_car] = ao_lisp_car,
        [builtin_cdr] = ao_lisp_cdr,
        [builtin_cons] = ao_lisp_cons,

+       [builtin_last] = ao_lisp_last,

        [builtin_quote] = ao_lisp_quote,
        [builtin_set] = ao_lisp_set,
        [builtin_setq] = ao_lisp_setq,
        [builtin_quote] = ao_lisp_quote,
        [builtin_set] = ao_lisp_set,
        [builtin_setq] = ao_lisp_setq,

diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp
index 5ca89bd4085ed2a68c8ea7dc4a06c5c789244d62..621fefc4f9ecfe3c9798210398a5edcbc6f40b40 100644 (file)
--- a/src/lisp/ao_lisp_const.lisp
+++ b/src/lisp/ao_lisp_const.lisp
@@ -1,7 +1,129 @@
-cadr (lambda (l) (car (cdr l)))
-caddr (lambda (l) (car (cdr (cdr l))))
-list (lexpr (l) l)
-1+ (lambda (x) (+ x 1))
-1- (lambda (x) (- x 1))
-last (lambda (x) (cond ((cdr x) (last (cdr x))) ((car x))))
-prog* (lexpr (l) (last l))
+                                       ; basic list accessors
+
+
+(setq cadr (lambda (l) (car (cdr l))))
+(setq caddr (lambda (l) (car (cdr (cdr l)))))
+(setq list (lexpr (l) l))
+
+                                       ; evaluate a list of sexprs
+
+(setq progn (lexpr (l) (last l)))
+
+                                       ; simple math operators
+
+(setq 1+ (lambda (x) (+ x 1)))
+(setq 1- (lambda (x) (- x 1)))
+
+                                       ; define a variable without returning the value
+
+(set 'def (macro (def-param)
+                (list
+                 'progn
+                 (list
+                  'set
+                  (list
+                   'quote
+                   (car def-param))
+                  (cadr def-param)
+                  )
+                 (list
+                  'quote
+                  (car def-param)
+                  )
+                 )
+                )
+     )
+
+                                       ; define a set of local
+                                       ; variables and then evaluate
+                                       ; a list of sexprs
+                                       ;
+                                       ; (let (var-defines) sexprs)
+                                       ;
+                                       ; where var-defines are either
+                                       ;
+                                       ; (name value)
+                                       ;
+                                       ; or
+                                       ;
+                                       ; (name)
+                                       ;
+                                       ; e.g.
+                                       ;
+                                       ; (let ((x 1) (y)) (setq y (+ x 1)) y)
+
+(def let (macro (let-param)
+               ((lambda (vars exprs make-names make-exprs make-nils)
+                  (progn
+
+                                       ;
+                                       ; make the list of names in the let
+                                       ;
+
+                    (set 'make-names (lambda (vars)
+                                      (cond (vars
+                                             (cons (car (car vars))
+                                                   (make-names (cdr vars))))
+                                            )
+                                      )
+                         )
+                                       ;
+                                       ; the set of expressions is
+                                       ; the list of set expressions
+                                       ; pre-pended to the
+                                       ; expressions to evaluate
+                                       ;
+                    (set 'make-exprs (lambda (vars exprs)
+                                      (progn
+                                        (cond (vars (cons
+                                                     (list set
+                                                           (list quote
+                                                                 (car (car vars))
+                                                                 )
+                                                           (cadr (car vars))
+                                                           )
+                                                     (make-exprs (cdr vars) exprs)
+                                                     )
+                                                    )
+                                              (exprs)
+                                              )
+                                        )
+                                      )
+                         )
+                    (set 'exprs (make-exprs vars exprs))
+
+                                       ;
+                                       ; the parameters to the lambda is a list
+                                       ; of nils of the right length
+                                       ;
+                    (set 'make-nils (lambda (vars)
+                                     (cond (vars (cons nil (make-nils (cdr vars))))
+                                           )
+                                     )
+                         )
+                                       ;
+                                       ; build the lambda.
+                                       ;
+                    (set 'last-let-value 
+                    (cons
+                     (list
+                      'lambda
+                      (make-names vars)
+                      (cond ((cdr exprs) (cons 'progn exprs))
+                            ((car exprs))
+                            )
+                      )
+                     (make-nils vars)
+                     )
+                    )
+                    )
+                    
+                  )
+                (car let-param)
+                (cdr let-param)
+                ()
+                ()
+                ()
+                )
+               )
+     )

diff --git a/src/lisp/ao_lisp_error.c b/src/lisp/ao_lisp_error.c
index ea8111d9434ec434f6b146eadc202ba3591aa62a..cedc107cd8d12e9b172cac677345d813ccef7289 100644 (file)
--- a/src/lisp/ao_lisp_error.c
+++ b/src/lisp/ao_lisp_error.c
@@ -15,6 +15,86 @@
 #include "ao_lisp.h"
 #include <stdarg.h>
 
 #include "ao_lisp.h"
 #include <stdarg.h>
 

+static void
+ao_lisp_error_cons(char *name, struct ao_lisp_cons *cons)
+{
+       int first = 1;
+       printf("\t\t%s(", name);
+       if (cons) {
+               while (cons) {
+                       if (!first)
+                               printf("\t\t         ");
+                       else
+                               first = 0;
+                       ao_lisp_poly_print(cons->car);
+                       printf("\n");
+                       cons = ao_lisp_poly_cons(cons->cdr);
+               }
+               printf("\t\t         )\n");
+       } else
+               printf(")\n");
+}
+
+static void tabs(int indent)
+{
+       while (indent--)
+               printf("\t");
+}
+
+static void
+ao_lisp_error_frame(int indent, char *name, struct ao_lisp_frame *frame)
+{
+       int                     f;
+
+       tabs(indent);
+       printf ("%s{", name);
+       if (frame) {
+               for (f = 0; f < frame->num; f++) {
+                       if (f != 0) {
+                               tabs(indent);
+                               printf("         ");
+                       }
+                       ao_lisp_poly_print(frame->vals[f].atom);
+                       printf(" = ");
+                       ao_lisp_poly_print(frame->vals[f].val);
+                       printf("\n");
+               }
+               if (frame->next)
+                       ao_lisp_error_frame(indent + 1, "next:   ", ao_lisp_poly_frame(frame->next));
+       }
+       tabs(indent);
+       printf("        }\n");
+}
+
+static const char *state_names[] = {
+       "sexpr",
+       "val",
+       "formal",
+       "exec",
+       "cond",
+       "cond_test",
+};
+
+void
+ao_lisp_stack_print(void)
+{
+       struct ao_lisp_stack *s;
+       printf("Value:  "); ao_lisp_poly_print(ao_lisp_v); printf("\n");
+       ao_lisp_error_frame(0, "Frame:  ", ao_lisp_frame_current);
+       printf("Stack:\n");
+       for (s = ao_lisp_stack; s; s = ao_lisp_poly_stack(s->prev)) {
+               printf("\t[\n");
+               printf("\t\texpr:   "); ao_lisp_poly_print(s->list); printf("\n");
+               printf("\t\tstate:  %s\n", state_names[s->state]);
+               printf("\t\tmacro:  %s\n", s->macro ? "true" : "false");
+               ao_lisp_error_cons ("sexprs: ", ao_lisp_poly_cons(s->sexprs));
+               ao_lisp_error_cons ("values: ", ao_lisp_poly_cons(s->values));
+               ao_lisp_error_frame(2, "frame:  ", ao_lisp_poly_frame(s->frame));
+               ao_lisp_error_frame(2, "mframe: ", ao_lisp_poly_frame(s->macro_frame));
+               printf("\t]\n");
+       }
+}
+

 ao_poly
 ao_lisp_error(int error, char *format, ...)
 {
 ao_poly
 ao_lisp_error(int error, char *format, ...)
 {


@@ -25,5 +105,6 @@ ao_lisp_error(int error, char *format, ...)
        vprintf(format, args);
        va_end(args);
        printf("\n");
        vprintf(format, args);
        va_end(args);
        printf("\n");

+       ao_lisp_stack_print();

        return AO_LISP_NIL;
 }
        return AO_LISP_NIL;
 }

diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index a5c742503f89452271a5dfb2c3124d63659ff212..f41962195ee7bd4227d1ce91e5cbc87138d807ae 100644 (file)
--- a/src/lisp/ao_lisp_eval.c
+++ b/src/lisp/ao_lisp_eval.c
@@ -12,60 +12,9 @@
  * General Public License for more details.
  */
 
  * General Public License for more details.
  */
 

+#define DBG_EVAL 1

 #include "ao_lisp.h"
 #include "ao_lisp.h"

-
-#if 0
-#define DBG_CODE       1
-static int stack_depth;
-#define DBG_INDENT()   do { int _s; for(_s = 0; _s < stack_depth; _s++) printf("  "); } while(0)
-#define DBG_IN()       (++stack_depth)
-#define DBG_OUT()      (--stack_depth)
-#define DBG(...)       printf(__VA_ARGS__)
-#define DBGI(...)      do { DBG_INDENT(); DBG("%4d: ", __LINE__); DBG(__VA_ARGS__); } while (0)
-#define DBG_CONS(a)    ao_lisp_cons_print(ao_lisp_cons_poly(a))
-#define DBG_POLY(a)    ao_lisp_poly_print(a)
-#define OFFSET(a)      ((a) ? (int) ((uint8_t *) a - ao_lisp_pool) : -1)
-#else
-#define DBG_INDENT()
-#define DBG_IN()
-#define DBG_OUT()
-#define DBG(...)
-#define DBGI(...)
-#define DBG_CONS(a)
-#define DBG_POLY(a)
-#endif
-
-enum eval_state {
-       eval_sexpr,
-       eval_val,
-       eval_formal,
-       eval_exec,
-       eval_exec_direct,
-       eval_cond,
-       eval_cond_test
-};
-
-struct ao_lisp_stack {
-       ao_poly                 prev;
-       uint8_t                 state;
-       uint8_t                 macro;
-       ao_poly                 actuals;
-       ao_poly                 formals;
-       ao_poly                 formals_tail;
-       ao_poly                 frame;
-};
-
-static struct ao_lisp_stack *
-ao_lisp_poly_stack(ao_poly p)
-{
-       return ao_lisp_ref(p);
-}
-
-static ao_poly
-ao_lisp_stack_poly(struct ao_lisp_stack *stack)
-{
-       return ao_lisp_poly(stack, AO_LISP_OTHER);
-}
+#include <assert.h>

 
 static int
 stack_size(void *addr)
 
 static int
 stack_size(void *addr)


@@ -79,10 +28,11 @@ stack_mark(void *addr)
 {
        struct ao_lisp_stack    *stack = addr;
        for (;;) {
 {
        struct ao_lisp_stack    *stack = addr;
        for (;;) {

-               ao_lisp_poly_mark(stack->actuals, 0);
-               ao_lisp_poly_mark(stack->formals, 0);
-               /* no need to mark formals_tail */
+               ao_lisp_poly_mark(stack->sexprs, 0);
+               ao_lisp_poly_mark(stack->values, 0);
+               /* no need to mark values_tail */

                ao_lisp_poly_mark(stack->frame, 0);
                ao_lisp_poly_mark(stack->frame, 0);

+               ao_lisp_poly_mark(stack->macro_frame, 0);

                stack = ao_lisp_poly_stack(stack->prev);
                if (ao_lisp_mark_memory(stack, sizeof (struct ao_lisp_stack)))
                        break;
                stack = ao_lisp_poly_stack(stack->prev);
                if (ao_lisp_mark_memory(stack, sizeof (struct ao_lisp_stack)))
                        break;


@@ -91,29 +41,6 @@ stack_mark(void *addr)
 
 static const struct ao_lisp_type ao_lisp_stack_type;
 
 
 static const struct ao_lisp_type ao_lisp_stack_type;
 

-#if DBG_CODE
-static void
-stack_validate_tail(struct ao_lisp_stack *stack)
-{
-       struct ao_lisp_cons *head = ao_lisp_poly_cons(stack->formals);
-       struct ao_lisp_cons *tail = ao_lisp_poly_cons(stack->formals_tail);
-       struct ao_lisp_cons *cons;
-       for (cons = head; cons && cons->cdr && cons != tail; cons = ao_lisp_poly_cons(cons->cdr))
-               ;
-       if (cons != tail || (tail && tail->cdr)) {
-               if (!tail) {
-                       printf("tail null\n");
-               } else {
-                       printf("tail validate fail head %d actual %d recorded %d\n",
-                              OFFSET(head), OFFSET(cons), OFFSET(tail));
-                       abort();
-               }
-       }
-}
-#else
-#define stack_validate_tail(s)
-#endif
-

 static void
 stack_move(void *addr)
 {
 static void
 stack_move(void *addr)
 {


@@ -122,15 +49,15 @@ stack_move(void *addr)
        while (stack) {
                void    *prev;
                int     ret;
        while (stack) {
                void    *prev;
                int     ret;

-               (void) ao_lisp_poly_move(&stack->actuals, 0);
-               (void) ao_lisp_poly_move(&stack->formals, 0);
-               (void) ao_lisp_poly_move(&stack->formals_tail, 0);
+               (void) ao_lisp_poly_move(&stack->sexprs, 0);
+               (void) ao_lisp_poly_move(&stack->values, 0);
+               (void) ao_lisp_poly_move(&stack->values_tail, 0);

                (void) ao_lisp_poly_move(&stack->frame, 0);
                (void) ao_lisp_poly_move(&stack->frame, 0);

+               (void) ao_lisp_poly_move(&stack->macro_frame, 0);

                prev = ao_lisp_poly_stack(stack->prev);
                ret = ao_lisp_move(&ao_lisp_stack_type, &prev);
                if (prev != ao_lisp_poly_stack(stack->prev))
                        stack->prev = ao_lisp_stack_poly(prev);
                prev = ao_lisp_poly_stack(stack->prev);
                ret = ao_lisp_move(&ao_lisp_stack_type, &prev);
                if (prev != ao_lisp_poly_stack(stack->prev))
                        stack->prev = ao_lisp_stack_poly(prev);

-               stack_validate_tail(stack);

                if (ret)
                        break;
                stack = ao_lisp_poly_stack(stack->prev);
                if (ret)
                        break;
                stack = ao_lisp_poly_stack(stack->prev);


@@ -143,199 +70,421 @@ static const struct ao_lisp_type ao_lisp_stack_type = {
        .move = stack_move
 };
 
        .move = stack_move
 };
 

-static struct ao_lisp_stack    *ao_lisp_stack;
-static ao_poly                 ao_lisp_v;
-static uint8_t been_here;
-
-#if DBG_CODE
-static void
-stack_validate_tails(void)
-{
-       struct ao_lisp_stack    *stack;
-
-       for (stack = ao_lisp_stack; stack; stack = ao_lisp_poly_stack(stack->prev))
-               stack_validate_tail(stack);
-}
-#else
-#define stack_validate_tails(s)
-#endif
+struct ao_lisp_stack           *ao_lisp_stack;
+ao_poly                                ao_lisp_v;

 
 ao_poly
 ao_lisp_set_cond(struct ao_lisp_cons *c)
 {
        ao_lisp_stack->state = eval_cond;
 
 ao_poly
 ao_lisp_set_cond(struct ao_lisp_cons *c)
 {
        ao_lisp_stack->state = eval_cond;

-       ao_lisp_stack->actuals = ao_lisp_cons_poly(c);
+       ao_lisp_stack->sexprs = ao_lisp_cons_poly(c);

        return AO_LISP_NIL;
 }
 
        return AO_LISP_NIL;
 }
 

-void
+static void

 ao_lisp_stack_reset(struct ao_lisp_stack *stack)
 {
        stack->state = eval_sexpr;
        stack->macro = 0;
 ao_lisp_stack_reset(struct ao_lisp_stack *stack)
 {
        stack->state = eval_sexpr;
        stack->macro = 0;

-       stack->actuals = AO_LISP_NIL;
-       stack->formals = AO_LISP_NIL;
-       stack->formals_tail = AO_LISP_NIL;
-       stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
-       stack_validate_tails();
+       stack->sexprs = AO_LISP_NIL;
+       stack->values = AO_LISP_NIL;
+       stack->values_tail = AO_LISP_NIL;

 }
 
 }
 

-int
-ao_lisp_stack_push(void)
+static void
+ao_lisp_frames_dump(void)

 {
 {

-       stack_validate_tails();
-       if (ao_lisp_stack) {
-               DBGI("formals "); DBG_POLY(ao_lisp_stack->formals); DBG("\n");
-               DBGI("actuals "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n");
+       struct ao_lisp_stack *s;
+       DBGI(".. current frame: "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
+       for (s = ao_lisp_stack; s; s = ao_lisp_poly_stack(s->prev)) {
+               DBGI(".. stack frame: "); DBG_POLY(s->frame); DBG("\n");
+               DBGI(".. macro frame: "); DBG_POLY(s->frame); DBG("\n");

        }
        }

+}
+
+static int
+ao_lisp_stack_push(void)
+{

        DBGI("stack push\n");
        DBG_IN();
        struct ao_lisp_stack    *stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
        if (!stack)
                return 0;
        stack->prev = ao_lisp_stack_poly(ao_lisp_stack);
        DBGI("stack push\n");
        DBG_IN();
        struct ao_lisp_stack    *stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
        if (!stack)
                return 0;
        stack->prev = ao_lisp_stack_poly(ao_lisp_stack);

+       stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
+       stack->list = AO_LISP_NIL;

        ao_lisp_stack = stack;
        ao_lisp_stack_reset(stack);
        ao_lisp_stack = stack;
        ao_lisp_stack_reset(stack);

-       stack_validate_tails();
+       ao_lisp_frames_dump();

        return 1;
 }
 
        return 1;
 }
 

-void
+static void

 ao_lisp_stack_pop(void)
 {
        if (!ao_lisp_stack)
                return;
 ao_lisp_stack_pop(void)
 {
        if (!ao_lisp_stack)
                return;

-       stack_validate_tails();
+       ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);
+       ao_lisp_stack = ao_lisp_poly_stack(ao_lisp_stack->prev);

        DBG_OUT();
        DBGI("stack pop\n");
        DBG_OUT();
        DBGI("stack pop\n");

-       ao_lisp_stack = ao_lisp_poly_stack(ao_lisp_stack->prev);
-       if (ao_lisp_stack)
-               ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);
-       else
-               ao_lisp_frame_current = NULL;
-       if (ao_lisp_stack) {
-               DBGI("formals "); DBG_POLY(ao_lisp_stack->formals); DBG("\n");
-               DBGI("actuals "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n");
-       }
+       ao_lisp_frames_dump();

 }
 
 static void
 ao_lisp_stack_clear(void)
 {
 }
 
 static void
 ao_lisp_stack_clear(void)
 {

-       stack_validate_tails();

        ao_lisp_stack = NULL;
        ao_lisp_frame_current = NULL;
        ao_lisp_stack = NULL;
        ao_lisp_frame_current = NULL;

+       ao_lisp_v = AO_LISP_NIL;

 }
 
 }
 

-static ao_poly
+static int

 func_type(ao_poly func)
 {
 func_type(ao_poly func)
 {

-       struct ao_lisp_cons     *cons;
-       struct ao_lisp_cons     *args;
-       int                     f;
-
-       DBGI("func type "); DBG_POLY(func); DBG("\n");

        if (func == AO_LISP_NIL)
                return ao_lisp_error(AO_LISP_INVALID, "func is nil");
        if (func == AO_LISP_NIL)
                return ao_lisp_error(AO_LISP_INVALID, "func is nil");

-       if (ao_lisp_poly_type(func) == AO_LISP_BUILTIN) {
-               struct ao_lisp_builtin *b = ao_lisp_poly_builtin(func);
-               return b->args;
-       } else if (ao_lisp_poly_type(func) == AO_LISP_CONS) {
-               cons = ao_lisp_poly_cons(func);
-               if (!ao_lisp_check_argc(_ao_lisp_atom_lambda, cons, 3, 3))
-                       return AO_LISP_NIL;
-               if (!ao_lisp_check_argt(_ao_lisp_atom_lambda, cons, 0, AO_LISP_ATOM, 0))
-                       return AO_LISP_NIL;
-               if (!ao_lisp_check_argt(_ao_lisp_atom_lambda, cons, 1, AO_LISP_CONS, 1))
-                       return AO_LISP_NIL;
-               args = ao_lisp_poly_cons(ao_lisp_arg(cons, 1));
-               f = 0;
-               while (args) {
-                       if (ao_lisp_poly_type(args->car) != AO_LISP_ATOM) {
-                               return ao_lisp_error(ao_lisp_arg(cons, 0), "formal %d is not an atom", f);
-                       }
-                       args = ao_lisp_poly_cons(args->cdr);
-                       f++;
-               }
-               return ao_lisp_arg(cons, 0);
-       } else {
+       switch (ao_lisp_poly_type(func)) {
+       case AO_LISP_BUILTIN:
+               return ao_lisp_poly_builtin(func)->args;
+       case AO_LISP_LAMBDA:
+               return ao_lisp_poly_lambda(func)->args;
+       default:

                ao_lisp_error(AO_LISP_INVALID, "not a func");
                ao_lisp_error(AO_LISP_INVALID, "not a func");

-               abort();
-               return AO_LISP_NIL;
+               return -1;

        }
 }
 
        }
 }
 

+/*
+ * Flattened eval to avoid stack issues
+ */
+
+/*
+ * Evaluate an s-expression
+ *
+ * For a list, evaluate all of the elements and
+ * then execute the resulting function call.
+ *
+ * Each element of the list is evaluated in
+ * a clean stack context.
+ *
+ * The current stack state is set to 'formal' so that
+ * when the evaluation is complete, the value
+ * will get appended to the values list.
+ *
+ * For other types, compute the value directly.
+ */
+

 static int
 static int

-ao_lisp_cons_length(struct ao_lisp_cons *cons)
+ao_lisp_eval_sexpr(void)

 {
 {

-       int     len = 0;
-       while (cons) {
-               len++;
-               cons = ao_lisp_poly_cons(cons->cdr);
+       DBGI("sexpr: "); DBG_POLY(ao_lisp_v); DBG("\n");
+       switch (ao_lisp_poly_type(ao_lisp_v)) {
+       case AO_LISP_CONS:
+               if (ao_lisp_v == AO_LISP_NIL) {
+                       if (!ao_lisp_stack->values) {
+                               /*
+                                * empty list evaluates to empty list
+                                */
+                               ao_lisp_v = AO_LISP_NIL;
+                               ao_lisp_stack->state = eval_val;
+                       } else {
+                               /*
+                                * done with arguments, go execute it
+                                */
+                               ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->values)->car;
+                               ao_lisp_stack->state = eval_exec;
+                       }
+               } else {
+                       if (!ao_lisp_stack->values)
+                               ao_lisp_stack->list = ao_lisp_v;
+                       /*
+                        * Evaluate another argument and then switch
+                        * to 'formal' to add the value to the values
+                        * list
+                        */
+                       ao_lisp_stack->sexprs = ao_lisp_v;
+                       ao_lisp_stack->state = eval_formal;
+                       if (!ao_lisp_stack_push())
+                               return 0;
+                       /*
+                        * push will reset the state to 'sexpr', which
+                        * will evaluate the expression
+                        */
+                       ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
+               }
+               break;
+       case AO_LISP_ATOM:
+               DBGI("..frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
+               ao_lisp_v = ao_lisp_atom_get(ao_lisp_v);
+               /* fall through */
+       case AO_LISP_INT:
+       case AO_LISP_STRING:
+       case AO_LISP_BUILTIN:
+       case AO_LISP_LAMBDA:
+               ao_lisp_stack->state = eval_val;
+               break;

        }
        }

-       return len;
+       DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG("\n");
+       return 1;

 }
 
 }
 

-static ao_poly
-ao_lisp_lambda(struct ao_lisp_cons *cons)
+/*
+ * A value has been computed.
+ *
+ * If the value was computed from a macro,
+ * then we want to reset the current context
+ * to evaluate the macro result again.
+ *
+ * If not a macro, then pop the stack.
+ * If the stack is empty, we're done.
+ * Otherwise, the stack will contain
+ * the next state.
+ */
+
+static int
+ao_lisp_eval_val(void)

 {
 {

-       ao_poly                 type;
-       struct ao_lisp_cons     *lambda;
-       struct ao_lisp_cons     *args;
-       struct ao_lisp_frame    *next_frame;
-       int                     args_wanted;
-       int                     args_provided;
+       DBGI("val: "); DBG_POLY(ao_lisp_v); DBG("\n");
+       if (ao_lisp_stack->macro) {
+               DBGI("..macro %d\n", ao_lisp_stack->macro);
+               DBGI("..current frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
+               DBGI("..saved frame   "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
+               DBGI("..macro frame   "); DBG_POLY(ao_lisp_stack->macro_frame); DBG("\n");
+               DBGI("..sexprs       "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
+               DBGI("..values       "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
+               /*
+                * Re-use the current stack to evaluate
+                * the value from the macro
+                */
+               ao_lisp_stack->state = eval_sexpr;
+//             assert(ao_lisp_stack->frame == ao_lisp_stack->macro_frame);
+               ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->macro_frame);
+               ao_lisp_stack->frame = ao_lisp_stack->macro_frame;
+               ao_lisp_stack->macro = 0;
+               ao_lisp_stack->macro_frame = AO_LISP_NIL;
+               ao_lisp_stack->sexprs = AO_LISP_NIL;
+               ao_lisp_stack->values = AO_LISP_NIL;
+               ao_lisp_stack->values_tail = AO_LISP_NIL;
+       } else {
+               /*
+                * Value computed, pop the stack
+                * to figure out what to do with the value
+                */
+               ao_lisp_stack_pop();
+       }
+       DBGI("..state %d\n", ao_lisp_stack ? ao_lisp_stack->state : -1);
+       return 1;
+}

 
 

-       lambda = ao_lisp_poly_cons(ao_lisp_arg(cons, 0));
-       DBGI("lambda "); DBG_CONS(lambda); DBG("\n");
-       type = ao_lisp_arg(lambda, 0);
-       args = ao_lisp_poly_cons(ao_lisp_arg(lambda, 1));
+/*
+ * A formal has been computed.
+ *
+ * If this is the first formal, then
+ * check to see if we've got a lamda/lexpr or
+ * macro/nlambda.
+ *
+ * For lambda/lexpr, go compute another formal.
+ * This will terminate when the sexpr state
+ * sees nil.
+ *
+ * For macro/nlambda, we're done, so move the
+ * sexprs into the values and go execute it.
+ */

 
 

-       args_wanted = ao_lisp_cons_length(args);
+static int
+ao_lisp_eval_formal(void)
+{
+       ao_poly formal;

 
 

-       /* Create a frame to hold the variables
-        */
-       if (type == _ao_lisp_atom_lambda)
-               args_provided = ao_lisp_cons_length(cons) - 1;
-       else
-               args_provided = 1;
-       if (args_wanted != args_provided)
-               return ao_lisp_error(AO_LISP_INVALID, "need %d args, not %d", args_wanted, args_provided);
-       next_frame = ao_lisp_frame_new(args_wanted);
-//     DBGI("new frame %d\n", OFFSET(next_frame));
-       switch (type) {
-       case _ao_lisp_atom_lambda: {
-               int                     f;
-               struct ao_lisp_cons     *vals = ao_lisp_poly_cons(cons->cdr);
-
-               for (f = 0; f < args_wanted; f++) {
-                       next_frame->vals[f].atom = args->car;
-                       next_frame->vals[f].val = vals->car;
-                       args = ao_lisp_poly_cons(args->cdr);
-                       vals = ao_lisp_poly_cons(vals->cdr);
+       DBGI("formal: "); DBG_POLY(ao_lisp_v); DBG("\n");
+
+       /* Check what kind of function we've got */
+       if (!ao_lisp_stack->values) {
+               switch (func_type(ao_lisp_v)) {
+               case AO_LISP_FUNC_LAMBDA:
+               case AO_LISP_FUNC_LEXPR:
+                       DBGI(".. lambda or lexpr\n");
+                       break;
+               case AO_LISP_FUNC_MACRO:
+                       ao_lisp_stack->macro = 1;
+                       DBGI(".. macro %d\n", ao_lisp_stack->macro);
+                       DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
+                       DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
+                       ao_lisp_stack->macro_frame = ao_lisp_stack->frame;
+                       /* fall through ... */
+               case AO_LISP_FUNC_NLAMBDA:
+                       DBGI(".. nlambda or macro\n");
+                       ao_lisp_stack->values = ao_lisp_stack->sexprs;
+                       ao_lisp_stack->values_tail = AO_LISP_NIL;
+                       ao_lisp_stack->state = eval_exec;
+                       return 1;
+               case -1:
+                       return 0;

                }
                }

-               break;

        }
        }

-       case _ao_lisp_atom_lexpr:
-       case _ao_lisp_atom_nlambda:
-               next_frame->vals[0].atom = args->car;
-               next_frame->vals[0].val = cons->cdr;
+
+       /* Append formal to list of values */
+       formal = ao_lisp_cons_poly(ao_lisp_cons_cons(ao_lisp_v, NULL));
+       if (!formal)
+               return 0;
+
+       if (ao_lisp_stack->values_tail)
+               ao_lisp_poly_cons(ao_lisp_stack->values_tail)->cdr = formal;
+       else
+               ao_lisp_stack->values = formal;
+       ao_lisp_stack->values_tail = formal;
+
+       DBGI(".. values "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
+
+       /*
+        * Step to the next argument, if this is last, then
+        * 'sexpr' will end up switching to 'exec'
+        */
+       ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
+
+       ao_lisp_stack->state = eval_sexpr;
+
+       DBGI(".. "); DBG_POLY(ao_lisp_v); DBG("\n");
+       return 1;
+}
+
+/*
+ * Start executing a function call
+ *
+ * Most builtins are easy, just call the function.
+ * 'cond' is magic; it sticks the list of clauses
+ * in 'sexprs' and switches to 'cond' state. That
+ * bit of magic is done in ao_lisp_set_cond.
+ *
+ * Lambdas build a new frame to hold the locals and
+ * then re-use the current stack context to evaluate
+ * the s-expression from the lambda.
+ */
+
+static int
+ao_lisp_eval_exec(void)
+{
+       ao_poly v;
+       DBGI("exec: "); DBG_POLY(ao_lisp_v); DBG(" values "); DBG_POLY(ao_lisp_stack->values); DBG ("\n");
+       ao_lisp_stack->sexprs = AO_LISP_NIL;
+       switch (ao_lisp_poly_type(ao_lisp_v)) {
+       case AO_LISP_BUILTIN:
+               ao_lisp_stack->state = eval_val;
+               v = ao_lisp_func(ao_lisp_poly_builtin(ao_lisp_v)) (
+                       ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->values)->cdr));
+               DBG_DO(if (!ao_lisp_exception && ao_lisp_poly_builtin(ao_lisp_v)->func == builtin_set) {
+                               struct ao_lisp_cons *cons = ao_lisp_poly_cons(ao_lisp_stack->values);
+                               ao_poly atom = ao_lisp_arg(cons, 1);
+                               ao_poly val = ao_lisp_arg(cons, 2);
+                               DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n");
+                       });
+               ao_lisp_v = v;
+               DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG ("\n");
+               DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");

                break;
                break;

-       case _ao_lisp_atom_macro:
-               next_frame->vals[0].atom = args->car;
-               next_frame->vals[0].val = ao_lisp_cons_poly(cons);
+       case AO_LISP_LAMBDA:
+               ao_lisp_stack->state = eval_sexpr;
+               DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
+               ao_lisp_v = ao_lisp_lambda_eval(ao_lisp_poly_lambda(ao_lisp_v),
+                                               ao_lisp_poly_cons(ao_lisp_stack->values));
+               DBGI(".. sexpr "); DBG_POLY(ao_lisp_v); DBG("\n");
+               DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");

                break;
        }
                break;
        }

-       next_frame->next = ao_lisp_frame_poly(ao_lisp_frame_current);
-       ao_lisp_frame_current = next_frame;
-       ao_lisp_stack->frame = ao_lisp_frame_poly(next_frame);
-       return ao_lisp_arg(lambda, 2);
+       ao_lisp_stack->values = AO_LISP_NIL;
+       ao_lisp_stack->values_tail = AO_LISP_NIL;
+       return 1;

 }
 
 }
 

+static int
+ao_lisp_eval_lambda_done(void)
+{
+       DBGI("lambda_done: "); DBG_POLY(ao_lisp_v); DBG("\n");
+       DBG_STACK();
+       return 1;
+}
+
+/*
+ * Start evaluating the next cond clause
+ *
+ * If the list of clauses is empty, then
+ * the result of the cond is nil.
+ *
+ * Otherwise, set the current stack state to 'cond_test' and create a
+ * new stack context to evaluate the test s-expression. Once that's
+ * complete, we'll land in 'cond_test' to finish the clause.
+ */
+static int
+ao_lisp_eval_cond(void)
+{
+       DBGI("cond: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
+       DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
+       DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
+       if (!ao_lisp_stack->sexprs) {
+               ao_lisp_v = AO_LISP_NIL;
+               ao_lisp_stack->state = eval_val;
+       } else {
+               ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car;
+               if (!ao_lisp_v || ao_lisp_poly_type(ao_lisp_v) != AO_LISP_CONS) {
+                       ao_lisp_error(AO_LISP_INVALID, "invalid cond clause");
+                       return 0;
+               }
+               ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
+               ao_lisp_stack->state = eval_cond_test;
+               if (!ao_lisp_stack_push())
+                       return 0;
+               ao_lisp_stack->state = eval_sexpr;
+       }
+       return 1;
+}
+
+/*
+ * Finish a cond clause.
+ *
+ * Check the value from the test expression, if
+ * non-nil, then set up to evaluate the value expression.
+ *
+ * Otherwise, step to the next clause and go back to the 'cond'
+ * state
+ */
+static int
+ao_lisp_eval_cond_test(void)
+{
+       DBGI("cond_test: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
+       DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
+       DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
+       if (ao_lisp_v) {
+               struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car);
+               struct ao_lisp_cons *c = ao_lisp_poly_cons(car->cdr);
+
+               ao_lisp_stack->state = eval_val;
+               if (c) {
+                       ao_lisp_v = c->car;
+                       if (!ao_lisp_stack_push())
+                               return 0;
+               }
+       } else {
+               ao_lisp_stack->sexprs = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
+               DBGI("next cond: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
+               ao_lisp_stack->state = eval_cond;
+       }
+       return 1;
+}
+
+static int (*const evals[])(void) = {
+       [eval_sexpr] = ao_lisp_eval_sexpr,
+       [eval_val] = ao_lisp_eval_val,
+       [eval_formal] = ao_lisp_eval_formal,
+       [eval_exec] = ao_lisp_eval_exec,
+       [eval_cond] = ao_lisp_eval_cond,
+       [eval_cond_test] = ao_lisp_eval_cond_test,
+};
+

 ao_poly
 ao_lisp_eval(ao_poly _v)
 {
 ao_poly
 ao_lisp_eval(ao_poly _v)
 {

-       ao_poly                 formal;
+       static uint8_t been_here;

 
        ao_lisp_v = _v;
        if (!been_here) {
 
        ao_lisp_v = _v;
        if (!been_here) {


@@ -345,165 +494,16 @@ ao_lisp_eval(ao_poly _v)
        }
 
        if (!ao_lisp_stack_push())
        }
 
        if (!ao_lisp_stack_push())

-               goto bail;
-
-       for (;;) {
-               if (ao_lisp_exception)
-                       goto bail;
-               switch (ao_lisp_stack->state) {
-               case eval_sexpr:
-                       DBGI("sexpr: "); DBG_POLY(ao_lisp_v); DBG("\n");
-                       switch (ao_lisp_poly_type(ao_lisp_v)) {
-                       case AO_LISP_CONS:
-                               if (ao_lisp_v == AO_LISP_NIL) {
-                                       ao_lisp_stack->state = eval_exec;
-                                       break;
-                               }
-                               ao_lisp_stack->actuals = ao_lisp_v;
-                               DBGI("actuals now "); DBG_POLY(ao_lisp_v); DBG("\n");
-                               ao_lisp_stack->state = eval_formal;
-                               if (!ao_lisp_stack_push())
-                                       goto bail;
-                               ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
-                               stack_validate_tails();
-                               break;
-                       case AO_LISP_ATOM:
-                               ao_lisp_v = ao_lisp_atom_get(ao_lisp_v);
-                               /* fall through */
-                       case AO_LISP_INT:
-                       case AO_LISP_STRING:
-                       case AO_LISP_BUILTIN:
-                               ao_lisp_stack->state = eval_val;
-                               break;
-                       }
-                       break;
-               case eval_val:
-                       DBGI("val: "); DBG_POLY(ao_lisp_v); DBG("\n");
-                       ao_lisp_stack_pop();
-                       if (!ao_lisp_stack)
-                               return ao_lisp_v;
-                       DBGI("..state %d\n", ao_lisp_stack->state);
-                       break;
-
-               case eval_formal:
-                       /* Check what kind of function we've got */
-                       if (!ao_lisp_stack->formals) {
-                               switch (func_type(ao_lisp_v)) {
-                               case AO_LISP_LAMBDA:
-                               case _ao_lisp_atom_lambda:
-                               case AO_LISP_LEXPR:
-                               case _ao_lisp_atom_lexpr:
-                                       DBGI(".. lambda or lexpr\n");
-                                       break;
-                               case AO_LISP_MACRO:
-                               case _ao_lisp_atom_macro:
-                                       ao_lisp_stack->macro = 1;
-                               case AO_LISP_NLAMBDA:
-                               case _ao_lisp_atom_nlambda:
-                                       DBGI(".. nlambda or macro\n");
-                                       ao_lisp_stack->formals = ao_lisp_stack->actuals;
-                                       ao_lisp_stack->formals_tail = AO_LISP_NIL;
-                                       ao_lisp_stack->state = eval_exec_direct;
-                                       stack_validate_tails();
-                                       break;
-                               }
-                               if (ao_lisp_stack->state == eval_exec_direct)
-                                       break;
-                       }
-
-                       DBGI("add formal "); DBG_POLY(ao_lisp_v); DBG("\n");
-                       stack_validate_tails();
-                       formal = ao_lisp_cons_poly(ao_lisp_cons_cons(ao_lisp_v, NULL));
-                       stack_validate_tails();
-                       if (!formal)
-                               goto bail;
-
-                       if (ao_lisp_stack->formals_tail)
-                               ao_lisp_poly_cons(ao_lisp_stack->formals_tail)->cdr = formal;
-                       else
-                               ao_lisp_stack->formals = formal;
-                       ao_lisp_stack->formals_tail = formal;
-
-                       DBGI("formals now "); DBG_POLY(ao_lisp_stack->formals); DBG("\n");
-
-                       ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->actuals)->cdr;
-
-                       stack_validate_tails();
-                       ao_lisp_stack->state = eval_sexpr;
+               return AO_LISP_NIL;

 
 

-                       break;
-               case eval_exec:
-                       if (!ao_lisp_stack->formals) {
-                               ao_lisp_v = AO_LISP_NIL;
-                               ao_lisp_stack->state = eval_val;
-                               break;
-                       }
-                       ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->formals)->car;
-               case eval_exec_direct:
-                       DBGI("exec: macro %d ", ao_lisp_stack->macro); DBG_POLY(ao_lisp_v); DBG(" formals "); DBG_POLY(ao_lisp_stack->formals); DBG ("\n");
-                       if (ao_lisp_poly_type(ao_lisp_v) == AO_LISP_BUILTIN) {
-                               stack_validate_tails();
-                               struct ao_lisp_builtin  *b = ao_lisp_poly_builtin(ao_lisp_v);
-                               stack_validate_tails();
-                               struct ao_lisp_cons     *f = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->formals)->cdr);
-
-                               DBGI(".. builtin formals "); DBG_CONS(f); DBG("\n");
-                               stack_validate_tails();
-                               if (ao_lisp_stack->macro)
-                                       ao_lisp_stack->state = eval_sexpr;
-                               else
-                                       ao_lisp_stack->state = eval_val;
-                               ao_lisp_stack->macro = 0;
-                               ao_lisp_stack->actuals = ao_lisp_stack->formals = ao_lisp_stack->formals_tail = AO_LISP_NIL;
-                               ao_lisp_v = ao_lisp_func(b) (f);
-                               DBGI("builtin result:"); DBG_POLY(ao_lisp_v); DBG ("\n");
-                               if (ao_lisp_exception)
-                                       goto bail;
-                               break;
-                       } else {
-                               ao_lisp_v = ao_lisp_lambda(ao_lisp_poly_cons(ao_lisp_stack->formals));
-                               ao_lisp_stack_reset(ao_lisp_stack);
-                       }
-                       break;
-               case eval_cond:
-                       DBGI("cond: "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n");
-                       if (!ao_lisp_stack->actuals) {
-                               ao_lisp_v = AO_LISP_NIL;
-                               ao_lisp_stack->state = eval_val;
-                       } else {
-                               ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->actuals)->car;
-                               if (!ao_lisp_v || ao_lisp_poly_type(ao_lisp_v) != AO_LISP_CONS) {
-                                       ao_lisp_error(AO_LISP_INVALID, "invalid cond clause");
-                                       goto bail;
-                               }
-                               ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
-                               ao_lisp_stack->state = eval_cond_test;
-                               stack_validate_tails();
-                               ao_lisp_stack_push();
-                               stack_validate_tails();
-                               ao_lisp_stack->state = eval_sexpr;
-                       }
-                       break;
-               case eval_cond_test:
-                       DBGI("cond_test: "); DBG_POLY(ao_lisp_v); DBG(" actuals "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n");
-                       if (ao_lisp_v) {
-                               struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->actuals)->car);
-                               struct ao_lisp_cons *c = ao_lisp_poly_cons(car->cdr);
-                               if (c) {
-                                       ao_lisp_v = c->car;
-                                       ao_lisp_stack->state = eval_sexpr;
-                               } else {
-                                       ao_lisp_stack->state = eval_val;
-                               }
-                       } else {
-                               ao_lisp_stack->actuals = ao_lisp_poly_cons(ao_lisp_stack->actuals)->cdr;
-                               DBGI("actuals now "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n");
-                               ao_lisp_stack->state = eval_cond;
-                       }
-                       break;
+       while (ao_lisp_stack) {
+//             DBG_STACK();
+               if (!(*evals[ao_lisp_stack->state])() || ao_lisp_exception) {
+                       ao_lisp_stack_clear();
+                       return AO_LISP_NIL;

                }
        }
                }
        }

-bail:
-       ao_lisp_stack_clear();
-       return AO_LISP_NIL;
+       DBG_DO(if (ao_lisp_frame_current) {DBGI("frame left as "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");});
+       ao_lisp_frame_current = NULL;
+       return ao_lisp_v;

 }
 }

diff --git a/src/lisp/ao_lisp_frame.c b/src/lisp/ao_lisp_frame.c
index 8791c4de8804780a03a5c1e744480e4b198e1244..7978f20add18c2ade7961730568eef539068991d 100644 (file)
--- a/src/lisp/ao_lisp_frame.c
+++ b/src/lisp/ao_lisp_frame.c
@@ -100,6 +100,27 @@ const struct ao_lisp_type ao_lisp_frame_type = {
        .move = frame_move
 };
 
        .move = frame_move
 };
 

+void
+ao_lisp_frame_print(ao_poly p)
+{
+       struct ao_lisp_frame    *frame = ao_lisp_poly_frame(p);
+       int                     f;
+
+       printf ("{");
+       if (frame) {
+               for (f = 0; f < frame->num; f++) {
+                       if (f != 0)
+                               printf(", ");
+                       ao_lisp_poly_print(frame->vals[f].atom);
+                       printf(" = ");
+                       ao_lisp_poly_print(frame->vals[f].val);
+               }
+               if (frame->next)
+                       ao_lisp_poly_print(frame->next);
+       }
+       printf("}");
+}
+

 ao_poly *
 ao_lisp_frame_ref(struct ao_lisp_frame *frame, ao_poly atom)
 {
 ao_poly *
 ao_lisp_frame_ref(struct ao_lisp_frame *frame, ao_poly atom)
 {

diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c
index f2e3cea162f23baa84c5c10c9502d442b641d97a..501052b91b991a0c4533e86f4c39f9cd1d6f3e4e 100644 (file)
--- a/src/lisp/ao_lisp_make_const.c
+++ b/src/lisp/ao_lisp_make_const.c
@@ -33,34 +33,32 @@ struct builtin_func {
 };
 
 struct builtin_func funcs[] = {
 };
 
 struct builtin_func funcs[] = {

-       "car",          AO_LISP_LEXPR,  builtin_car,
-       "cdr",          AO_LISP_LEXPR,  builtin_cdr,
-       "cons",         AO_LISP_LEXPR,  builtin_cons,
-       "quote",        AO_LISP_NLAMBDA,builtin_quote,
-       "set",          AO_LISP_LEXPR,  builtin_set,
-       "setq",         AO_LISP_MACRO,  builtin_setq,
-       "cond",         AO_LISP_NLAMBDA,builtin_cond,
-       "print",        AO_LISP_LEXPR,  builtin_print,
-       "patom",        AO_LISP_LEXPR,  builtin_patom,
-       "+",            AO_LISP_LEXPR,  builtin_plus,
-       "-",            AO_LISP_LEXPR,  builtin_minus,
-       "*",            AO_LISP_LEXPR,  builtin_times,
-       "/",            AO_LISP_LEXPR,  builtin_divide,
-       "%",            AO_LISP_LEXPR,  builtin_mod,
-       "=",            AO_LISP_LEXPR,  builtin_equal,
-       "<",            AO_LISP_LEXPR,  builtin_less,
-       ">",            AO_LISP_LEXPR,  builtin_greater,
-       "<=",           AO_LISP_LEXPR,  builtin_less_equal,
-       ">=",           AO_LISP_LEXPR,  builtin_greater_equal,
+       "lambda",       AO_LISP_FUNC_NLAMBDA,   builtin_lambda,
+       "lexpr",        AO_LISP_FUNC_NLAMBDA,   builtin_lexpr,
+       "nlambda",      AO_LISP_FUNC_NLAMBDA,   builtin_nlambda,
+       "macro",        AO_LISP_FUNC_NLAMBDA,   builtin_macro,
+       "car",          AO_LISP_FUNC_LAMBDA,    builtin_car,
+       "cdr",          AO_LISP_FUNC_LAMBDA,    builtin_cdr,
+       "cons",         AO_LISP_FUNC_LAMBDA,    builtin_cons,
+       "last",         AO_LISP_FUNC_LAMBDA,    builtin_last,
+       "quote",        AO_LISP_FUNC_NLAMBDA,   builtin_quote,
+       "set",          AO_LISP_FUNC_LAMBDA,    builtin_set,
+       "setq",         AO_LISP_FUNC_MACRO,     builtin_setq,
+       "cond",         AO_LISP_FUNC_NLAMBDA,   builtin_cond,
+       "print",        AO_LISP_FUNC_LEXPR,     builtin_print,
+       "patom",        AO_LISP_FUNC_LEXPR,     builtin_patom,
+       "+",            AO_LISP_FUNC_LEXPR,     builtin_plus,
+       "-",            AO_LISP_FUNC_LEXPR,     builtin_minus,
+       "*",            AO_LISP_FUNC_LEXPR,     builtin_times,
+       "/",            AO_LISP_FUNC_LEXPR,     builtin_divide,
+       "%",            AO_LISP_FUNC_LEXPR,     builtin_mod,
+       "=",            AO_LISP_FUNC_LEXPR,     builtin_equal,
+       "<",            AO_LISP_FUNC_LEXPR,     builtin_less,
+       ">",            AO_LISP_FUNC_LEXPR,     builtin_greater,
+       "<=",           AO_LISP_FUNC_LEXPR,     builtin_less_equal,
+       ">=",           AO_LISP_FUNC_LEXPR,     builtin_greater_equal,

 };
 
 };
 

-ao_poly
-ao_lisp_set_cond(struct ao_lisp_cons *c)
-{
-       (void) c;
-       return AO_LISP_NIL;
-}
-

 #define N_FUNC (sizeof funcs / sizeof funcs[0])
 
 /* Syntactic atoms */
 #define N_FUNC (sizeof funcs / sizeof funcs[0])
 
 /* Syntactic atoms */


@@ -90,19 +88,18 @@ int
 main(int argc, char **argv)
 {
        int     f, o, i;
 main(int argc, char **argv)
 {
        int     f, o, i;

-       ao_poly atom, val;
+       ao_poly sexpr, val;

        struct ao_lisp_atom     *a;
        struct ao_lisp_builtin  *b;
        int     in_atom;
 
        printf("/*\n");
        printf(" * Generated file, do not edit\n");
        struct ao_lisp_atom     *a;
        struct ao_lisp_builtin  *b;
        int     in_atom;
 
        printf("/*\n");
        printf(" * Generated file, do not edit\n");

-       ao_lisp_root_add(&ao_lisp_frame_type, &globals);
-       globals = ao_lisp_frame_new(0);

        for (f = 0; f < N_FUNC; f++) {
                b = ao_lisp_make_builtin(funcs[f].func, funcs[f].args);
                a = ao_lisp_atom_intern(funcs[f].name);
        for (f = 0; f < N_FUNC; f++) {
                b = ao_lisp_make_builtin(funcs[f].func, funcs[f].args);
                a = ao_lisp_atom_intern(funcs[f].name);

-               globals = ao_lisp_frame_add(globals, ao_lisp_atom_poly(a), ao_lisp_builtin_poly(b));
+               ao_lisp_atom_set(ao_lisp_atom_poly(a),
+                                ao_lisp_builtin_poly(b));

        }
 
        /* atoms for syntax */
        }
 
        /* atoms for syntax */


@@ -110,23 +107,25 @@ main(int argc, char **argv)
                (void) ao_lisp_atom_intern(atoms[i]);
 
        /* boolean constants */
                (void) ao_lisp_atom_intern(atoms[i]);
 
        /* boolean constants */

-       a = ao_lisp_atom_intern("nil");
-       globals = ao_lisp_frame_add(globals, ao_lisp_atom_poly(a), AO_LISP_NIL);
+       ao_lisp_atom_set(ao_lisp_atom_poly(ao_lisp_atom_intern("nil")),
+                        AO_LISP_NIL);

        a = ao_lisp_atom_intern("t");
        a = ao_lisp_atom_intern("t");

-       globals = ao_lisp_frame_add(globals, ao_lisp_atom_poly(a), ao_lisp_atom_poly(a));
+       ao_lisp_atom_set(ao_lisp_atom_poly(a),
+                        ao_lisp_atom_poly(a));

 
        for (;;) {
 
        for (;;) {

-               atom = ao_lisp_read();
-               if (!atom)
+               sexpr = ao_lisp_read();
+               if (!sexpr)

                        break;
                        break;

-               val = ao_lisp_read();
-               if (!val)
-                       break;
-               if (ao_lisp_poly_type(atom) != AO_LISP_ATOM) {
-                       fprintf(stderr, "input must be atom val pairs\n");
+               printf ("sexpr: ");
+               ao_lisp_poly_print(sexpr);
+               printf("\n");
+               val = ao_lisp_eval(sexpr);
+               if (ao_lisp_exception)

                        exit(1);
                        exit(1);

-               }
-               globals = ao_lisp_frame_add(globals, atom, val);
+               printf("\t");
+               ao_lisp_poly_print(val);
+               printf("\n");

        }
 
        /* Reduce to referenced values */
        }
 
        /* Reduce to referenced values */


@@ -136,7 +135,7 @@ main(int argc, char **argv)
        printf("#define AO_LISP_POOL_CONST %d\n", ao_lisp_top);
        printf("extern const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));\n");
        printf("#define ao_builtin_atoms 0x%04x\n", ao_lisp_atom_poly(ao_lisp_atoms));
        printf("#define AO_LISP_POOL_CONST %d\n", ao_lisp_top);
        printf("extern const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));\n");
        printf("#define ao_builtin_atoms 0x%04x\n", ao_lisp_atom_poly(ao_lisp_atoms));

-       printf("#define ao_builtin_frame 0x%04x\n", ao_lisp_frame_poly(globals));
+       printf("#define ao_builtin_frame 0x%04x\n", ao_lisp_frame_poly(ao_lisp_frame_global));

 
        for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next)) {
                char    *n = a->name, c;
 
        for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next)) {
                char    *n = a->name, c;

diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index c11ec25d96df982afa581549b5edc28d963b72b4..476843d89ee1a4b04d9aa541f1cdabf451fae17a 100644 (file)
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -262,6 +262,7 @@ static const struct ao_lisp_type const *ao_lisp_types[AO_LISP_NUM_TYPE] = {
        [AO_LISP_ATOM] = &ao_lisp_atom_type,
        [AO_LISP_BUILTIN] = &ao_lisp_builtin_type,
        [AO_LISP_FRAME] = &ao_lisp_frame_type,
        [AO_LISP_ATOM] = &ao_lisp_atom_type,
        [AO_LISP_BUILTIN] = &ao_lisp_builtin_type,
        [AO_LISP_FRAME] = &ao_lisp_frame_type,

+       [AO_LISP_LAMBDA] = &ao_lisp_lambda_type,

 };
 
 
 };
 
 

diff --git a/src/lisp/ao_lisp_prim.c b/src/lisp/ao_lisp_prim.c
index 3c081ee89fbeab3be336fe4f298dc824fb926b9e..bfd75ae3b629a1ad9e235277418f3d528e73d6a1 100644 (file)
--- a/src/lisp/ao_lisp_prim.c
+++ b/src/lisp/ao_lisp_prim.c
@@ -45,7 +45,15 @@ static const struct ao_lisp_funcs ao_lisp_funcs[AO_LISP_NUM_TYPE] = {
        [AO_LISP_BUILTIN] = {
                .print = ao_lisp_builtin_print,
                .patom = ao_lisp_builtin_print,
        [AO_LISP_BUILTIN] = {
                .print = ao_lisp_builtin_print,
                .patom = ao_lisp_builtin_print,

-       }
+       },
+       [AO_LISP_FRAME] = {
+               .print = ao_lisp_frame_print,
+               .patom = ao_lisp_frame_print,
+       },
+       [AO_LISP_LAMBDA] = {
+               .print = ao_lisp_lambda_print,
+               .patom = ao_lisp_lambda_print,
+       },

 };
 
 static const struct ao_lisp_funcs *
 };
 
 static const struct ao_lisp_funcs *

diff --git a/src/test/Makefile b/src/test/Makefile
index 8d617eeaf9c7150e3a55afa6d98a66236861a760..7395e8325db75d437c7519285f60620db403194b 100644 (file)
--- a/src/test/Makefile
+++ b/src/test/Makefile
@@ -94,7 +94,7 @@ ao_quaternion_test: ao_quaternion_test.c ao_quaternion.h
 AO_LISP_OBJS = ao_lisp_test.o ao_lisp_mem.o  ao_lisp_cons.o ao_lisp_string.o \
        ao_lisp_atom.o ao_lisp_int.o ao_lisp_prim.o ao_lisp_eval.o ao_lisp_poly.o \
        ao_lisp_builtin.o ao_lisp_read.o ao_lisp_rep.o ao_lisp_frame.o \
 AO_LISP_OBJS = ao_lisp_test.o ao_lisp_mem.o  ao_lisp_cons.o ao_lisp_string.o \
        ao_lisp_atom.o ao_lisp_int.o ao_lisp_prim.o ao_lisp_eval.o ao_lisp_poly.o \
        ao_lisp_builtin.o ao_lisp_read.o ao_lisp_rep.o ao_lisp_frame.o \

-       ao_lisp_error.o
+       ao_lisp_lambda.o ao_lisp_error.o

 
 ao_lisp_test: $(AO_LISP_OBJS)
        cc $(CFLAGS) -o $@ $(AO_LISP_OBJS)
 
 ao_lisp_test: $(AO_LISP_OBJS)
        cc $(CFLAGS) -o $@ $(AO_LISP_OBJS)