altos/lisp: Add apply
[fw/altos] / src / lisp / ao_lisp.h
index a8e1715a8dc88bd3ca8cc4e79e5823b4b3561efc..a445ddddaadf991012fd2c6387b7b0da1e2d34fe 100644 (file)
 #ifndef _AO_LISP_H_
 #define _AO_LISP_H_
 
+#define DBG_MEM                0
+#define DBG_EVAL       0
+
 #include <stdint.h>
 #include <string.h>
-//#include <stdio.h>
 #include <ao_lisp_os.h>
 
 typedef uint16_t       ao_poly;
@@ -48,40 +50,28 @@ ao_lisp_os_restore(void);
 
 #ifdef AO_LISP_MAKE_CONST
 #define AO_LISP_POOL_CONST     16384
-extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST];
+extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));
 #define ao_lisp_pool ao_lisp_const
 #define AO_LISP_POOL AO_LISP_POOL_CONST
 
 #define _atom(n) ao_lisp_atom_poly(ao_lisp_atom_intern(n))
+#define _bool(v) ao_lisp_bool_poly(ao_lisp_bool_get(v))
+
+#define _ao_lisp_bool_true     _bool(1)
+#define _ao_lisp_bool_false    _bool(0)
 
-#define _ao_lisp_atom_quote    _atom("quote")
-#define _ao_lisp_atom_set      _atom("set")
-#define _ao_lisp_atom_setq     _atom("setq")
-#define _ao_lisp_atom_t        _atom("t")
-#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_length   _atom("length")
-#define _ao_lisp_atom_cond     _atom("cond")
-#define _ao_lisp_atom_lambda   _atom("lambda")
-#define _ao_lisp_atom_led      _atom("led")
-#define _ao_lisp_atom_delay    _atom("delay")
-#define _ao_lisp_atom_pack     _atom("pack")
-#define _ao_lisp_atom_unpack   _atom("unpack")
-#define _ao_lisp_atom_flush    _atom("flush")
-#define _ao_lisp_atom_eval     _atom("eval")
-#define _ao_lisp_atom_read     _atom("read")
 #define _ao_lisp_atom_eof      _atom("eof")
-#define _ao_lisp_atom_save     _atom("save")
-#define _ao_lisp_atom_restore  _atom("restore")
-#define _ao_lisp_atom_call2fcc _atom("call/cc")
+#define _ao_lisp_atom_else     _atom("else")
+
+#define AO_LISP_BUILTIN_ATOMS
+#include "ao_lisp_builtin.h"
+
 #else
 #include "ao_lisp_const.h"
 #ifndef AO_LISP_POOL
 #define AO_LISP_POOL   3072
 #endif
-extern uint8_t         ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA];
+extern uint8_t         ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA] __attribute__((aligned(4)));
 #endif
 
 /* Primitive types */
@@ -101,7 +91,8 @@ extern uint8_t               ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA];
 #define AO_LISP_FRAME          6
 #define AO_LISP_LAMBDA         7
 #define AO_LISP_STACK          8
-#define AO_LISP_NUM_TYPE       9
+#define AO_LISP_BOOL           9
+#define AO_LISP_NUM_TYPE       10
 
 /* Leave two bits for types to use as they please */
 #define AO_LISP_OTHER_TYPE_MASK        0x3f
