From 417161dbb36323b5a6572859dedad02ca92fc65c Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Wed, 9 Nov 2016 16:22:43 -0800 Subject: [PATCH] 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/lambdakey-v1.0/Makefile | 1 + src/lambdakey-v1.0/ao_lisp_os.h | 56 ++++++++++ src/lambdakey-v1.0/ao_pins.h | 2 +- src/lisp/Makefile | 3 +- src/lisp/ao_lisp.h | 19 ++-- src/lisp/ao_lisp_builtin.c | 36 +++++- src/lisp/ao_lisp_const.lisp | 35 +++++- src/lisp/ao_lisp_lambda.c | 188 ++++++++++++++++++++++++++++++++ src/lisp/ao_lisp_make_const.c | 16 +-- src/lisp/ao_lisp_mem.c | 8 +- src/lisp/ao_lisp_os.h | 51 +++++++++ src/lisp/ao_lisp_poly.c | 85 +++++++++++---- src/lisp/ao_lisp_prim.c | 86 --------------- src/lisp/ao_lisp_read.c | 14 +-- src/test/Makefile | 5 +- 15 files changed, 442 insertions(+), 163 deletions(-) create mode 100644 src/lambdakey-v1.0/ao_lisp_os.h create mode 100644 src/lisp/ao_lisp_lambda.c create mode 100644 src/lisp/ao_lisp_os.h delete mode 100644 src/lisp/ao_lisp_prim.c diff --git a/src/lambdakey-v1.0/Makefile b/src/lambdakey-v1.0/Makefile index 4db0e290..ef03527e 100644 --- a/src/lambdakey-v1.0/Makefile +++ b/src/lambdakey-v1.0/Makefile @@ -47,6 +47,7 @@ ALTOS_SRC = \ ao_lisp_rep.c \ ao_lisp_frame.c \ ao_lisp_error.c \ + ao_lisp_lambda.c \ ao_exti_stm.c PRODUCT=LambdaKey-v1.0 diff --git a/src/lambdakey-v1.0/ao_lisp_os.h b/src/lambdakey-v1.0/ao_lisp_os.h new file mode 100644 index 00000000..df158f6a --- /dev/null +++ b/src/lambdakey-v1.0/ao_lisp_os.h @@ -0,0 +1,56 @@ +/* + * 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 "ao.h" + +static inline int +ao_lisp_getc() { + static uint8_t at_eol; + int c; + + if (at_eol) { + ao_cmd_readline(); + at_eol = 0; + } + c = ao_cmd_lex(); + if (c == '\n') + at_eol = 1; + return c; +} + +static inline void +ao_lisp_abort(void) +{ + ao_panic(1); +} + +static inline void +ao_lisp_os_led(int led) +{ + ao_led_set(led); +} + +static inline void +ao_lisp_os_delay(int delay) +{ + ao_delay(AO_MS_TO_TICKS(delay)); +} + +#endif diff --git a/src/lambdakey-v1.0/ao_pins.h b/src/lambdakey-v1.0/ao_pins.h index 5a840f13..b8429c55 100644 --- a/src/lambdakey-v1.0/ao_pins.h +++ b/src/lambdakey-v1.0/ao_pins.h @@ -25,7 +25,7 @@ #define AO_LED_RED (1 << LED_PIN_RED) #define AO_LED_PANIC AO_LED_RED #define AO_CMD_LEN 128 -#define AO_LISP_POOL 2560 +#define AO_LISP_POOL 3072 #define AO_STACK_SIZE 1024 #define LEDS_AVAILABLE (AO_LED_RED) diff --git a/src/lisp/Makefile b/src/lisp/Makefile index f7edbe41..9c99f05c 100644 --- a/src/lisp/Makefile +++ b/src/lisp/Makefile @@ -14,7 +14,6 @@ SRCS=\ ao_lisp_atom.c \ ao_lisp_int.c \ ao_lisp_poly.c \ - ao_lisp_prim.c \ ao_lisp_builtin.c \ ao_lisp_read.c \ ao_lisp_frame.c \ @@ -24,7 +23,7 @@ SRCS=\ OBJS=$(SRCS:.c=.o) -CFLAGS=-DAO_LISP_MAKE_CONST -O0 -g +CFLAGS=-DAO_LISP_MAKE_CONST -O0 -g -I. HDRS=\ ao_lisp.h \ diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index 82ba5a20..de55b307 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -15,17 +15,10 @@ #ifndef _AO_LISP_H_ #define _AO_LISP_H_ -#include - -#if !defined(AO_LISP_TEST) && !defined(AO_LISP_MAKE_CONST) -#include -#define AO_LISP_ALTOS 1 -#define abort() ao_panic(1) -#endif - #include #include -#include +//#include +#include #ifdef AO_LISP_MAKE_CONST #define AO_LISP_POOL_CONST 16384 @@ -45,6 +38,8 @@ extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST]; #define _ao_lisp_atom_last _atom("last") #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") #else #include "ao_lisp_const.h" #ifndef AO_LISP_POOL @@ -99,7 +94,7 @@ ao_lisp_is_const(ao_poly poly) { static inline void * ao_lisp_ref(ao_poly poly) { if (poly == 0xBEEF) - abort(); + ao_lisp_abort(); if (poly == AO_LISP_NIL) return NULL; if (poly & AO_LISP_CONST) @@ -227,12 +222,14 @@ enum ao_lisp_builtin_id { builtin_greater, builtin_less_equal, builtin_greater_equal, + builtin_delay, + builtin_led, _builtin_last }; typedef ao_poly (*ao_lisp_func_t)(struct ao_lisp_cons *cons); -extern ao_lisp_func_t ao_lisp_builtins[]; +extern const ao_lisp_func_t ao_lisp_builtins[]; static inline ao_lisp_func_t ao_lisp_func(struct ao_lisp_builtin *b) diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c index c38ba165..5bd180e2 100644 --- a/src/lisp/ao_lisp_builtin.c +++ b/src/lisp/ao_lisp_builtin.c @@ -72,11 +72,13 @@ 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_delay] = _ao_lisp_atom_delay, + [builtin_led] = _ao_lisp_atom_led, }; static char * ao_lisp_builtin_name(enum ao_lisp_builtin_id b) { - if (0 <= b && b < _builtin_last) + if (b < _builtin_last) return ao_lisp_poly_atom(builtin_names[b])->name; return "???"; } @@ -448,7 +450,33 @@ ao_lisp_greater_equal(struct ao_lisp_cons *cons) return ao_lisp_compare(cons, builtin_greater_equal); } -ao_lisp_func_t ao_lisp_builtins[] = { +ao_poly +ao_lisp_led(struct ao_lisp_cons *cons) +{ + ao_poly led; + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1)) + return AO_LISP_NIL; + if (!ao_lisp_check_argt(_ao_lisp_atom_led, cons, 0, AO_LISP_INT, 0)) + return AO_LISP_NIL; + led = ao_lisp_arg(cons, 0); + ao_lisp_os_led(ao_lisp_poly_int(led)); + return led; +} + +ao_poly +ao_lisp_delay(struct ao_lisp_cons *cons) +{ + ao_poly delay; + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1)) + return AO_LISP_NIL; + if (!ao_lisp_check_argt(_ao_lisp_atom_led, cons, 0, AO_LISP_INT, 0)) + return AO_LISP_NIL; + delay = ao_lisp_arg(cons, 0); + ao_lisp_os_delay(ao_lisp_poly_int(delay)); + return delay; +} + +const ao_lisp_func_t ao_lisp_builtins[] = { [builtin_lambda] = ao_lisp_lambda, [builtin_lexpr] = ao_lisp_lexpr, [builtin_nlambda] = ao_lisp_nlambda, @@ -472,6 +500,8 @@ ao_lisp_func_t ao_lisp_builtins[] = { [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_greater_equal] = ao_lisp_greater_equal, + [builtin_led] = ao_lisp_led, + [builtin_delay] = ao_lisp_delay, }; diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp index 621fefc4..08a511d9 100644 --- a/src/lisp/ao_lisp_const.lisp +++ b/src/lisp/ao_lisp_const.lisp @@ -14,9 +14,13 @@ (setq 1+ (lambda (x) (+ x 1))) (setq 1- (lambda (x) (- x 1))) - ; define a variable without returning the value + ; + ; Define a variable without returning the value + ; Useful when defining functions to avoid + ; having lots of output generated + ; -(set 'def (macro (def-param) +(setq def (macro (def-param) (list 'progn (list @@ -127,3 +131,30 @@ ) ) ) + + ; + ; A slightly more convenient form + ; for defining lambdas. + ; + ; (defun () s-exprs) + ; + +(def defun (macro (defun-param) + (let ((name (car defun-param)) + (args (cadr defun-param)) + (exprs (cdr (cdr defun-param)))) + (list + def + name + (list + 'lambda + args + (cond ((cdr exprs) + (cons progn exprs)) + ((car exprs)) + ) + ) + ) + ) + ) + ) diff --git a/src/lisp/ao_lisp_lambda.c b/src/lisp/ao_lisp_lambda.c new file mode 100644 index 00000000..cc5af4bc --- /dev/null +++ b/src/lisp/ao_lisp_lambda.c @@ -0,0 +1,188 @@ +/* + * 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. + */ + +#define DBG_EVAL 0 +#include "ao_lisp.h" + +int +lambda_size(void *addr) +{ + (void) addr; + return sizeof (struct ao_lisp_lambda); +} + +void +lambda_mark(void *addr) +{ + struct ao_lisp_lambda *lambda = addr; + + ao_lisp_poly_mark(lambda->code, 0); + ao_lisp_poly_mark(lambda->frame, 0); +} + +void +lambda_move(void *addr) +{ + struct ao_lisp_lambda *lambda = addr; + + ao_lisp_poly_move(&lambda->code, 0); + ao_lisp_poly_move(&lambda->frame, 0); +} + +const struct ao_lisp_type ao_lisp_lambda_type = { + .size = lambda_size, + .mark = lambda_mark, + .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) +{ + struct ao_lisp_lambda *lambda = ao_lisp_poly_lambda(poly); + struct ao_lisp_cons *cons = ao_lisp_poly_cons(lambda->code); + + printf("("); + printf("%s", ao_lisp_args_name(lambda->args)); + while (cons) { + printf(" "); + ao_lisp_poly_print(cons->car); + cons = ao_lisp_poly_cons(cons->cdr); + } + printf(")"); +} + +ao_poly +ao_lisp_lambda_alloc(struct ao_lisp_cons *code, int args) +{ + struct ao_lisp_lambda *lambda = ao_lisp_alloc(sizeof (struct ao_lisp_lambda)); + struct ao_lisp_cons *arg; + int f; + + if (!lambda) + return AO_LISP_NIL; + + if (!ao_lisp_check_argc(_ao_lisp_atom_lambda, code, 2, 2)) + return AO_LISP_NIL; + if (!ao_lisp_check_argt(_ao_lisp_atom_lambda, code, 0, AO_LISP_CONS, 1)) + return AO_LISP_NIL; + f = 0; + arg = ao_lisp_poly_cons(ao_lisp_arg(code, 0)); + while (arg) { + if (ao_lisp_poly_type(arg->car) != AO_LISP_ATOM) + return ao_lisp_error(AO_LISP_INVALID, "formal %d is not an atom", f); + arg = ao_lisp_poly_cons(arg->cdr); + f++; + } + + lambda->type = AO_LISP_LAMBDA; + lambda->args = args; + lambda->code = ao_lisp_cons_poly(code); + lambda->frame = ao_lisp_frame_poly(ao_lisp_frame_current); + DBGI("build frame: "); DBG_POLY(lambda->frame); DBG("\n"); + DBG_STACK(); + return ao_lisp_lambda_poly(lambda); +} + +ao_poly +ao_lisp_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) +{ + return ao_lisp_lambda_alloc(cons, AO_LISP_FUNC_LEXPR); +} + +ao_poly +ao_lisp_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) +{ + return ao_lisp_lambda_alloc(cons, AO_LISP_FUNC_MACRO); +} + +ao_poly +ao_lisp_lambda_eval(struct ao_lisp_lambda *lambda, + struct ao_lisp_cons *cons) +{ + struct ao_lisp_cons *code; + struct ao_lisp_cons *args; + struct ao_lisp_frame *next_frame; + int args_wanted; + int args_provided; + + code = ao_lisp_poly_cons(lambda->code); + DBGI("lambda "); DBG_POLY(ao_lisp_lambda_poly(lambda)); DBG("\n"); + args = ao_lisp_poly_cons(ao_lisp_arg(code, 0)); + + args_wanted = ao_lisp_cons_length(args); + + /* Create a frame to hold the variables + */ + if (lambda->args == AO_LISP_FUNC_LAMBDA) + args_provided = ao_lisp_cons_length(cons) - 1; + else + args_provided = 1; + if (args_wanted != args_provided) + return ao_lisp_error(AO_LISP_INVALID, "need %d args, not %d", args_wanted, args_provided); + next_frame = ao_lisp_frame_new(args_wanted); + switch (lambda->args) { + case AO_LISP_FUNC_LAMBDA: { + int f; + struct ao_lisp_cons *vals = ao_lisp_poly_cons(cons->cdr); + + for (f = 0; f < args_wanted; f++) { + DBGI("bind "); DBG_POLY(args->car); DBG(" = "); DBG_POLY(vals->car); DBG("\n"); + next_frame->vals[f].atom = args->car; + next_frame->vals[f].val = vals->car; + args = ao_lisp_poly_cons(args->cdr); + vals = ao_lisp_poly_cons(vals->cdr); + } + break; + } + case AO_LISP_FUNC_LEXPR: + case AO_LISP_FUNC_NLAMBDA: + case AO_LISP_FUNC_MACRO: + DBGI("bind "); DBG_POLY(args->car); DBG(" = "); DBG_POLY(cons->cdr); DBG("\n"); + next_frame->vals[0].atom = args->car; + next_frame->vals[0].val = cons->cdr; + break; + } + next_frame->next = lambda->frame; + DBGI("eval frame: "); DBG_POLY(ao_lisp_frame_poly(next_frame)); DBG("\n"); + ao_lisp_frame_current = next_frame; + ao_lisp_stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current); + DBG_STACK(); + return ao_lisp_arg(code, 1); +} diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c index 501052b9..6f852f9d 100644 --- a/src/lisp/ao_lisp_make_const.c +++ b/src/lisp/ao_lisp_make_const.c @@ -57,20 +57,12 @@ struct builtin_func funcs[] = { ">", AO_LISP_FUNC_LEXPR, builtin_greater, "<=", AO_LISP_FUNC_LEXPR, builtin_less_equal, ">=", AO_LISP_FUNC_LEXPR, builtin_greater_equal, + "delay", AO_LISP_FUNC_LAMBDA, builtin_delay, + "led", AO_LISP_FUNC_LEXPR, builtin_led, }; #define N_FUNC (sizeof funcs / sizeof funcs[0]) -/* Syntactic atoms */ -char *atoms[] = { - "lambda", - "nlambda", - "lexpr", - "macro" -}; - -#define N_ATOM (sizeof atoms / sizeof atoms[0]) - struct ao_lisp_frame *globals; static int @@ -102,10 +94,6 @@ main(int argc, char **argv) ao_lisp_builtin_poly(b)); } - /* atoms for syntax */ - for (i = 0; i < N_ATOM; i++) - (void) ao_lisp_atom_intern(atoms[i]); - /* boolean constants */ ao_lisp_atom_set(ao_lisp_atom_poly(ao_lisp_atom_intern("nil")), AO_LISP_NIL); diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c index 476843d8..66e09db0 100644 --- a/src/lisp/ao_lisp_mem.c +++ b/src/lisp/ao_lisp_mem.c @@ -331,7 +331,7 @@ ao_lisp_collect(void) move_object(); DBG("\tbusy size %d\n", move_size); if (move_size == 0) - abort(); + ao_lisp_abort(); clear_object(ao_lisp_busy, move_old, move_size); mark_object(ao_lisp_busy, move_new, move_size); if (busy_object(ao_lisp_cons, move_old)) { @@ -431,7 +431,7 @@ ao_lisp_move(const struct ao_lisp_type *type, void **ref) #endif DBG_MOVE("object %d\n", DBG_OFFSET(addr)); if (!AO_LISP_IS_POOL(a)) - abort(); + ao_lisp_abort(); DBG_MOVE_IN(); addr = check_move(addr, size); if (addr != *ref) @@ -495,7 +495,7 @@ ao_lisp_poly_move(ao_poly *ref, uint8_t do_note_cons) type = ao_lisp_other_type(ao_lisp_move_map(ao_lisp_poly_other(p))); if (type >= AO_LISP_NUM_TYPE) - abort(); + ao_lisp_abort(); lisp_type = ao_lisp_types[type]; if (!lisp_type) @@ -601,7 +601,7 @@ ao_lisp_root_add(const struct ao_lisp_type *type, void *addr) return 1; } } - abort(); + ao_lisp_abort(); return 0; } 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 diff --git a/src/lisp/ao_lisp_poly.c b/src/lisp/ao_lisp_poly.c index c6ca0a97..bfd75ae3 100644 --- a/src/lisp/ao_lisp_poly.c +++ b/src/lisp/ao_lisp_poly.c @@ -14,34 +14,73 @@ #include "ao_lisp.h" -/* +#if 0 +#define DBG(...) printf (__VA_ARGS__) +#else +#define DBG(...) +#endif -static const struct ao_lisp_builtin builtin_plus = { - .type = AO_LISP_BUILTIN, - .func = ao_lisp_plus, - .name = "+" +struct ao_lisp_funcs { + void (*print)(ao_poly); + void (*patom)(ao_poly); }; -static const struct ao_lisp_atom atom_plus = { - .type = AO_LISP_ATOM, - .val = AO_LISP_OTHER_POLY(&builtin_plus), - .next = AO_LISP_ATOM_CONST, - .name = "plus" +static const struct ao_lisp_funcs ao_lisp_funcs[AO_LISP_NUM_TYPE] = { + [AO_LISP_CONS] = { + .print = ao_lisp_cons_print, + .patom = ao_lisp_cons_patom, + }, + [AO_LISP_STRING] = { + .print = ao_lisp_string_print, + .patom = ao_lisp_string_patom, + }, + [AO_LISP_INT] = { + .print = ao_lisp_int_print, + .patom = ao_lisp_int_print, + }, + [AO_LISP_ATOM] = { + .print = ao_lisp_atom_print, + .patom = ao_lisp_atom_print, + }, + [AO_LISP_BUILTIN] = { + .print = ao_lisp_builtin_print, + .patom = ao_lisp_builtin_print, + }, + [AO_LISP_FRAME] = { + .print = ao_lisp_frame_print, + .patom = ao_lisp_frame_print, + }, + [AO_LISP_LAMBDA] = { + .print = ao_lisp_lambda_print, + .patom = ao_lisp_lambda_print, + }, }; -static const struct ao_lisp_builtin builtin_minus = { - .type = AO_LISP_BUILTIN, - .func = ao_lisp_minus -}; +static const struct ao_lisp_funcs * +funcs(ao_poly p) +{ + uint8_t type = ao_lisp_poly_type(p); -static const struct ao_lisp_builtin builtin_times = { - .type = AO_LISP_BUILTIN, - .func = ao_lisp_times -}; + if (type < AO_LISP_NUM_TYPE) + return &ao_lisp_funcs[type]; + return NULL; +} +void +ao_lisp_poly_print(ao_poly p) +{ + const struct ao_lisp_funcs *f = funcs(p); + + if (f && f->print) + f->print(p); +} + +void +ao_lisp_poly_patom(ao_poly p) +{ + const struct ao_lisp_funcs *f = funcs(p); + + if (f && f->patom) + f->patom(p); +} -const struct ao_lisp_atom const *ao_lisp_builtins[] = { - &atom_plus, - 0 -}; -*/ diff --git a/src/lisp/ao_lisp_prim.c b/src/lisp/ao_lisp_prim.c deleted file mode 100644 index bfd75ae3..00000000 --- a/src/lisp/ao_lisp_prim.c +++ /dev/null @@ -1,86 +0,0 @@ -/* - * 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, 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" - -#if 0 -#define DBG(...) printf (__VA_ARGS__) -#else -#define DBG(...) -#endif - -struct ao_lisp_funcs { - void (*print)(ao_poly); - void (*patom)(ao_poly); -}; - -static const struct ao_lisp_funcs ao_lisp_funcs[AO_LISP_NUM_TYPE] = { - [AO_LISP_CONS] = { - .print = ao_lisp_cons_print, - .patom = ao_lisp_cons_patom, - }, - [AO_LISP_STRING] = { - .print = ao_lisp_string_print, - .patom = ao_lisp_string_patom, - }, - [AO_LISP_INT] = { - .print = ao_lisp_int_print, - .patom = ao_lisp_int_print, - }, - [AO_LISP_ATOM] = { - .print = ao_lisp_atom_print, - .patom = ao_lisp_atom_print, - }, - [AO_LISP_BUILTIN] = { - .print = ao_lisp_builtin_print, - .patom = ao_lisp_builtin_print, - }, - [AO_LISP_FRAME] = { - .print = ao_lisp_frame_print, - .patom = ao_lisp_frame_print, - }, - [AO_LISP_LAMBDA] = { - .print = ao_lisp_lambda_print, - .patom = ao_lisp_lambda_print, - }, -}; - -static const struct ao_lisp_funcs * -funcs(ao_poly p) -{ - uint8_t type = ao_lisp_poly_type(p); - - if (type < AO_LISP_NUM_TYPE) - return &ao_lisp_funcs[type]; - return NULL; -} - -void -ao_lisp_poly_print(ao_poly p) -{ - const struct ao_lisp_funcs *f = funcs(p); - - if (f && f->print) - f->print(p); -} - -void -ao_lisp_poly_patom(ao_poly p) -{ - const struct ao_lisp_funcs *f = funcs(p); - - if (f && f->patom) - f->patom(p); -} - diff --git a/src/lisp/ao_lisp_read.c b/src/lisp/ao_lisp_read.c index bc1eb36b..3a2ef7f1 100644 --- a/src/lisp/ao_lisp_read.c +++ b/src/lisp/ao_lisp_read.c @@ -156,19 +156,7 @@ lex_get() c = lex_unget_c; lex_unget_c = 0; } else { -#if AO_LISP_ALTOS - static uint8_t at_eol; - - if (at_eol) { - ao_cmd_readline(); - at_eol = 0; - } - c = ao_cmd_lex(); - if (c == '\n') - at_eol = 1; -#else - c = getchar(); -#endif + c = ao_lisp_getc(); } return c; } diff --git a/src/test/Makefile b/src/test/Makefile index 7395e832..d6777090 100644 --- a/src/test/Makefile +++ b/src/test/Makefile @@ -88,11 +88,8 @@ ao_ms5607_convert_test: ao_ms5607_convert_test.c ao_ms5607_convert_8051.c ao_int ao_quaternion_test: ao_quaternion_test.c ao_quaternion.h cc $(CFLAGS) -o $@ ao_quaternion_test.c -lm - -#AO_LISP_OBJS = ao_lisp_test.o ao_lisp_mem.o ao_lisp_lex.o ao_lisp_cons.o ao_lisp_string.o ao_lisp_atom.o ao_lisp_int.o ao_lisp_prim.o ao_lisp_eval.o ao_lisp_poly.o ao_lisp_builtin.o ao_lisp_read.o - AO_LISP_OBJS = ao_lisp_test.o ao_lisp_mem.o ao_lisp_cons.o ao_lisp_string.o \ - ao_lisp_atom.o ao_lisp_int.o ao_lisp_prim.o ao_lisp_eval.o ao_lisp_poly.o \ + ao_lisp_atom.o ao_lisp_int.o ao_lisp_eval.o ao_lisp_poly.o \ ao_lisp_builtin.o ao_lisp_read.o ao_lisp_rep.o ao_lisp_frame.o \ ao_lisp_lambda.o ao_lisp_error.o -- 2.30.2