From b3b4731fcb89cb404433f37a7704a503567c43bd Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Thu, 16 Nov 2017 17:49:47 -0800 Subject: [PATCH] altos/lisp: Add scheme-style bools (#t and #f) Cond and while compare against #f, just like scheme says to. Signed-off-by: Keith Packard --- src/lisp/.gitignore | 1 + src/lisp/Makefile | 10 +- src/lisp/Makefile-inc | 5 +- src/lisp/ao_lisp.h | 165 +++++++++++--------------- src/lisp/ao_lisp_bool.c | 73 ++++++++++++ src/lisp/ao_lisp_builtin.c | 216 +++++++++++++--------------------- src/lisp/ao_lisp_builtin.txt | 40 +++++++ src/lisp/ao_lisp_const.lisp | 29 +++-- src/lisp/ao_lisp_eval.c | 5 +- src/lisp/ao_lisp_lambda.c | 8 +- src/lisp/ao_lisp_make_builtin | 149 +++++++++++++++++++++++ src/lisp/ao_lisp_make_const.c | 55 ++------- src/lisp/ao_lisp_mem.c | 11 ++ src/lisp/ao_lisp_poly.c | 4 + src/lisp/ao_lisp_read.c | 39 ++++-- src/lisp/ao_lisp_read.h | 37 +++--- src/lisp/ao_lisp_rep.c | 2 +- src/lisp/ao_lisp_save.c | 14 +-- src/lisp/ao_lisp_stack.c | 2 +- 19 files changed, 528 insertions(+), 337 deletions(-) create mode 100644 src/lisp/ao_lisp_bool.c create mode 100644 src/lisp/ao_lisp_builtin.txt create mode 100644 src/lisp/ao_lisp_make_builtin 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; @@ -665,29 +660,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; @@ -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 + * + * 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 \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_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; -- 2.30.2