@@ -125,6 +116,7 @@ ao_lisp_is_const(ao_poly poly) {
 
 #define AO_LISP_IS_CONST(a)    (ao_lisp_const <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_lisp_const + AO_LISP_POOL_CONST)
 #define AO_LISP_IS_POOL(a)     (ao_lisp_pool <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_lisp_pool + AO_LISP_POOL)
+#define AO_LISP_IS_INT(p)      (ao_lisp_poly_base_type(p) == AO_LISP_INT)
 
 void *
 ao_lisp_ref(ao_poly poly);
@@ -163,6 +155,12 @@ struct ao_lisp_frame {
        struct ao_lisp_val      vals[];
 };
 
+struct ao_lisp_bool {
+       uint8_t                 type;
+       uint8_t                 value;
+       uint16_t                pad;
+};
+
 /* Set on type when the frame escapes the lambda */
 #define AO_LISP_FRAME_MARK     0x80
 #define AO_LISP_FRAME_PRINT    0x40
@@ -186,6 +184,7 @@ enum eval_state {
        eval_val,               /* Value computed */
        eval_formal,            /* Formal computed */
        eval_exec,              /* Start a lambda evaluation */
+       eval_apply,             /* Execute apply */
        eval_cond,              /* Start next cond clause */
        eval_cond_test,         /* Check cond condition */
        eval_progn,             /* Start next progn entry */
@@ -249,46 +248,8 @@ struct ao_lisp_builtin {
        uint16_t        func;
 };
 
-enum ao_lisp_builtin_id {
-       builtin_eval,
-       builtin_read,
-       builtin_lambda,
-       builtin_lexpr,
-       builtin_nlambda,
-       builtin_macro,
-       builtin_car,
-       builtin_cdr,
-       builtin_cons,
-       builtin_last,
-       builtin_length,
-       builtin_quote,
-       builtin_set,
-       builtin_setq,
-       builtin_cond,
-       builtin_progn,
-       builtin_while,
-       builtin_print,
-       builtin_patom,
-       builtin_plus,
-       builtin_minus,
-       builtin_times,
-       builtin_divide,
-       builtin_mod,
-       builtin_equal,
-       builtin_less,
-       builtin_greater,
-       builtin_less_equal,
-       builtin_greater_equal,
-       builtin_pack,
-       builtin_unpack,
-       builtin_flush,
-       builtin_delay,
-       builtin_led,
-       builtin_save,
-       builtin_restore,
-       builtin_call_cc,
-       _builtin_last
-};
+#define AO_LISP_BUILTIN_ID
+#include "ao_lisp_builtin.h"
 
 typedef ao_poly (*ao_lisp_func_t)(struct ao_lisp_cons *cons);
 
@@ -326,6 +287,10 @@ ao_lisp_poly_other(ao_poly poly) {
 
 static inline uint8_t
 ao_lisp_other_type(void *other) {
+#if DBG_MEM
+       if ((*((uint8_t *) other) & AO_LISP_OTHER_TYPE_MASK) >= AO_LISP_NUM_TYPE)
+               ao_lisp_abort();
+#endif
        return *((uint8_t *) other) & AO_LISP_OTHER_TYPE_MASK;
 }
 
@@ -420,6 +385,17 @@ ao_lisp_builtin_poly(struct ao_lisp_builtin *b)
        return ao_lisp_poly(b, AO_LISP_OTHER);
 }
 
+static inline ao_poly
+ao_lisp_bool_poly(struct ao_lisp_bool *b)
+{
+       return ao_lisp_poly(b, AO_LISP_OTHER);
+}
+
+static inline struct ao_lisp_bool *
+ao_lisp_poly_bool(ao_poly poly)
+{
+       return ao_lisp_ref(poly);
+}
 /* memory functions */
 
 extern int ao_lisp_collects[2];
@@ -460,29 +436,50 @@ ao_lisp_cons_stash(int id, struct ao_lisp_cons *cons);
 struct ao_lisp_cons *
 ao_lisp_cons_fetch(int id);
 
+void
+ao_lisp_poly_stash(int id, ao_poly poly);
+
+ao_poly
+ao_lisp_poly_fetch(int id);
+
 void
 ao_lisp_string_stash(int id, char *string);
 
 char *
 ao_lisp_string_fetch(int id);
 
-void
-ao_lisp_stack_stash(int id, struct ao_lisp_stack *stack);
+static inline void
+ao_lisp_stack_stash(int id, struct ao_lisp_stack *stack) {
+       ao_lisp_poly_stash(id, ao_lisp_stack_poly(stack));
+}
+
+static inline struct ao_lisp_stack *
+ao_lisp_stack_fetch(int id) {
+       return ao_lisp_poly_stack(ao_lisp_poly_fetch(id));
+}
+
+/* bool */
 
-struct ao_lisp_stack *
-ao_lisp_stack_fetch(int id);
+extern const struct ao_lisp_type ao_lisp_bool_type;
 
 void
-ao_lisp_poly_stash(int id, ao_poly poly);
+ao_lisp_bool_print(ao_poly v);
 
-ao_poly
-ao_lisp_poly_fetch(int id);
+#ifdef AO_LISP_MAKE_CONST
+struct ao_lisp_bool    *ao_lisp_true, *ao_lisp_false;
+
+struct ao_lisp_bool *
+ao_lisp_bool_get(uint8_t value);
+#endif
 
 /* cons */
 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;
 
@@ -609,7 +606,7 @@ ao_lisp_read_eval_print(void);
 /* frame */
 extern const struct ao_lisp_type ao_lisp_frame_type;
 
-#define AO_LISP_FRAME_FREE     4
+#define AO_LISP_FRAME_FREE     6
 
 extern struct ao_lisp_frame    *ao_lisp_frame_free_list[AO_LISP_FRAME_FREE];
 
@@ -625,6 +622,9 @@ ao_lisp_frame_new(int num);
 void
 ao_lisp_frame_free(struct ao_lisp_frame *frame);
 
+void
+ao_lisp_frame_bind(struct ao_lisp_frame *frame, int num, ao_poly atom, ao_poly val);
+
 int
 ao_lisp_frame_add(struct ao_lisp_frame **frame, ao_poly atom, ao_poly val);
 
@@ -642,29 +642,9 @@ 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(void);
 
-/* save */
-
-ao_poly
-ao_lisp_save(struct ao_lisp_cons *cons);
-
-ao_poly
-ao_lisp_restore(struct ao_lisp_cons *cons);
-
 /* stack */
 
 extern const struct ao_lisp_type ao_lisp_stack_type;
@@ -689,9 +669,6 @@ ao_lisp_stack_print(ao_poly stack);
 ao_poly
 ao_lisp_stack_eval(void);
 
-ao_poly
-ao_lisp_call_cc(struct ao_lisp_cons *cons);
-
 /* error */
 
 void
@@ -703,6 +680,11 @@ ao_lisp_error_frame(int indent, char *name, struct ao_lisp_frame *frame);
 ao_poly
 ao_lisp_error(int error, char *format, ...);
 
+/* builtins */
+
+#define AO_LISP_BUILTIN_DECLS
+#include "ao_lisp_builtin.h"
+
 /* debugging macros */
 
 #if DBG_EVAL
@@ -718,7 +700,7 @@ int ao_lisp_stack_depth;
 #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()
+#define DBG_STACK()    ao_lisp_stack_print(ao_lisp_stack_poly(ao_lisp_stack))
 static inline void
 ao_lisp_frames_dump(void)
 {
@@ -743,7 +725,6 @@ ao_lisp_frames_dump(void)
 #define DBG_FRAMES()
 #endif
 
-#define DBG_MEM                0
 #define DBG_MEM_START  1
 
 #if DBG_MEM