From 417161dbb36323b5a6572859dedad02ca92fc65c Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Wed, 9 Nov 2016 16:22:43 -0800 Subject: altos/lisp: Clean up OS integration bits, add defun Provide an abstraction for the OS interface so that it can build more cleanly on Linux and AltOS. Add defun macro. Signed-off-by: Keith Packard --- src/lisp/ao_lisp_os.h | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) create mode 100644 src/lisp/ao_lisp_os.h (limited to 'src/lisp/ao_lisp_os.h') diff --git a/src/lisp/ao_lisp_os.h b/src/lisp/ao_lisp_os.h new file mode 100644 index 00000000..55ffed50 --- /dev/null +++ b/src/lisp/ao_lisp_os.h @@ -0,0 +1,51 @@ +/* + * Copyright © 2016 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; version 2 of the License. + * + * 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. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. + */ + +#ifndef _AO_LISP_OS_H_ +#define _AO_LISP_OS_H_ + +#include +#include +#include + +static inline int +ao_lisp_getc() { + return getchar(); +} + +static inline void +ao_lisp_abort(void) +{ + abort(); +} + +static inline void +ao_lisp_os_led(int led) +{ + printf("leds set to 0x%x\n", led); +} + +static inline void +ao_lisp_os_delay(int delay) +{ + struct timespec ts = { + .tv_sec = delay / 1000, + .tv_nsec = (delay % 1000) * 1000000, + }; + nanosleep(&ts, NULL); +} +#endif -- cgit v1.2.3 From 7f7e2431f5d1f7c1782ed6e774ccfc70fb4c87cf Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Fri, 11 Nov 2016 00:28:31 -0800 Subject: altos/lisp: add length, pack, unpack and flush lots more builtins Signed-off-by: Keith Packard --- src/lambdakey-v1.0/ao_lisp_os.h | 6 +++++ src/lisp/ao_lisp.h | 17 ++++++++++++++ src/lisp/ao_lisp_builtin.c | 47 +++++++++++++++++++++++++++++++++++++ src/lisp/ao_lisp_cons.c | 11 +++++++++ src/lisp/ao_lisp_lambda.c | 11 --------- src/lisp/ao_lisp_make_const.c | 4 ++++ src/lisp/ao_lisp_os.h | 5 ++++ src/lisp/ao_lisp_string.c | 52 +++++++++++++++++++++++++++++++++++++---- src/test/ao_lisp_os.h | 5 ++++ 9 files changed, 142 insertions(+), 16 deletions(-) (limited to 'src/lisp/ao_lisp_os.h') diff --git a/src/lambdakey-v1.0/ao_lisp_os.h b/src/lambdakey-v1.0/ao_lisp_os.h index df158f6a..1993ac44 100644 --- a/src/lambdakey-v1.0/ao_lisp_os.h +++ b/src/lambdakey-v1.0/ao_lisp_os.h @@ -35,6 +35,12 @@ ao_lisp_getc() { return c; } +static inline void +ao_lisp_os_flush(void) +{ + flush(); +} + static inline void ao_lisp_abort(void) { diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index 60a97f2c..86a5ddcf 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -36,10 +36,14 @@ extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST]; #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") @@ -215,6 +219,7 @@ enum ao_lisp_builtin_id { builtin_cdr, builtin_cons, builtin_last, + builtin_length, builtin_quote, builtin_set, builtin_setq, @@ -233,6 +238,9 @@ enum ao_lisp_builtin_id { builtin_greater, builtin_less_equal, builtin_greater_equal, + builtin_pack, + builtin_unpack, + builtin_flush, builtin_delay, builtin_led, _builtin_last @@ -409,6 +417,9 @@ ao_lisp_cons_print(ao_poly); void ao_lisp_cons_patom(ao_poly); +int +ao_lisp_cons_length(struct ao_lisp_cons *cons); + /* string */ extern const struct ao_lisp_type ao_lisp_string_type; @@ -421,6 +432,12 @@ ao_lisp_string_copy(char *a); char * ao_lisp_string_cat(char *a, char *b); +ao_poly +ao_lisp_string_pack(struct ao_lisp_cons *cons); + +ao_poly +ao_lisp_string_unpack(char *a); + void ao_lisp_string_print(ao_poly s); diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c index 57d9ee10..30631980 100644 --- a/src/lisp/ao_lisp_builtin.c +++ b/src/lisp/ao_lisp_builtin.c @@ -58,6 +58,7 @@ static const ao_poly builtin_names[] = { [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, @@ -76,6 +77,9 @@ static const ao_poly builtin_names[] = { [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, }; @@ -200,6 +204,16 @@ ao_lisp_last(struct ao_lisp_cons *cons) return AO_LISP_NIL; } +ao_poly +ao_lisp_length(struct ao_lisp_cons *cons) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_last, cons, 1, 1)) + return AO_LISP_NIL; + if (!ao_lisp_check_argt(_ao_lisp_atom_last, cons, 0, AO_LISP_CONS, 1)) + return AO_LISP_NIL; + return ao_lisp_int_poly(ao_lisp_cons_length(ao_lisp_poly_cons(ao_lisp_arg(cons, 0)))); +} + ao_poly ao_lisp_quote(struct ao_lisp_cons *cons) { @@ -470,6 +484,35 @@ ao_lisp_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) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_pack, cons, 1, 1)) + return AO_LISP_NIL; + if (!ao_lisp_check_argt(_ao_lisp_atom_pack, cons, 0, AO_LISP_CONS, 1)) + return AO_LISP_NIL; + return ao_lisp_string_pack(ao_lisp_poly_cons(ao_lisp_arg(cons, 0))); +} + +ao_poly +ao_lisp_unpack(struct ao_lisp_cons *cons) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_unpack, cons, 1, 1)) + return AO_LISP_NIL; + if (!ao_lisp_check_argt(_ao_lisp_atom_unpack, cons, 0, AO_LISP_STRING, 0)) + return AO_LISP_NIL; + return ao_lisp_string_unpack(ao_lisp_poly_string(ao_lisp_arg(cons, 0))); +} + +ao_poly +ao_lisp_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; +} + ao_poly ao_lisp_led(struct ao_lisp_cons *cons) { @@ -524,6 +567,7 @@ const ao_lisp_func_t ao_lisp_builtins[] = { [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, @@ -542,6 +586,9 @@ const ao_lisp_func_t ao_lisp_builtins[] = { [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, }; diff --git a/src/lisp/ao_lisp_cons.c b/src/lisp/ao_lisp_cons.c index cd8a8d1d..b75ffaa0 100644 --- a/src/lisp/ao_lisp_cons.c +++ b/src/lisp/ao_lisp_cons.c @@ -107,3 +107,14 @@ ao_lisp_cons_patom(ao_poly c) cons = ao_lisp_poly_cons(cons->cdr); } } + +int +ao_lisp_cons_length(struct ao_lisp_cons *cons) +{ + int len = 0; + while (cons) { + len++; + cons = ao_lisp_poly_cons(cons->cdr); + } + return len; +} diff --git a/src/lisp/ao_lisp_lambda.c b/src/lisp/ao_lisp_lambda.c index 8eafb187..c53a38fd 100644 --- a/src/lisp/ao_lisp_lambda.c +++ b/src/lisp/ao_lisp_lambda.c @@ -49,17 +49,6 @@ const struct ao_lisp_type ao_lisp_lambda_type = { .move = lambda_move, }; -static int -ao_lisp_cons_length(struct ao_lisp_cons *cons) -{ - int len = 0; - while (cons) { - len++; - cons = ao_lisp_poly_cons(cons->cdr); - } - return len; -} - void ao_lisp_lambda_print(ao_poly poly) { diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c index 4fc43e58..0b3e25a6 100644 --- a/src/lisp/ao_lisp_make_const.c +++ b/src/lisp/ao_lisp_make_const.c @@ -43,6 +43,7 @@ struct builtin_func funcs[] = { "cdr", AO_LISP_FUNC_LAMBDA, builtin_cdr, "cons", AO_LISP_FUNC_LAMBDA, builtin_cons, "last", AO_LISP_FUNC_LAMBDA, builtin_last, + "length", AO_LISP_FUNC_LAMBDA, builtin_length, "quote", AO_LISP_FUNC_NLAMBDA, builtin_quote, "set", AO_LISP_FUNC_LAMBDA, builtin_set, "setq", AO_LISP_FUNC_MACRO, builtin_setq, @@ -61,6 +62,9 @@ struct builtin_func funcs[] = { ">", AO_LISP_FUNC_LEXPR, builtin_greater, "<=", AO_LISP_FUNC_LEXPR, builtin_less_equal, ">=", AO_LISP_FUNC_LEXPR, builtin_greater_equal, + "pack", AO_LISP_FUNC_LAMBDA, builtin_pack, + "unpack", AO_LISP_FUNC_LAMBDA, builtin_unpack, + "flush", AO_LISP_FUNC_LAMBDA, builtin_flush, "delay", AO_LISP_FUNC_LAMBDA, builtin_delay, "led", AO_LISP_FUNC_LEXPR, builtin_led, }; diff --git a/src/lisp/ao_lisp_os.h b/src/lisp/ao_lisp_os.h index 55ffed50..b7bf7a2c 100644 --- a/src/lisp/ao_lisp_os.h +++ b/src/lisp/ao_lisp_os.h @@ -27,6 +27,11 @@ ao_lisp_getc() { return getchar(); } +static inline void +ao_lisp_os_flush() { + fflush(stdout); +} + static inline void ao_lisp_abort(void) { diff --git a/src/lisp/ao_lisp_string.c b/src/lisp/ao_lisp_string.c index 0064064c..9ee1a7dd 100644 --- a/src/lisp/ao_lisp_string.c +++ b/src/lisp/ao_lisp_string.c @@ -34,6 +34,12 @@ static void string_move(void *addr) (void) addr; } +const struct ao_lisp_type ao_lisp_string_type = { + .mark = string_mark, + .size = string_size, + .move = string_move, +}; + char * ao_lisp_string_new(int len) { char *a = ao_lisp_alloc(len + 1); @@ -68,11 +74,47 @@ ao_lisp_string_cat(char *a, char *b) return r; } -const struct ao_lisp_type ao_lisp_string_type = { - .mark = string_mark, - .size = string_size, - .move = string_move, -}; +ao_poly +ao_lisp_string_pack(struct ao_lisp_cons *cons) +{ + int len = ao_lisp_cons_length(cons); + char *r = ao_lisp_alloc(len + 1); + char *s = r; + + while (cons) { + if (ao_lisp_poly_type(cons->car) != AO_LISP_INT) + return ao_lisp_error(AO_LISP_INVALID, "non-int passed to pack"); + *s++ = ao_lisp_poly_int(cons->car); + cons = ao_lisp_poly_cons(cons->cdr); + } + *s++ = 0; + return ao_lisp_string_poly(r); +} + +ao_poly +ao_lisp_string_unpack(char *a) +{ + struct ao_lisp_cons *cons = NULL, *tail = NULL; + int c; + + ao_lisp_root_add(&ao_lisp_cons_type, &cons); + ao_lisp_root_add(&ao_lisp_cons_type, &tail); + while ((c = *a++)) { + struct ao_lisp_cons *n = ao_lisp_cons_cons(ao_lisp_int_poly(c), NULL); + if (!n) { + cons = NULL; + break; + } + if (tail) + tail->cdr = ao_lisp_cons_poly(n); + else + cons = n; + tail = n; + } + ao_lisp_root_clear(&cons); + ao_lisp_root_clear(&tail); + return ao_lisp_cons_poly(cons); +} void ao_lisp_string_print(ao_poly p) diff --git a/src/test/ao_lisp_os.h b/src/test/ao_lisp_os.h index 19bd4f64..c979697e 100644 --- a/src/test/ao_lisp_os.h +++ b/src/test/ao_lisp_os.h @@ -24,6 +24,11 @@ extern int ao_lisp_getc(void); +static inline void +ao_lisp_os_flush() { + fflush(stdout); +} + static inline void ao_lisp_abort(void) { -- cgit v1.2.3 From 974717eb9dad105c9897ee24f953d98d57eaec77 Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Tue, 15 Nov 2016 09:55:22 -0800 Subject: altos/lisp: Evaluate macros once, then smash them into place This assumes that macros are all pure functions, which should be true for syntactic macros. Signed-off-by: Keith Packard --- src/lisp/Makefile | 5 +- src/lisp/ao_lisp.h | 17 +-- src/lisp/ao_lisp_builtin.c | 2 + src/lisp/ao_lisp_const.lisp | 24 ++-- src/lisp/ao_lisp_eval.c | 23 +++- src/lisp/ao_lisp_make_const.c | 263 ++++++++++++++++++++++++++++++++---------- src/lisp/ao_lisp_os.h | 7 +- 7 files changed, 253 insertions(+), 88 deletions(-) (limited to 'src/lisp/ao_lisp_os.h') diff --git a/src/lisp/Makefile b/src/lisp/Makefile index dac11f66..b06e10dd 100644 --- a/src/lisp/Makefile +++ b/src/lisp/Makefile @@ -4,7 +4,7 @@ clean: rm -f ao_lisp_const.h $(OBJS) ao_lisp_make_const ao_lisp_const.h: ao_lisp_const.lisp ao_lisp_make_const - ./ao_lisp_make_const < ao_lisp_const.lisp > $@ + ./ao_lisp_make_const -o $@ ao_lisp_const.lisp SRCS=\ ao_lisp_make_const.c\ @@ -25,10 +25,11 @@ SRCS=\ OBJS=$(SRCS:.c=.o) -CFLAGS=-DAO_LISP_MAKE_CONST -O0 -g -I. +CFLAGS=-DAO_LISP_MAKE_CONST -O0 -g -I. -Wall -Wextra HDRS=\ ao_lisp.h \ + ao_lisp_os.h \ ao_lisp_read.h ao_lisp_make_const: $(OBJS) diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index efd13cf5..2db4914f 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -173,14 +173,15 @@ ao_lisp_frame_poly(struct ao_lisp_frame *frame) { enum eval_state { eval_sexpr, /* Evaluate an sexpr */ - eval_val, - eval_formal, - eval_exec, - eval_cond, - eval_cond_test, - eval_progn, - eval_while, - eval_while_test, + eval_val, /* Value computed */ + eval_formal, /* Formal computed */ + eval_exec, /* Start a lambda evaluation */ + eval_cond, /* Start next cond clause */ + eval_cond_test, /* Check cond condition */ + eval_progn, /* Start next progn entry */ + eval_while, /* Start while condition */ + eval_while_test, /* Check while condition */ + eval_macro, /* Finished with macro generation */ }; struct ao_lisp_stack { diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c index ebc69f77..e4b7ef52 100644 --- a/src/lisp/ao_lisp_builtin.c +++ b/src/lisp/ao_lisp_builtin.c @@ -41,9 +41,11 @@ 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 "???"; } char *ao_lisp_args_name(uint8_t args) { + (void) args; return "???"; } #else diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp index c6f50e34..9d8af588 100644 --- a/src/lisp/ao_lisp_const.lisp +++ b/src/lisp/ao_lisp_const.lisp @@ -9,10 +9,6 @@ ;(setq progn (lexpr (l) (last l))) - ; simple math operators - -(setq 1+ (lambda (x) (+ x 1))) -(setq 1- (lambda (x) (- x 1))) ; ; Define a variable without returning the value @@ -64,7 +60,7 @@ ; make the list of names in the let ; - (set 'make-names (lambda (vars) + (setq make-names (lambda (vars) (cond (vars (cons (car (car vars)) (make-names (cdr vars)))) @@ -77,7 +73,7 @@ ; pre-pended to the ; expressions to evaluate ; - (set 'make-exprs (lambda (vars exprs) + (setq make-exprs (lambda (vars exprs) (progn (cond (vars (cons (list set @@ -94,13 +90,13 @@ ) ) ) - (set 'exprs (make-exprs vars exprs)) + (setq exprs (make-exprs vars exprs)) ; ; the parameters to the lambda is a list ; of nils of the right length ; - (set 'make-nils (lambda (vars) + (setq make-nils (lambda (vars) (cond (vars (cons nil (make-nils (cdr vars)))) ) ) @@ -108,7 +104,6 @@ ; ; build the lambda. ; - (set 'last-let-value (cons (list 'lambda @@ -120,8 +115,6 @@ (make-nils vars) ) ) - ) - ) (car let-param) (cdr let-param) @@ -158,3 +151,12 @@ ) ) ) + + ; simple math operators + ; + ; Do these last to run defun + ; at least once so the let macro + ; is resolved + +(defun 1+ (x) (+ x 1)) +(defun 1- (x) (- x 1)) diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c index 5cc1b75a..3af56796 100644 --- a/src/lisp/ao_lisp_eval.c +++ b/src/lisp/ao_lisp_eval.c @@ -298,7 +298,7 @@ ao_lisp_eval_formal(void) break; case AO_LISP_FUNC_MACRO: /* Evaluate the result once more */ - ao_lisp_stack->state = eval_sexpr; + ao_lisp_stack->state = eval_macro; if (!ao_lisp_stack_push()) return 0; @@ -308,7 +308,6 @@ ao_lisp_eval_formal(void) prev = ao_lisp_poly_stack(ao_lisp_stack->prev); ao_lisp_stack->state = eval_sexpr; ao_lisp_stack->sexprs = prev->sexprs; - prev->sexprs = AO_LISP_NIL; DBGI(".. start macro\n"); DBGI(".. sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n"); @@ -555,6 +554,25 @@ ao_lisp_eval_while_test(void) return 1; } +/* + * Replace the original sexpr with the macro expansion, then + * execute that + */ +static int +ao_lisp_eval_macro(void) +{ + DBGI("macro: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n"); + + if (ao_lisp_poly_type(ao_lisp_v) == AO_LISP_CONS) { + *ao_lisp_poly_cons(ao_lisp_stack->sexprs) = *ao_lisp_poly_cons(ao_lisp_v); + ao_lisp_v = ao_lisp_stack->sexprs; + DBGI("sexprs rewritten to: "); DBG_POLY(ao_lisp_v); DBG("\n"); + } + ao_lisp_stack->sexprs = AO_LISP_NIL; + ao_lisp_stack->state = eval_sexpr; + return 1; +} + static int (*const evals[])(void) = { [eval_sexpr] = ao_lisp_eval_sexpr, [eval_val] = ao_lisp_eval_val, @@ -565,6 +583,7 @@ static int (*const evals[])(void) = { [eval_progn] = ao_lisp_eval_progn, [eval_while] = ao_lisp_eval_while, [eval_while_test] = ao_lisp_eval_while_test, + [eval_macro] = ao_lisp_eval_macro, }; /* diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c index 178b041e..ae53bd35 100644 --- a/src/lisp/ao_lisp_make_const.c +++ b/src/lisp/ao_lisp_make_const.c @@ -15,6 +15,8 @@ #include "ao_lisp.h" #include #include +#include +#include static struct ao_lisp_builtin * ao_lisp_make_builtin(enum ao_lisp_builtin_id func, int args) { @@ -33,42 +35,42 @@ struct builtin_func { }; struct builtin_func funcs[] = { - "eval", AO_LISP_FUNC_F_LAMBDA, builtin_eval, - "read", AO_LISP_FUNC_F_LAMBDA, builtin_read, - "lambda", AO_LISP_FUNC_NLAMBDA, builtin_lambda, - "lexpr", AO_LISP_FUNC_NLAMBDA, builtin_lexpr, - "nlambda", AO_LISP_FUNC_NLAMBDA, builtin_nlambda, - "macro", AO_LISP_FUNC_NLAMBDA, builtin_macro, - "car", AO_LISP_FUNC_F_LAMBDA, builtin_car, - "cdr", AO_LISP_FUNC_F_LAMBDA, builtin_cdr, - "cons", AO_LISP_FUNC_F_LAMBDA, builtin_cons, - "last", AO_LISP_FUNC_F_LAMBDA, builtin_last, - "length", AO_LISP_FUNC_F_LAMBDA, builtin_length, - "quote", AO_LISP_FUNC_NLAMBDA, builtin_quote, - "set", AO_LISP_FUNC_F_LAMBDA, builtin_set, - "setq", AO_LISP_FUNC_MACRO, builtin_setq, - "cond", AO_LISP_FUNC_NLAMBDA, builtin_cond, - "progn", AO_LISP_FUNC_NLAMBDA, builtin_progn, - "while", AO_LISP_FUNC_NLAMBDA, builtin_while, - "print", AO_LISP_FUNC_F_LEXPR, builtin_print, - "patom", AO_LISP_FUNC_F_LEXPR, builtin_patom, - "+", AO_LISP_FUNC_F_LEXPR, builtin_plus, - "-", AO_LISP_FUNC_F_LEXPR, builtin_minus, - "*", AO_LISP_FUNC_F_LEXPR, builtin_times, - "/", AO_LISP_FUNC_F_LEXPR, builtin_divide, - "%", AO_LISP_FUNC_F_LEXPR, builtin_mod, - "=", AO_LISP_FUNC_F_LEXPR, builtin_equal, - "<", AO_LISP_FUNC_F_LEXPR, builtin_less, - ">", AO_LISP_FUNC_F_LEXPR, builtin_greater, - "<=", AO_LISP_FUNC_F_LEXPR, builtin_less_equal, - ">=", AO_LISP_FUNC_F_LEXPR, builtin_greater_equal, - "pack", AO_LISP_FUNC_F_LAMBDA, builtin_pack, - "unpack", AO_LISP_FUNC_F_LAMBDA, builtin_unpack, - "flush", AO_LISP_FUNC_F_LAMBDA, builtin_flush, - "delay", AO_LISP_FUNC_F_LAMBDA, builtin_delay, - "led", AO_LISP_FUNC_F_LEXPR, builtin_led, - "save", AO_LISP_FUNC_F_LAMBDA, builtin_save, - "restore", AO_LISP_FUNC_F_LAMBDA, builtin_restore, + { .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 }, }; #define N_FUNC (sizeof funcs / sizeof funcs[0]) @@ -113,18 +115,127 @@ ao_fec_crc(const uint8_t *bytes, uint8_t len) return crc; } +int +ao_is_macro(ao_poly p) +{ + struct ao_lisp_builtin *builtin; + struct ao_lisp_lambda *lambda; + +// printf ("macro scanning "); ao_lisp_poly_print(p); printf("\n"); + switch (ao_lisp_poly_type(p)) { + case AO_LISP_ATOM: + return ao_is_macro(ao_lisp_atom_get(p)); + case AO_LISP_BUILTIN: + builtin = ao_lisp_poly_builtin(p); + if ((builtin->args & AO_LISP_FUNC_MASK) == AO_LISP_FUNC_MACRO) + return 1; + return 0; + case AO_LISP_LAMBDA: + lambda = ao_lisp_poly_lambda(p); + if (lambda->args == AO_LISP_FUNC_MACRO) + return 1; + return 0; + default: + return 0; + } +} + +ao_poly +ao_has_macro(ao_poly p) +{ + struct ao_lisp_cons *cons; + struct ao_lisp_lambda *lambda; + ao_poly m; + + if (p == AO_LISP_NIL) + return AO_LISP_NIL; + + switch (ao_lisp_poly_type(p)) { + case AO_LISP_LAMBDA: + lambda = ao_lisp_poly_lambda(p); + return ao_has_macro(lambda->code); + case AO_LISP_CONS: + cons = ao_lisp_poly_cons(p); + if (ao_is_macro(cons->car)) + return cons->car; + + cons = ao_lisp_poly_cons(cons->cdr); + while (cons) { + m = ao_has_macro(cons->car); + if (m) + return m; + cons = ao_lisp_poly_cons(cons->cdr); + } + return AO_LISP_NIL; + + default: + return AO_LISP_NIL; + } +} + +int +ao_lisp_read_eval_abort(void) +{ + ao_poly in, out = AO_LISP_NIL; + for(;;) { + in = ao_lisp_read(); + if (in == _ao_lisp_atom_eof) + break; + out = ao_lisp_eval(in); + if (ao_lisp_exception) + return 0; + ao_lisp_poly_print(out); + putchar ('\n'); + } + return 1; +} + +static FILE *in; +static FILE *out; + +int +ao_lisp_getc(void) +{ + return getc(in); +} + +static const struct option options[] = { + { .name = "out", .has_arg = 1, .val = 'o' }, + { 0, 0, 0, 0 } +}; + +static void usage(char *program) +{ + fprintf(stderr, "usage: %s [--out=] [input]\n", program); + exit(1); +} + int main(int argc, char **argv) { - int f, o, i; - ao_poly sexpr, val; + int f, o; + ao_poly val; struct ao_lisp_atom *a; struct ao_lisp_builtin *b; int in_atom; + char *out_name; + int c; + + in = stdin; + out = stdout; + + while ((c = getopt_long(argc, argv, "o:", options, NULL)) != -1) { + switch (c) { + case 'o': + out_name = optarg; + break; + default: + usage(argv[0]); + break; + } + } - printf("/*\n"); - printf(" * Generated file, do not edit\n"); - for (f = 0; f < N_FUNC; f++) { + 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); ao_lisp_atom_set(ao_lisp_atom_poly(a), @@ -143,47 +254,79 @@ main(int argc, char **argv) ao_lisp_atom_set(ao_lisp_atom_poly(a), ao_lisp_atom_poly(a)); - ao_lisp_read_eval_print(); + if (argv[optind]){ + in = fopen(argv[optind], "r"); + if (!in) { + perror(argv[optind]); + exit(1); + } + } + if (!ao_lisp_read_eval_abort()) { + fprintf(stderr, "eval failed\n"); + exit(1); + } /* Reduce to referenced values */ ao_lisp_collect(); - printf(" */\n"); - printf("#define AO_LISP_POOL_CONST %d\n", ao_lisp_top); - printf("extern const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));\n"); - printf("#define ao_builtin_atoms 0x%04x\n", ao_lisp_atom_poly(ao_lisp_atoms)); - printf("#define ao_builtin_frame 0x%04x\n", ao_lisp_frame_poly(ao_lisp_frame_global)); - printf("#define ao_lisp_const_checksum ((uint16_t) 0x%04x)\n", ao_fec_crc(ao_lisp_const, ao_lisp_top)); + for (f = 0; f < ao_lisp_frame_global->num; f++) { + val = ao_has_macro(ao_lisp_frame_global->vals[f].val); + if (val != AO_LISP_NIL) { + printf("error: function %s contains unresolved macro: ", + ao_lisp_poly_atom(ao_lisp_frame_global->vals[f].atom)->name); + ao_lisp_poly_print(val); + printf(stderr, "\n"); + exit(1); + } + } + + if (out_name) { + out = fopen(out_name, "w"); + if (!out) { + perror(out_name); + exit(1); + } + } + + fprintf(out, "/* Generated file, do not edit */\n\n"); + + fprintf(out, "#define AO_LISP_POOL_CONST %d\n", ao_lisp_top); + fprintf(out, "extern const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));\n"); + fprintf(out, "#define ao_builtin_atoms 0x%04x\n", ao_lisp_atom_poly(ao_lisp_atoms)); + 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)); + for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next)) { char *n = a->name, c; - printf ("#define _ao_lisp_atom_"); + fprintf(out, "#define _ao_lisp_atom_"); while ((c = *n++)) { if (isalnum(c)) - printf("%c", c); + fprintf(out, "%c", c); else - printf("%02x", c); + fprintf(out, "%02x", c); } - printf(" 0x%04x\n", ao_lisp_atom_poly(a)); + fprintf(out, " 0x%04x\n", ao_lisp_atom_poly(a)); } - printf("#ifdef AO_LISP_CONST_BITS\n"); - printf("const uint8_t ao_lisp_const[] = {"); + fprintf(out, "#ifdef AO_LISP_CONST_BITS\n"); + fprintf(out, "const uint8_t ao_lisp_const[] = {"); for (o = 0; o < ao_lisp_top; o++) { uint8_t c; if ((o & 0xf) == 0) - printf("\n\t"); + fprintf(out, "\n\t"); else - printf(" "); + fprintf(out, " "); c = ao_lisp_const[o]; if (!in_atom) in_atom = is_atom(o); if (in_atom) { - printf (" '%c',", c); + fprintf(out, " '%c',", c); in_atom--; } else { - printf("0x%02x,", c); + fprintf(out, "0x%02x,", c); } } - printf("\n};\n"); - printf("#endif /* AO_LISP_CONST_BITS */\n"); + fprintf(out, "\n};\n"); + fprintf(out, "#endif /* AO_LISP_CONST_BITS */\n"); + exit(0); } diff --git a/src/lisp/ao_lisp_os.h b/src/lisp/ao_lisp_os.h index b7bf7a2c..5fa3686b 100644 --- a/src/lisp/ao_lisp_os.h +++ b/src/lisp/ao_lisp_os.h @@ -22,13 +22,10 @@ #include #include -static inline int -ao_lisp_getc() { - return getchar(); -} +extern int ao_lisp_getc(void); static inline void -ao_lisp_os_flush() { +ao_lisp_os_flush(void) { fflush(stdout); } -- cgit v1.2.3