summaryrefslogtreecommitdiff
path: root/src/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/lisp')
-rw-r--r--src/lisp/.gitignore1
-rw-r--r--src/lisp/Makefile10
-rw-r--r--src/lisp/Makefile-inc5
-rw-r--r--src/lisp/ao_lisp.h165
-rw-r--r--src/lisp/ao_lisp_bool.c73
-rw-r--r--src/lisp/ao_lisp_builtin.c216
-rw-r--r--src/lisp/ao_lisp_builtin.txt40
-rw-r--r--src/lisp/ao_lisp_const.lisp29
-rw-r--r--src/lisp/ao_lisp_eval.c5
-rw-r--r--src/lisp/ao_lisp_lambda.c8
-rw-r--r--src/lisp/ao_lisp_make_builtin149
-rw-r--r--src/lisp/ao_lisp_make_const.c55
-rw-r--r--src/lisp/ao_lisp_mem.c11
-rw-r--r--src/lisp/ao_lisp_poly.c4
-rw-r--r--src/lisp/ao_lisp_read.c39
-rw-r--r--src/lisp/ao_lisp_read.h37
-rw-r--r--src/lisp/ao_lisp_rep.c2
-rw-r--r--src/lisp/ao_lisp_save.c14
-rw-r--r--src/lisp/ao_lisp_stack.c2
19 files changed, 528 insertions, 337 deletions
diff --git a/src/lisp/.gitignore b/src/lisp/.gitignore
index 76a555ea..1faa9b67 100644
--- a/src/lisp/.gitignore
+++ b/src/lisp/.gitignore
@@ -1,2 +1,3 @@
ao_lisp_make_const
ao_lisp_const.h
+ao_lisp_builtin.h
diff --git a/src/lisp/Makefile b/src/lisp/Makefile
index 25796ec5..4563dad3 100644
--- a/src/lisp/Makefile
+++ b/src/lisp/Makefile
@@ -1,13 +1,16 @@
-all: ao_lisp_const.h
+all: ao_lisp_builtin.h ao_lisp_const.h
clean:
- rm -f ao_lisp_const.h $(OBJS) ao_lisp_make_const
+ rm -f ao_lisp_const.h ao_lisp_builtin.h $(OBJS) ao_lisp_make_const
ao_lisp_const.h: ao_lisp_const.lisp ao_lisp_make_const
./ao_lisp_make_const -o $@ ao_lisp_const.lisp
+ao_lisp_builtin.h: ao_lisp_make_builtin ao_lisp_builtin.txt
+ nickle ./ao_lisp_make_builtin ao_lisp_builtin.txt > $@
+
include Makefile-inc
-SRCS=$(LISP_SRCS)
+SRCS=$(LISP_SRCS) ao_lisp_make_const.c
HDRS=$(LISP_HDRS)
@@ -15,7 +18,6 @@ OBJS=$(SRCS:.c=.o)
CFLAGS=-DAO_LISP_MAKE_CONST -O0 -g -I. -Wall -Wextra -no-pie
-
ao_lisp_make_const: $(OBJS)
$(CC) $(CFLAGS) -o $@ $(OBJS)
diff --git a/src/lisp/Makefile-inc b/src/lisp/Makefile-inc
index 126deeb0..6c8702fb 100644
--- a/src/lisp/Makefile-inc
+++ b/src/lisp/Makefile-inc
@@ -1,11 +1,11 @@
LISP_SRCS=\
- ao_lisp_make_const.c\
ao_lisp_mem.c \
ao_lisp_cons.c \
ao_lisp_string.c \
ao_lisp_atom.c \
ao_lisp_int.c \
ao_lisp_poly.c \
+ ao_lisp_bool.c \
ao_lisp_builtin.c \
ao_lisp_read.c \
ao_lisp_frame.c \
@@ -19,4 +19,5 @@ LISP_SRCS=\
LISP_HDRS=\
ao_lisp.h \
ao_lisp_os.h \
- ao_lisp_read.h
+ ao_lisp_read.h \
+ ao_lisp_builtin.h
diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index 79f8fcc3..cd002cc2 100644
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -54,35 +54,37 @@ 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 _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_collect _atom("collect")
-#define _ao_lisp_atom_symbolp _atom("symbol?")
-#define _ao_lisp_atom_builtin _atom("builtin?")
-#define _ao_lisp_atom_symbolp _atom("symbol?")
-#define _ao_lisp_atom_symbolp _atom("symbol?")
+#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_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_collect _atom(collect)
+#define _ao_lisp_atom_symbolp _atom(symbol?)
+#define _ao_lisp_atom_builtin _atom(builtin?)
+#define _ao_lisp_atom_symbolp _atom(symbol?)
+#define _ao_lisp_atom_symbolp _atom(symbol?)
#else
#include "ao_lisp_const.h"
#ifndef AO_LISP_POOL
@@ -108,7 +110,8 @@ extern uint8_t ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA] __attribute__((a
#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
@@ -171,6 +174,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
@@ -257,47 +266,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_collect,
- _builtin_last
-};
+#define AO_LISP_BUILTIN_ID
+#include "ao_lisp_builtin.h"
typedef ao_poly (*ao_lisp_func_t)(struct ao_lisp_cons *cons);
@@ -433,6 +403,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];
@@ -495,6 +476,20 @@ ao_lisp_stack_fetch(int id) {
return ao_lisp_poly_stack(ao_lisp_poly_fetch(id));
}
+/* bool */
+
+extern const struct ao_lisp_type ao_lisp_bool_type;
+
+void
+ao_lisp_bool_print(ao_poly v);
+
+#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;
@@ -666,28 +661,8 @@ 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;
@@ -712,9 +687,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
@@ -726,6 +698,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
diff --git a/src/lisp/ao_lisp_bool.c b/src/lisp/ao_lisp_bool.c
new file mode 100644
index 00000000..ad25afba
--- /dev/null
+++ b/src/lisp/ao_lisp_bool.c
@@ -0,0 +1,73 @@
+/*
+ * Copyright © 2017 Keith Packard <keithp@keithp.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * General Public License for more details.
+ */
+
+#include "ao_lisp.h"
+
+static void bool_mark(void *addr)
+{
+ (void) addr;
+}
+
+static int bool_size(void *addr)
+{
+ (void) addr;
+ return sizeof (struct ao_lisp_bool);
+}
+
+static void bool_move(void *addr)
+{
+ (void) addr;
+}
+
+const struct ao_lisp_type ao_lisp_bool_type = {
+ .mark = bool_mark,
+ .size = bool_size,
+ .move = bool_move,
+ .name = "bool"
+};
+
+void
+ao_lisp_bool_print(ao_poly v)
+{
+ struct ao_lisp_bool *b = ao_lisp_poly_bool(v);
+
+ if (b->value)
+ printf("#t");
+ else
+ printf("#f");
+}
+
+#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)
+{
+ struct ao_lisp_bool **b;
+
+ if (value)
+ b = &ao_lisp_true;
+ else
+ b = &ao_lisp_false;
+
+ if (!*b) {
+ *b = ao_lisp_alloc(sizeof (struct ao_lisp_bool));
+ (*b)->type = AO_LISP_BOOL;
+ (*b)->value = value;
+ }
+ return *b;
+}
+
+#endif
diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c
index 5a960873..6fc28820 100644
--- a/src/lisp/ao_lisp_builtin.c
+++ b/src/lisp/ao_lisp_builtin.c
@@ -40,61 +40,26 @@ const struct ao_lisp_type ao_lisp_builtin_type = {
};
#ifdef AO_LISP_MAKE_CONST
-char *ao_lisp_builtin_name(enum ao_lisp_builtin_id b) {
- (void) b;
- return "???";
-}
+
+#define AO_LISP_BUILTIN_CASENAME
+#include "ao_lisp_builtin.h"
+
+#define _atomn(n) ao_lisp_poly_atom(_atom(n))
+
char *ao_lisp_args_name(uint8_t args) {
- (void) args;
- return "???";
+ args &= AO_LISP_FUNC_MASK;
+ switch (args) {
+ case AO_LISP_FUNC_LAMBDA: return _atomn(lambda)->name;
+ case AO_LISP_FUNC_LEXPR: return _atomn(lexpr)->name;
+ case AO_LISP_FUNC_NLAMBDA: return _atomn(nlambda)->name;
+ case AO_LISP_FUNC_MACRO: return _atomn(macro)->name;
+ default: return "???";
+ }
}
#else
-static const ao_poly builtin_names[] = {
- [builtin_eval] = _ao_lisp_atom_eval,
- [builtin_read] = _ao_lisp_atom_read,
- [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_length] = _ao_lisp_atom_length,
- [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_progn] = _ao_lisp_atom_progn,
- [builtin_while] = _ao_lisp_atom_while,
- [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,
- [builtin_pack] = _ao_lisp_atom_pack,
- [builtin_unpack] = _ao_lisp_atom_unpack,
- [builtin_flush] = _ao_lisp_atom_flush,
- [builtin_delay] = _ao_lisp_atom_delay,
- [builtin_led] = _ao_lisp_atom_led,
- [builtin_save] = _ao_lisp_atom_save,
- [builtin_restore] = _ao_lisp_atom_restore,
- [builtin_call_cc] = _ao_lisp_atom_call2fcc,
- [builtin_collect] = _ao_lisp_atom_collect,
-#if 0
- [builtin_symbolp] = _ao_lisp_atom_symbolp,
- [builtin_listp] = _ao_lisp_atom_listp,
- [builtin_stringp] = _ao_lisp_atom_stringp,
- [builtin_numberp] = _ao_lisp_atom_numberp,
-#endif
-};
+
+#define AO_LISP_BUILTIN_ARRAYNAME
+#include "ao_lisp_builtin.h"
static char *
ao_lisp_builtin_name(enum ao_lisp_builtin_id b) {
@@ -138,7 +103,7 @@ ao_lisp_check_argc(ao_poly name, struct ao_lisp_cons *cons, int min, int max)
}
if (argc < min || argc > max)
return ao_lisp_error(AO_LISP_INVALID, "%s: invalid arg count", ao_lisp_poly_atom(name)->name);
- return _ao_lisp_atom_t;
+ return _ao_lisp_bool_true;
}
ao_poly
@@ -161,11 +126,11 @@ ao_lisp_check_argt(ao_poly name, struct ao_lisp_cons *cons, int argc, int type,
if ((!car && !nil_ok) || ao_lisp_poly_type(car) != type)
return ao_lisp_error(AO_LISP_INVALID, "%s: invalid type for arg %d", ao_lisp_poly_atom(name)->name, argc);
- return _ao_lisp_atom_t;
+ return _ao_lisp_bool_true;
}
ao_poly
-ao_lisp_car(struct ao_lisp_cons *cons)
+ao_lisp_do_car(struct ao_lisp_cons *cons)
{
if (!ao_lisp_check_argc(_ao_lisp_atom_car, cons, 1, 1))
return AO_LISP_NIL;
@@ -175,7 +140,7 @@ ao_lisp_car(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_cdr(struct ao_lisp_cons *cons)
+ao_lisp_do_cdr(struct ao_lisp_cons *cons)
{
if (!ao_lisp_check_argc(_ao_lisp_atom_cdr, cons, 1, 1))
return AO_LISP_NIL;
@@ -185,7 +150,7 @@ ao_lisp_cdr(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_cons(struct ao_lisp_cons *cons)
+ao_lisp_do_cons(struct ao_lisp_cons *cons)
{
ao_poly car, cdr;
if(!ao_lisp_check_argc(_ao_lisp_atom_cons, cons, 2, 2))
@@ -196,7 +161,7 @@ ao_lisp_cons(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_last(struct ao_lisp_cons *cons)
+ao_lisp_do_last(struct ao_lisp_cons *cons)
{
ao_poly l;
if (!ao_lisp_check_argc(_ao_lisp_atom_last, cons, 1, 1))
@@ -214,7 +179,7 @@ ao_lisp_last(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_length(struct ao_lisp_cons *cons)
+ao_lisp_do_length(struct ao_lisp_cons *cons)
{
if (!ao_lisp_check_argc(_ao_lisp_atom_length, cons, 1, 1))
return AO_LISP_NIL;
@@ -224,7 +189,7 @@ ao_lisp_length(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_quote(struct ao_lisp_cons *cons)
+ao_lisp_do_quote(struct ao_lisp_cons *cons)
{
if (!ao_lisp_check_argc(_ao_lisp_atom_quote, cons, 1, 1))
return AO_LISP_NIL;
@@ -232,7 +197,7 @@ ao_lisp_quote(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_set(struct ao_lisp_cons *cons)
+ao_lisp_do_set(struct ao_lisp_cons *cons)
{
if (!ao_lisp_check_argc(_ao_lisp_atom_set, cons, 2, 2))
return AO_LISP_NIL;
@@ -243,7 +208,7 @@ ao_lisp_set(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_setq(struct ao_lisp_cons *cons)
+ao_lisp_do_setq(struct ao_lisp_cons *cons)
{
if (!ao_lisp_check_argc(_ao_lisp_atom_setq, cons, 2, 2))
return AO_LISP_NIL;
@@ -254,14 +219,14 @@ ao_lisp_setq(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_cond(struct ao_lisp_cons *cons)
+ao_lisp_do_cond(struct ao_lisp_cons *cons)
{
ao_lisp_set_cond(cons);
return AO_LISP_NIL;
}
ao_poly
-ao_lisp_progn(struct ao_lisp_cons *cons)
+ao_lisp_do_progn(struct ao_lisp_cons *cons)
{
ao_lisp_stack->state = eval_progn;
ao_lisp_stack->sexprs = ao_lisp_cons_poly(cons);
@@ -269,7 +234,7 @@ ao_lisp_progn(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_while(struct ao_lisp_cons *cons)
+ao_lisp_do_while(struct ao_lisp_cons *cons)
{
ao_lisp_stack->state = eval_while;
ao_lisp_stack->sexprs = ao_lisp_cons_poly(cons);
@@ -277,7 +242,7 @@ ao_lisp_while(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_print(struct ao_lisp_cons *cons)
+ao_lisp_do_print(struct ao_lisp_cons *cons)
{
ao_poly val = AO_LISP_NIL;
while (cons) {
@@ -292,7 +257,7 @@ ao_lisp_print(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_patom(struct ao_lisp_cons *cons)
+ao_lisp_do_patom(struct ao_lisp_cons *cons)
{
ao_poly val = AO_LISP_NIL;
while (cons) {
@@ -358,31 +323,31 @@ ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
}
ao_poly
-ao_lisp_plus(struct ao_lisp_cons *cons)
+ao_lisp_do_plus(struct ao_lisp_cons *cons)
{
return ao_lisp_math(cons, builtin_plus);
}
ao_poly
-ao_lisp_minus(struct ao_lisp_cons *cons)
+ao_lisp_do_minus(struct ao_lisp_cons *cons)
{
return ao_lisp_math(cons, builtin_minus);
}
ao_poly
-ao_lisp_times(struct ao_lisp_cons *cons)
+ao_lisp_do_times(struct ao_lisp_cons *cons)
{
return ao_lisp_math(cons, builtin_times);
}
ao_poly
-ao_lisp_divide(struct ao_lisp_cons *cons)
+ao_lisp_do_divide(struct ao_lisp_cons *cons)
{
return ao_lisp_math(cons, builtin_divide);
}
ao_poly
-ao_lisp_mod(struct ao_lisp_cons *cons)
+ao_lisp_do_mod(struct ao_lisp_cons *cons)
{
return ao_lisp_math(cons, builtin_mod);
}
@@ -393,7 +358,7 @@ ao_lisp_compare(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
ao_poly left;
if (!cons)
- return _ao_lisp_atom_t;
+ return _ao_lisp_bool_true;
left = cons->car;
cons = ao_lisp_poly_cons(cons->cdr);
@@ -402,7 +367,7 @@ ao_lisp_compare(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
if (op == builtin_equal) {
if (left != right)
- return AO_LISP_NIL;
+ return _ao_lisp_bool_false;
} else {
uint8_t lt = ao_lisp_poly_type(left);
uint8_t rt = ao_lisp_poly_type(right);
@@ -413,19 +378,19 @@ ao_lisp_compare(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
switch (op) {
case builtin_less:
if (!(l < r))
- return AO_LISP_NIL;
+ return _ao_lisp_bool_false;
break;
case builtin_greater:
if (!(l > r))
- return AO_LISP_NIL;
+ return _ao_lisp_bool_false;
break;
case builtin_less_equal:
if (!(l <= r))
- return AO_LISP_NIL;
+ return _ao_lisp_bool_false;
break;
case builtin_greater_equal:
if (!(l >= r))
- return AO_LISP_NIL;
+ return _ao_lisp_bool_false;
break;
default:
break;
@@ -436,19 +401,19 @@ ao_lisp_compare(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
switch (op) {
case builtin_less:
if (!(c < 0))
- return AO_LISP_NIL;
+ return _ao_lisp_bool_false;
break;
case builtin_greater:
if (!(c > 0))
- return AO_LISP_NIL;
+ return _ao_lisp_bool_false;
break;
case builtin_less_equal:
if (!(c <= 0))
- return AO_LISP_NIL;
+ return _ao_lisp_bool_false;
break;
case builtin_greater_equal:
if (!(c >= 0))
- return AO_LISP_NIL;
+ return _ao_lisp_bool_false;
break;
default:
break;
@@ -458,41 +423,41 @@ ao_lisp_compare(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
left = right;
cons = ao_lisp_poly_cons(cons->cdr);
}
- return _ao_lisp_atom_t;
+ return _ao_lisp_bool_true;
}
ao_poly
-ao_lisp_equal(struct ao_lisp_cons *cons)
+ao_lisp_do_equal(struct ao_lisp_cons *cons)
{
return ao_lisp_compare(cons, builtin_equal);
}
ao_poly
-ao_lisp_less(struct ao_lisp_cons *cons)
+ao_lisp_do_less(struct ao_lisp_cons *cons)
{
return ao_lisp_compare(cons, builtin_less);
}
ao_poly
-ao_lisp_greater(struct ao_lisp_cons *cons)
+ao_lisp_do_greater(struct ao_lisp_cons *cons)
{
return ao_lisp_compare(cons, builtin_greater);
}
ao_poly
-ao_lisp_less_equal(struct ao_lisp_cons *cons)
+ao_lisp_do_less_equal(struct ao_lisp_cons *cons)
{
return ao_lisp_compare(cons, builtin_less_equal);
}
ao_poly
-ao_lisp_greater_equal(struct ao_lisp_cons *cons)
+ao_lisp_do_greater_equal(struct ao_lisp_cons *cons)
{
return ao_lisp_compare(cons, builtin_greater_equal);
}
ao_poly
-ao_lisp_pack(struct ao_lisp_cons *cons)
+ao_lisp_do_pack(struct ao_lisp_cons *cons)
{
if (!ao_lisp_check_argc(_ao_lisp_atom_pack, cons, 1, 1))
return AO_LISP_NIL;
@@ -502,7 +467,7 @@ ao_lisp_pack(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_unpack(struct ao_lisp_cons *cons)
+ao_lisp_do_unpack(struct ao_lisp_cons *cons)
{
if (!ao_lisp_check_argc(_ao_lisp_atom_unpack, cons, 1, 1))
return AO_LISP_NIL;
@@ -512,16 +477,16 @@ ao_lisp_unpack(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_flush(struct ao_lisp_cons *cons)
+ao_lisp_do_flush(struct ao_lisp_cons *cons)
{
if (!ao_lisp_check_argc(_ao_lisp_atom_flush, cons, 0, 0))
return AO_LISP_NIL;
ao_lisp_os_flush();
- return _ao_lisp_atom_t;
+ return _ao_lisp_bool_true;
}
ao_poly
-ao_lisp_led(struct ao_lisp_cons *cons)
+ao_lisp_do_led(struct ao_lisp_cons *cons)
{
ao_poly led;
if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
@@ -534,7 +499,7 @@ ao_lisp_led(struct ao_lisp_cons *cons)
}
ao_poly
-ao_lisp_delay(struct ao_lisp_cons *cons)
+ao_lisp_do_delay(struct ao_lisp_cons *cons)
{
ao_poly delay;
if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
@@ -572,44 +537,27 @@ ao_lisp_do_collect(struct ao_lisp_cons *cons)
return ao_lisp_int_poly(free);
}
-const ao_lisp_func_t ao_lisp_builtins[] = {
- [builtin_eval] = ao_lisp_do_eval,
- [builtin_read] = ao_lisp_do_read,
- [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_last] = ao_lisp_last,
- [builtin_length] = ao_lisp_length,
- [builtin_quote] = ao_lisp_quote,
- [builtin_set] = ao_lisp_set,
- [builtin_setq] = ao_lisp_setq,
- [builtin_cond] = ao_lisp_cond,
- [builtin_progn] = ao_lisp_progn,
- [builtin_while] = ao_lisp_while,
- [builtin_print] = ao_lisp_print,
- [builtin_patom] = ao_lisp_patom,
- [builtin_plus] = ao_lisp_plus,
- [builtin_minus] = ao_lisp_minus,
- [builtin_times] = ao_lisp_times,
- [builtin_divide] = ao_lisp_divide,
- [builtin_mod] = ao_lisp_mod,
- [builtin_equal] = ao_lisp_equal,
- [builtin_less] = ao_lisp_less,
- [builtin_greater] = ao_lisp_greater,
- [builtin_less_equal] = ao_lisp_less_equal,
- [builtin_greater_equal] = ao_lisp_greater_equal,
- [builtin_pack] = ao_lisp_pack,
- [builtin_unpack] = ao_lisp_unpack,
- [builtin_flush] = ao_lisp_flush,
- [builtin_led] = ao_lisp_led,
- [builtin_delay] = ao_lisp_delay,
- [builtin_save] = ao_lisp_save,
- [builtin_restore] = ao_lisp_restore,
- [builtin_call_cc] = ao_lisp_call_cc,
- [builtin_collect] = ao_lisp_do_collect,
-};
+ao_poly
+ao_lisp_do_nullp(struct ao_lisp_cons *cons)
+{
+ if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
+ return AO_LISP_NIL;
+ if (ao_lisp_arg(cons, 0) == AO_LISP_NIL)
+ return _ao_lisp_bool_true;
+ else
+ return _ao_lisp_bool_false;
+}
+
+ao_poly
+ao_lisp_do_not(struct ao_lisp_cons *cons)
+{
+ if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
+ return AO_LISP_NIL;
+ if (ao_lisp_arg(cons, 0) == _ao_lisp_bool_false)
+ return _ao_lisp_bool_true;
+ else
+ return _ao_lisp_bool_false;
+}
+#define AO_LISP_BUILTIN_FUNCS
+#include "ao_lisp_builtin.h"
diff --git a/src/lisp/ao_lisp_builtin.txt b/src/lisp/ao_lisp_builtin.txt
new file mode 100644
index 00000000..02320df0
--- /dev/null
+++ b/src/lisp/ao_lisp_builtin.txt
@@ -0,0 +1,40 @@
+lambda eval
+lambda read
+nlambda lambda
+nlambda lexpr
+nlambda nlambda
+nlambda macro
+lambda car
+lambda cdr
+lambda cons
+lambda last
+lambda length
+nlambda quote
+lambda set
+macro setq
+nlambda cond
+nlambda progn
+nlambda while
+lexpr print
+lexpr patom
+lexpr plus +
+lexpr minus -
+lexpr times *
+lexpr divide /
+lexpr mod %
+lexpr equal =
+lexpr less <
+lexpr greater >
+lexpr less_equal <=
+lexpr greater_equal >=
+lambda pack
+lambda unpack
+lambda flush
+lambda delay
+lexpr led
+lambda save
+lambda restore
+lambda call_cc call/cc
+lambda collect
+lambda nullp null?
+lambda not
diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp
index 3c8fd21b..df277fce 100644
--- a/src/lisp/ao_lisp_const.lisp
+++ b/src/lisp/ao_lisp_const.lisp
@@ -95,7 +95,7 @@
;
(setq make-names (lambda (vars)
- (cond (vars
+ (cond ((not (null? vars))
(cons (car (car vars))
(make-names (cdr vars))))
)
@@ -108,7 +108,7 @@
; expressions to evaluate
(setq make-exprs (lambda (vars exprs)
- (cond (vars (cons
+ (cond ((not (null? vars)) (cons
(list set
(list quote
(car (car vars))
@@ -127,7 +127,7 @@
; of nils of the right length
(setq make-nils (lambda (vars)
- (cond (vars (cons nil (make-nils (cdr vars))))
+ (cond ((not (null? vars)) (cons () (make-nils (cdr vars))))
)
)
)
@@ -149,13 +149,14 @@
)
)
+(let ((x 1)) x)
+
; boolean operators
(def or (lexpr (l)
- (let ((ret nil))
- (while l
- (cond ((setq ret (car l))
- (setq l nil))
+ (let ((ret #f))
+ (while (not (null? l))
+ (cond ((car l) (setq ret #t) (setq l ()))
((setq l (cdr l)))))
ret
)
@@ -164,14 +165,16 @@
; execute to resolve macros
-(or nil t)
+(or #f #t)
(def and (lexpr (l)
- (let ((ret t))
- (while l
- (cond ((setq ret (car l))
+ (let ((ret #t))
+ (while (not (null? l))
+ (cond ((car l)
(setq l (cdr l)))
- ((setq ret (setq l nil)))
+ (#t
+ (setq ret #f)
+ (setq l ()))
)
)
ret
@@ -181,4 +184,4 @@
; execute to resolve macros
-(and t nil)
+(and #t #f)
diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index 3e68d14a..b6cb4fd8 100644
--- a/src/lisp/ao_lisp_eval.c
+++ b/src/lisp/ao_lisp_eval.c
@@ -107,6 +107,7 @@ ao_lisp_eval_sexpr(void)
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_BOOL:
case AO_LISP_INT:
case AO_LISP_STRING:
case AO_LISP_BUILTIN:
@@ -345,7 +346,7 @@ 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) {
+ if (ao_lisp_v != _ao_lisp_bool_false) {
struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car);
ao_poly c = car->cdr;
@@ -432,7 +433,7 @@ ao_lisp_eval_while_test(void)
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) {
+ if (ao_lisp_v != _ao_lisp_bool_false) {
ao_lisp_stack->values = ao_lisp_v;
ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
ao_lisp_stack->state = eval_while;
diff --git a/src/lisp/ao_lisp_lambda.c b/src/lisp/ao_lisp_lambda.c
index 526863c5..cc333d6f 100644
--- a/src/lisp/ao_lisp_lambda.c
+++ b/src/lisp/ao_lisp_lambda.c
@@ -98,25 +98,25 @@ ao_lisp_lambda_alloc(struct ao_lisp_cons *code, int args)
}
ao_poly
-ao_lisp_lambda(struct ao_lisp_cons *cons)
+ao_lisp_do_lambda(struct ao_lisp_cons *cons)
{
return ao_lisp_lambda_alloc(cons, AO_LISP_FUNC_LAMBDA);
}
ao_poly
-ao_lisp_lexpr(struct ao_lisp_cons *cons)
+ao_lisp_do_lexpr(struct ao_lisp_cons *cons)
{
return ao_lisp_lambda_alloc(cons, AO_LISP_FUNC_LEXPR);
}
ao_poly
-ao_lisp_nlambda(struct ao_lisp_cons *cons)
+ao_lisp_do_nlambda(struct ao_lisp_cons *cons)
{
return ao_lisp_lambda_alloc(cons, AO_LISP_FUNC_NLAMBDA);
}
ao_poly
-ao_lisp_macro(struct ao_lisp_cons *cons)
+ao_lisp_do_macro(struct ao_lisp_cons *cons)
{
return ao_lisp_lambda_alloc(cons, AO_LISP_FUNC_MACRO);
}
diff --git a/src/lisp/ao_lisp_make_builtin b/src/lisp/ao_lisp_make_builtin
new file mode 100644
index 00000000..5e98516c
--- /dev/null
+++ b/src/lisp/ao_lisp_make_builtin
@@ -0,0 +1,149 @@
+#!/usr/bin/nickle
+
+typedef struct {
+ string type;
+ string c_name;
+ string lisp_name;
+} builtin_t;
+
+string[string] type_map = {
+ "lambda" => "F_LAMBDA",
+ "nlambda" => "NLAMBDA",
+ "lexpr" => "F_LEXPR",
+ "macro" => "MACRO",
+};
+
+builtin_t
+read_builtin(file f) {
+ string line = File::fgets(f);
+ string[*] tokens = String::wordsplit(line, " \t");
+
+ return (builtin_t) {
+ .type = dim(tokens) > 0 ? type_map[tokens[0]] : "#",
+ .c_name = dim(tokens) > 1 ? tokens[1] : "#",
+ .lisp_name = dim(tokens) > 2 ? tokens[2] : tokens[1]
+ };
+}
+
+builtin_t[*]
+read_builtins(file f) {
+ builtin_t[...] builtins = {};
+
+ while (!File::end(f)) {
+ builtin_t b = read_builtin(f);
+
+ if (b.type[0] != '#')
+ builtins[dim(builtins)] = b;
+ }
+ return builtins;
+}
+
+void
+dump_ids(builtin_t[*] builtins) {
+ printf("#ifdef AO_LISP_BUILTIN_ID\n");
+ printf("#undef AO_LISP_BUILTIN_ID\n");
+ printf("enum ao_lisp_builtin_id {\n");
+ for (int i = 0; i < dim(builtins); i++)
+ printf("\tbuiltin_%s,\n", builtins[i].c_name);
+ printf("\t_builtin_last\n");
+ printf("};\n");
+ printf("#endif /* AO_LISP_BUILTIN_ID */\n");
+}
+
+void
+dump_casename(builtin_t[*] builtins) {
+ printf("#ifdef AO_LISP_BUILTIN_CASENAME\n");
+ printf("#undef AO_LISP_BUILTIN_CASENAME\n");
+ printf("static char *ao_lisp_builtin_name(enum ao_lisp_builtin_id b) {\n");
+ printf("\tswitch(b) {\n");
+ for (int i = 0; i < dim(builtins); i++)
+ printf("\tcase builtin_%s: return ao_lisp_poly_atom(_atom(%s))->name;\n",
+ builtins[i].c_name, builtins[i].c_name);
+ printf("\tdefault: return \"???\";\n");
+ printf("\t}\n");
+ printf("}\n");
+ printf("#endif /* AO_LISP_BUILTIN_CASENAME */\n");
+}
+
+void
+cify_lisp(string l) {
+ for (int j = 0; j < String::length(l); j++) {
+ int c= l[j];
+ if (Ctype::isalnum(c) || c == '_')
+ printf("%c", c);
+ else
+ printf("%02x", c);
+ }
+}
+
+void
+dump_arrayname(builtin_t[*] builtins) {
+ printf("#ifdef AO_LISP_BUILTIN_ARRAYNAME\n");
+ printf("#undef AO_LISP_BUILTIN_ARRAYNAME\n");
+ printf("static const ao_poly builtin_names[] = {\n");
+ for (int i = 0; i < dim(builtins); i++) {
+ printf("\t[builtin_%s] = _ao_lisp_atom_",
+ builtins[i].c_name);
+ cify_lisp(builtins[i].lisp_name);
+ printf(",\n");
+ }
+ printf("};\n");
+ printf("#endif /* AO_LISP_BUILTIN_ARRAYNAME */\n");
+}
+
+void
+dump_funcs(builtin_t[*] builtins) {
+ printf("#ifdef AO_LISP_BUILTIN_FUNCS\n");
+ printf("#undef AO_LISP_BUILTIN_FUNCS\n");
+ printf("const ao_lisp_func_t ao_lisp_builtins[] = {\n");
+ for (int i = 0; i < dim(builtins); i++) {
+ printf("\t[builtin_%s] = ao_lisp_do_%s,\n",
+ builtins[i].c_name,
+ builtins[i].c_name);
+ }
+ printf("};\n");
+ printf("#endif /* AO_LISP_BUILTIN_FUNCS */\n");
+}
+
+void
+dump_decls(builtin_t[*] builtins) {
+ printf("#ifdef AO_LISP_BUILTIN_DECLS\n");
+ printf("#undef AO_LISP_BUILTIN_DECLS\n");
+ for (int i = 0; i < dim(builtins); i++) {
+ printf("ao_poly\n");
+ printf("ao_lisp_do_%s(struct ao_lisp_cons *cons);\n",
+ builtins[i].c_name);
+ }
+ printf("#endif /* AO_LISP_BUILTIN_DECLS */\n");
+}
+
+void
+dump_consts(builtin_t[*] builtins) {
+ printf("#ifdef AO_LISP_BUILTIN_CONSTS\n");
+ printf("#undef AO_LISP_BUILTIN_CONSTS\n");
+ printf("struct builtin_func funcs[] = {\n");
+ for (int i = 0; i < dim(builtins); i++) {
+ printf ("\t{ .name = \"%s\", .args = AO_LISP_FUNC_%s, .func = builtin_%s },\n",
+ builtins[i].lisp_name, builtins[i].type, builtins[i].c_name);
+ }
+ printf("};\n");
+ printf("#endif /* AO_LISP_BUILTIN_CONSTS */\n");
+}
+
+void main() {
+ if (dim(argv) < 2) {
+ File::fprintf(stderr, "usage: %s <file>\n", argv[0]);
+ exit(1);
+ }
+ twixt(file f = File::open(argv[1], "r"); File::close(f)) {
+ builtin_t[*] builtins = read_builtins(f);
+ dump_ids(builtins);
+ dump_casename(builtins);
+ dump_arrayname(builtins);
+ dump_funcs(builtins);
+ dump_decls(builtins);
+ dump_consts(builtins);
+ }
+}
+
+main();
diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c
index 49f989e6..02cfa67e 100644
--- a/src/lisp/ao_lisp_make_const.c
+++ b/src/lisp/ao_lisp_make_const.c
@@ -34,46 +34,8 @@ struct builtin_func {
int func;
};
-struct builtin_func funcs[] = {
- { .name = "eval", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_eval },
- { .name = "read", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_read },
- { .name = "lambda", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_lambda },
- { .name = "lexpr", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_lexpr },
- { .name = "nlambda", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_nlambda },
- { .name = "macro", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_macro },
- { .name = "car", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_car },
- { .name = "cdr", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_cdr },
- { .name = "cons", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_cons },
- { .name = "last", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_last },
- { .name = "length", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_length },
- { .name = "quote", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_quote },
- { .name = "set", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_set },
- { .name = "setq", .args = AO_LISP_FUNC_MACRO, .func = builtin_setq },
- { .name = "cond", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_cond },
- { .name = "progn", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_progn },
- { .name = "while", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_while },
- { .name = "print", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_print },
- { .name = "patom", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_patom },
- { .name = "+", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_plus },
- { .name = "-", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_minus },
- { .name = "*", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_times },
- { .name = "/", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_divide },
- { .name = "%", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_mod },
- { .name = "=", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_equal },
- { .name = "<", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_less },
- { .name = ">", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_greater },
- { .name = "<=", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_less_equal },
- { .name = ">=", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_greater_equal },
- { .name = "pack", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_pack },
- { .name = "unpack", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_unpack },
- { .name = "flush", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_flush },
- { .name = "delay", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_delay },
- { .name = "led", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_led },
- { .name = "save", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_save },
- { .name = "restore", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_restore },
- { .name = "call/cc", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_call_cc },
- { .name = "collect", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_collect },
-};
+#define AO_LISP_BUILTIN_CONSTS
+#include "ao_lisp_builtin.h"
#define N_FUNC (sizeof funcs / sizeof funcs[0])
@@ -326,6 +288,10 @@ main(int argc, char **argv)
}
}
+ /* Boolean values #f and #t */
+ ao_lisp_bool_get(0);
+ ao_lisp_bool_get(1);
+
for (f = 0; f < (int) N_FUNC; f++) {
b = ao_lisp_make_builtin(funcs[f].func, funcs[f].args);
a = ao_lisp_atom_intern(funcs[f].name);
@@ -333,13 +299,6 @@ main(int argc, char **argv)
ao_lisp_builtin_poly(b));
}
- /* boolean constants */
- ao_lisp_atom_set(ao_lisp_atom_poly(ao_lisp_atom_intern("nil")),
- AO_LISP_NIL);
- a = ao_lisp_atom_intern("t");
- ao_lisp_atom_set(ao_lisp_atom_poly(a),
- ao_lisp_atom_poly(a));
-
/* end of file value */
a = ao_lisp_atom_intern("eof");
ao_lisp_atom_set(ao_lisp_atom_poly(a),
@@ -387,6 +346,8 @@ main(int argc, char **argv)
fprintf(out, "#define ao_builtin_frame 0x%04x\n", ao_lisp_frame_poly(ao_lisp_frame_global));
fprintf(out, "#define ao_lisp_const_checksum ((uint16_t) 0x%04x)\n", ao_fec_crc(ao_lisp_const, ao_lisp_top));
+ fprintf(out, "#define _ao_lisp_bool_false 0x%04x\n", ao_lisp_bool_poly(ao_lisp_false));
+ fprintf(out, "#define _ao_lisp_bool_true 0x%04x\n", ao_lisp_bool_poly(ao_lisp_true));
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 d7c8d7a6..156221e8 100644
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -211,6 +211,16 @@ static const struct ao_lisp_root ao_lisp_root[] = {
.type = &ao_lisp_cons_type,
.addr = (void **) &ao_lisp_read_stack,
},
+#ifdef AO_LISP_MAKE_CONST
+ {
+ .type = &ao_lisp_bool_type,
+ .addr = (void **) &ao_lisp_false,
+ },
+ {
+ .type = &ao_lisp_bool_type,
+ .addr = (void **) &ao_lisp_true,
+ },
+#endif
};
#define AO_LISP_ROOT (sizeof (ao_lisp_root) / sizeof (ao_lisp_root[0]))
@@ -447,6 +457,7 @@ static const struct ao_lisp_type *ao_lisp_types[AO_LISP_NUM_TYPE] = {
[AO_LISP_FRAME] = &ao_lisp_frame_type,
[AO_LISP_LAMBDA] = &ao_lisp_lambda_type,
[AO_LISP_STACK] = &ao_lisp_stack_type,
+ [AO_LISP_BOOL] = &ao_lisp_bool_type,
};
static int
diff --git a/src/lisp/ao_lisp_poly.c b/src/lisp/ao_lisp_poly.c
index fb3b06fe..160734b1 100644
--- a/src/lisp/ao_lisp_poly.c
+++ b/src/lisp/ao_lisp_poly.c
@@ -52,6 +52,10 @@ static const struct ao_lisp_funcs ao_lisp_funcs[AO_LISP_NUM_TYPE] = {
.print = ao_lisp_stack_print,
.patom = ao_lisp_stack_print,
},
+ [AO_LISP_BOOL] = {
+ .print = ao_lisp_bool_print,
+ .patom = ao_lisp_bool_print,
+ },
};
static const struct ao_lisp_funcs *
diff --git a/src/lisp/ao_lisp_read.c b/src/lisp/ao_lisp_read.c
index 550f62c2..508d16b4 100644
--- a/src/lisp/ao_lisp_read.c
+++ b/src/lisp/ao_lisp_read.c
@@ -51,18 +51,18 @@ static const uint16_t lex_classes[128] = {
PRINTABLE|WHITE, /* */
PRINTABLE, /* ! */
PRINTABLE|STRINGC, /* " */
- PRINTABLE|COMMENT, /* # */
+ PRINTABLE|POUND, /* # */
PRINTABLE, /* $ */
PRINTABLE, /* % */
PRINTABLE, /* & */
- PRINTABLE|QUOTEC, /* ' */
- PRINTABLE|BRA, /* ( */
- PRINTABLE|KET, /* ) */
+ PRINTABLE|SPECIAL, /* ' */
+ PRINTABLE|SPECIAL, /* ( */
+ PRINTABLE|SPECIAL, /* ) */
PRINTABLE, /* * */
PRINTABLE|SIGN, /* + */
PRINTABLE, /* , */
PRINTABLE|SIGN, /* - */
- PRINTABLE|DOTC, /* . */
+ PRINTABLE|SPECIAL, /* . */
PRINTABLE, /* / */
PRINTABLE|DIGIT, /* 0 */
PRINTABLE|DIGIT, /* 1 */
@@ -283,27 +283,38 @@ _lex(void)
continue;
}
- if (lex_class & (BRA|KET|QUOTEC)) {
+ if (lex_class & SPECIAL) {
add_token(c);
end_token();
switch (c) {
case '(':
+ case '[':
return OPEN;
case ')':
+ case ']':
return CLOSE;
case '\'':
return QUOTE;
+ case '.':
+ return DOT;
}
}
- if (lex_class & (DOTC)) {
- add_token(c);
- end_token();
- return DOT;
- }
if (lex_class & TWIDDLE) {
token_int = lexc();
return NUM;
}
+ if (lex_class & POUND) {
+ for (;;) {
+ c = lexc();
+ add_token(c);
+ switch (c) {
+ case 't':
+ return BOOL;
+ case 'f':
+ return BOOL;
+ }
+ }
+ }
if (lex_class & STRINGC) {
for (;;) {
c = lexc();
@@ -457,6 +468,12 @@ ao_lisp_read(void)
case NUM:
v = ao_lisp_int_poly(token_int);
break;
+ case BOOL:
+ if (token_string[0] == 't')
+ v = _ao_lisp_bool_true;
+ else
+ v = _ao_lisp_bool_false;
+ break;
case STRING:
string = ao_lisp_string_copy(token_string);
if (string)
diff --git a/src/lisp/ao_lisp_read.h b/src/lisp/ao_lisp_read.h
index 30dcac3f..f8bcd195 100644
--- a/src/lisp/ao_lisp_read.h
+++ b/src/lisp/ao_lisp_read.h
@@ -15,6 +15,10 @@
#ifndef _AO_LISP_READ_H_
#define _AO_LISP_READ_H_
+/*
+ * token classes
+ */
+
# define END 0
# define NAME 1
# define OPEN 2
@@ -23,29 +27,28 @@
# define STRING 5
# define NUM 6
# define DOT 7
+# define BOOL 8
/*
* character classes
*/
-# define PRINTABLE 0x00000001 /* \t \n ' ' - '~' */
-# define QUOTED 0x00000002 /* \ anything */
-# define BRA 0x00000004 /* ( [ { */
-# define KET 0x00000008 /* ) ] } */
-# define WHITE 0x00000010 /* ' ' \t \n */
-# define DIGIT 0x00000020 /* [0-9] */
-# define SIGN 0x00000040 /* +- */
-# define ENDOFFILE 0x00000080 /* end of file */
-# define COMMENT 0x00000100 /* ; # */
-# define IGNORE 0x00000200 /* \0 - ' ' */
-# define QUOTEC 0x00000400 /* ' */
-# define BACKSLASH 0x00000800 /* \ */
-# define VBAR 0x00001000 /* | */
-# define TWIDDLE 0x00002000 /* ~ */
-# define STRINGC 0x00004000 /* " */
-# define DOTC 0x00008000 /* . */
+# define PRINTABLE 0x0001 /* \t \n ' ' - '~' */
+# define QUOTED 0x0002 /* \ anything */
+# define SPECIAL 0x0004 /* ( [ { ) ] } ' . */
+# define WHITE 0x0008 /* ' ' \t \n */
+# define DIGIT 0x0010 /* [0-9] */
+# define SIGN 0x0020 /* +- */
+# define ENDOFFILE 0x0040 /* end of file */
+# define COMMENT 0x0080 /* ; */
+# define IGNORE 0x0100 /* \0 - ' ' */
+# define BACKSLASH 0x0200 /* \ */
+# define VBAR 0x0400 /* | */
+# define TWIDDLE 0x0800 /* ~ */
+# define STRINGC 0x1000 /* " */
+# define POUND 0x2000 /* # */
-# define NOTNAME (STRINGC|TWIDDLE|VBAR|QUOTEC|COMMENT|ENDOFFILE|WHITE|KET|BRA|DOTC)
+# define NOTNAME (STRINGC|TWIDDLE|VBAR|COMMENT|ENDOFFILE|WHITE|SPECIAL)
# define NUMBER (DIGIT|SIGN)
#endif /* _AO_LISP_READ_H_ */
diff --git a/src/lisp/ao_lisp_rep.c b/src/lisp/ao_lisp_rep.c
index 3be95d44..ef7dbaf2 100644
--- a/src/lisp/ao_lisp_rep.c
+++ b/src/lisp/ao_lisp_rep.c
@@ -20,7 +20,7 @@ ao_lisp_read_eval_print(void)
ao_poly in, out = AO_LISP_NIL;
for(;;) {
in = ao_lisp_read();
- if (in == _ao_lisp_atom_eof || in == AO_LISP_NIL)
+ if (in == _ao_lisp_atom_eof)
break;
out = ao_lisp_eval(in);
if (ao_lisp_exception) {
diff --git a/src/lisp/ao_lisp_save.c b/src/lisp/ao_lisp_save.c
index 4f850fb9..cbc8e925 100644
--- a/src/lisp/ao_lisp_save.c
+++ b/src/lisp/ao_lisp_save.c
@@ -15,7 +15,7 @@
#include <ao_lisp.h>
ao_poly
-ao_lisp_save(struct ao_lisp_cons *cons)
+ao_lisp_do_save(struct ao_lisp_cons *cons)
{
if (!ao_lisp_check_argc(_ao_lisp_atom_save, cons, 0, 0))
return AO_LISP_NIL;
@@ -30,13 +30,13 @@ ao_lisp_save(struct ao_lisp_cons *cons)
os->const_checksum_inv = (uint16_t) ~ao_lisp_const_checksum;
if (ao_lisp_os_save())
- return _ao_lisp_atom_t;
+ return _ao_lisp_bool_true;
#endif
- return AO_LISP_NIL;
+ return _ao_lisp_bool_false;
}
ao_poly
-ao_lisp_restore(struct ao_lisp_cons *cons)
+ao_lisp_do_restore(struct ao_lisp_cons *cons)
{
if (!ao_lisp_check_argc(_ao_lisp_atom_save, cons, 0, 0))
return AO_LISP_NIL;
@@ -68,9 +68,9 @@ ao_lisp_restore(struct ao_lisp_cons *cons)
/* Re-create the evaluator stack */
if (!ao_lisp_eval_restart())
- return AO_LISP_NIL;
- return _ao_lisp_atom_t;
+ return _ao_lisp_bool_false;
+ return _ao_lisp_bool_true;
}
#endif
- return AO_LISP_NIL;
+ return _ao_lisp_bool_false;
}
diff --git a/src/lisp/ao_lisp_stack.c b/src/lisp/ao_lisp_stack.c
index 53adf432..729a63ba 100644
--- a/src/lisp/ao_lisp_stack.c
+++ b/src/lisp/ao_lisp_stack.c
@@ -241,7 +241,7 @@ ao_lisp_stack_eval(void)
* it a single argument which is the current continuation
*/
ao_poly
-ao_lisp_call_cc(struct ao_lisp_cons *cons)
+ao_lisp_do_call_cc(struct ao_lisp_cons *cons)
{
struct ao_lisp_stack *new;
ao_poly v;
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 12:16:02 +0000