From cf5729a0bae51172f12fc9ec4339d4e975a45fcc Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Fri, 17 Nov 2017 23:23:50 -0800 Subject: [PATCH] altos/lisp: Finish first pass through r7rs * print -> write, patom -> display * Add read-char, write-char * Add exit, current-jiffy, current-second, jiffies-per-second * Add for-each and string-for-each * Avoid duplicate builtins with different atoms Signed-off-by: Keith Packard --- src/lisp/README | 11 ++++++ src/lisp/ao_lisp.h | 33 ++++++++-------- src/lisp/ao_lisp_atom.c | 2 +- src/lisp/ao_lisp_bool.c | 2 +- src/lisp/ao_lisp_builtin.c | 74 +++++++++++++++++++++++++++++++---- src/lisp/ao_lisp_builtin.txt | 10 ++++- src/lisp/ao_lisp_cons.c | 10 ++--- src/lisp/ao_lisp_const.lisp | 26 ++++++------ src/lisp/ao_lisp_error.c | 14 +++---- src/lisp/ao_lisp_eval.c | 2 +- src/lisp/ao_lisp_frame.c | 8 ++-- src/lisp/ao_lisp_int.c | 2 +- src/lisp/ao_lisp_lambda.c | 4 +- src/lisp/ao_lisp_make_builtin | 4 +- src/lisp/ao_lisp_make_const.c | 19 +++++---- src/lisp/ao_lisp_os.h | 16 ++++++-- src/lisp/ao_lisp_poly.c | 52 ++++++++++++------------ src/lisp/ao_lisp_rep.c | 4 +- src/lisp/ao_lisp_save.c | 1 + src/lisp/ao_lisp_stack.c | 4 +- src/lisp/ao_lisp_string.c | 4 +- 21 files changed, 199 insertions(+), 103 deletions(-) create mode 100644 src/lisp/README diff --git a/src/lisp/README b/src/lisp/README new file mode 100644 index 00000000..c1e84475 --- /dev/null +++ b/src/lisp/README @@ -0,0 +1,11 @@ +This follows the R7RS with the following known exceptions: + +* No vectors or bytevectors +* Characters are just numbers +* No dynamic-wind or exceptions +* No environments +* No ports +* No syntax-rules; we have macros instead +* define inside of lambda does not add name to lambda scope +* No record types +* No libraries diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index a445dddd..a10ccc43 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -106,6 +106,7 @@ extern uint16_t ao_lisp_top; #define AO_LISP_INVALID 0x04 #define AO_LISP_UNDEFINED 0x08 #define AO_LISP_EOF 0x10 +#define AO_LISP_EXIT 0x20 extern uint8_t ao_lisp_exception; @@ -463,7 +464,7 @@ ao_lisp_stack_fetch(int id) { extern const struct ao_lisp_type ao_lisp_bool_type; void -ao_lisp_bool_print(ao_poly v); +ao_lisp_bool_write(ao_poly v); #ifdef AO_LISP_MAKE_CONST struct ao_lisp_bool *ao_lisp_true, *ao_lisp_false; @@ -487,10 +488,10 @@ void ao_lisp_cons_free(struct ao_lisp_cons *cons); void -ao_lisp_cons_print(ao_poly); +ao_lisp_cons_write(ao_poly); void -ao_lisp_cons_patom(ao_poly); +ao_lisp_cons_display(ao_poly); int ao_lisp_cons_length(struct ao_lisp_cons *cons); @@ -511,10 +512,10 @@ ao_poly ao_lisp_string_unpack(char *a); void -ao_lisp_string_print(ao_poly s); +ao_lisp_string_write(ao_poly s); void -ao_lisp_string_patom(ao_poly s); +ao_lisp_string_display(ao_poly s); /* atom */ extern const struct ao_lisp_type ao_lisp_atom_type; @@ -524,7 +525,7 @@ extern struct ao_lisp_frame *ao_lisp_frame_global; extern struct ao_lisp_frame *ao_lisp_frame_current; void -ao_lisp_atom_print(ao_poly a); +ao_lisp_atom_write(ao_poly a); struct ao_lisp_atom * ao_lisp_atom_intern(char *name); @@ -540,14 +541,14 @@ ao_lisp_atom_set(ao_poly atom, ao_poly val); /* int */ void -ao_lisp_int_print(ao_poly i); +ao_lisp_int_write(ao_poly i); /* prim */ void -ao_lisp_poly_print(ao_poly p); +ao_lisp_poly_write(ao_poly p); void -ao_lisp_poly_patom(ao_poly p); +ao_lisp_poly_display(ao_poly p); int ao_lisp_poly_mark(ao_poly p, uint8_t note_cons); @@ -572,7 +573,7 @@ ao_lisp_set_cond(struct ao_lisp_cons *cons); /* builtin */ void -ao_lisp_builtin_print(ao_poly b); +ao_lisp_builtin_write(ao_poly b); extern const struct ao_lisp_type ao_lisp_builtin_type; @@ -629,7 +630,7 @@ int ao_lisp_frame_add(struct ao_lisp_frame **frame, ao_poly atom, ao_poly val); void -ao_lisp_frame_print(ao_poly p); +ao_lisp_frame_write(ao_poly p); /* lambda */ extern const struct ao_lisp_type ao_lisp_lambda_type; @@ -640,7 +641,7 @@ struct ao_lisp_lambda * ao_lisp_lambda_new(ao_poly cons); void -ao_lisp_lambda_print(ao_poly lambda); +ao_lisp_lambda_write(ao_poly lambda); ao_poly ao_lisp_lambda_eval(void); @@ -664,7 +665,7 @@ void ao_lisp_stack_clear(void); void -ao_lisp_stack_print(ao_poly stack); +ao_lisp_stack_write(ao_poly stack); ao_poly ao_lisp_stack_eval(void); @@ -697,10 +698,10 @@ int ao_lisp_stack_depth; #define DBG_RESET() (ao_lisp_stack_depth = 0) #define DBG(...) printf(__VA_ARGS__) #define DBGI(...) do { DBG("%4d: ", __LINE__); DBG_INDENT(); DBG(__VA_ARGS__); } while (0) -#define DBG_CONS(a) ao_lisp_cons_print(ao_lisp_cons_poly(a)) -#define DBG_POLY(a) ao_lisp_poly_print(a) +#define DBG_CONS(a) ao_lisp_cons_write(ao_lisp_cons_poly(a)) +#define DBG_POLY(a) ao_lisp_poly_write(a) #define OFFSET(a) ((a) ? (int) ((uint8_t *) a - ao_lisp_pool) : -1) -#define DBG_STACK() ao_lisp_stack_print(ao_lisp_stack_poly(ao_lisp_stack)) +#define DBG_STACK() ao_lisp_stack_write(ao_lisp_stack_poly(ao_lisp_stack)) static inline void ao_lisp_frames_dump(void) { diff --git a/src/lisp/ao_lisp_atom.c b/src/lisp/ao_lisp_atom.c index 8c9e8ed1..ede13567 100644 --- a/src/lisp/ao_lisp_atom.c +++ b/src/lisp/ao_lisp_atom.c @@ -158,7 +158,7 @@ ao_lisp_atom_set(ao_poly atom, ao_poly val) } void -ao_lisp_atom_print(ao_poly a) +ao_lisp_atom_write(ao_poly a) { struct ao_lisp_atom *atom = ao_lisp_poly_atom(a); printf("%s", atom->name); diff --git a/src/lisp/ao_lisp_bool.c b/src/lisp/ao_lisp_bool.c index ad25afba..391a7f78 100644 --- a/src/lisp/ao_lisp_bool.c +++ b/src/lisp/ao_lisp_bool.c @@ -38,7 +38,7 @@ const struct ao_lisp_type ao_lisp_bool_type = { }; void -ao_lisp_bool_print(ao_poly v) +ao_lisp_bool_write(ao_poly v) { struct ao_lisp_bool *b = ao_lisp_poly_bool(v); diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c index d37d0284..6dd4d5e6 100644 --- a/src/lisp/ao_lisp_builtin.c +++ b/src/lisp/ao_lisp_builtin.c @@ -85,7 +85,7 @@ ao_lisp_args_name(uint8_t args) #endif void -ao_lisp_builtin_print(ao_poly b) +ao_lisp_builtin_write(ao_poly b) { struct ao_lisp_builtin *builtin = ao_lisp_poly_builtin(b); printf("%s", ao_lisp_builtin_name(builtin->func)); @@ -247,30 +247,30 @@ ao_lisp_do_while(struct ao_lisp_cons *cons) } ao_poly -ao_lisp_do_print(struct ao_lisp_cons *cons) +ao_lisp_do_write(struct ao_lisp_cons *cons) { ao_poly val = AO_LISP_NIL; while (cons) { val = cons->car; - ao_lisp_poly_print(val); + ao_lisp_poly_write(val); cons = ao_lisp_poly_cons(cons->cdr); if (cons) printf(" "); } printf("\n"); - return val; + return _ao_lisp_bool_true; } ao_poly -ao_lisp_do_patom(struct ao_lisp_cons *cons) +ao_lisp_do_display(struct ao_lisp_cons *cons) { ao_poly val = AO_LISP_NIL; while (cons) { val = cons->car; - ao_lisp_poly_patom(val); + ao_lisp_poly_display(val); cons = ao_lisp_poly_cons(cons->cdr); } - return val; + return _ao_lisp_bool_true; } ao_poly @@ -738,5 +738,65 @@ ao_lisp_do_string_to_symbol(struct ao_lisp_cons *cons) return ao_lisp_atom_poly(ao_lisp_atom_intern(ao_lisp_poly_string(ao_lisp_arg(cons, 0)))); } +ao_poly +ao_lisp_do_read_char(struct ao_lisp_cons *cons) +{ + int c; + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 0, 0)) + return AO_LISP_NIL; + c = getchar(); + return ao_lisp_int_poly(c); +} + +ao_poly +ao_lisp_do_write_char(struct ao_lisp_cons *cons) +{ + 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; + putchar(ao_lisp_poly_int(ao_lisp_arg(cons, 0))); + return _ao_lisp_bool_true; +} + +ao_poly +ao_lisp_do_exit(struct ao_lisp_cons *cons) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 0, 0)) + return AO_LISP_NIL; + ao_lisp_exception |= AO_LISP_EXIT; + return _ao_lisp_bool_true; +} + +ao_poly +ao_lisp_do_current_jiffy(struct ao_lisp_cons *cons) +{ + int jiffy; + + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 0, 0)) + return AO_LISP_NIL; + jiffy = ao_lisp_os_jiffy(); + return (ao_lisp_int_poly(jiffy)); +} + +ao_poly +ao_lisp_do_current_second(struct ao_lisp_cons *cons) +{ + int second; + + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 0, 0)) + return AO_LISP_NIL; + second = ao_lisp_os_jiffy() / AO_LISP_JIFFIES_PER_SECOND; + return (ao_lisp_int_poly(second)); +} + +ao_poly +ao_lisp_do_jiffies_per_second(struct ao_lisp_cons *cons) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 0, 0)) + return AO_LISP_NIL; + return (ao_lisp_int_poly(AO_LISP_JIFFIES_PER_SECOND)); +} + #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 index ba6455ab..4c484337 100644 --- a/src/lisp/ao_lisp_builtin.txt +++ b/src/lisp/ao_lisp_builtin.txt @@ -15,8 +15,8 @@ macro setq set! nlambda cond nlambda progn nlambda while -f_lexpr print -f_lexpr patom +f_lexpr write +f_lexpr display f_lexpr plus + f_lexpr minus - f_lexpr times * @@ -52,3 +52,9 @@ f_lambda string_to_symbol string->symbol f_lambda stringp string? f_lambda procedurep procedure? lexpr apply +f_lambda read_char read-char +f_lambda write_char write-char +f_lambda exit +f_lambda current_jiffy current-jiffy +f_lambda current_second current-second +f_lambda jiffies_per_second jiffies-per-second diff --git a/src/lisp/ao_lisp_cons.c b/src/lisp/ao_lisp_cons.c index 8d607372..9379597c 100644 --- a/src/lisp/ao_lisp_cons.c +++ b/src/lisp/ao_lisp_cons.c @@ -123,7 +123,7 @@ ao_lisp_cons_free(struct ao_lisp_cons *cons) } void -ao_lisp_cons_print(ao_poly c) +ao_lisp_cons_write(ao_poly c) { struct ao_lisp_cons *cons = ao_lisp_poly_cons(c); int first = 1; @@ -131,14 +131,14 @@ ao_lisp_cons_print(ao_poly c) while (cons) { if (!first) printf(" "); - ao_lisp_poly_print(cons->car); + ao_lisp_poly_write(cons->car); c = cons->cdr; if (ao_lisp_poly_type(c) == AO_LISP_CONS) { cons = ao_lisp_poly_cons(c); first = 0; } else { printf(" . "); - ao_lisp_poly_print(c); + ao_lisp_poly_write(c); cons = NULL; } } @@ -146,12 +146,12 @@ ao_lisp_cons_print(ao_poly c) } void -ao_lisp_cons_patom(ao_poly c) +ao_lisp_cons_display(ao_poly c) { struct ao_lisp_cons *cons = ao_lisp_poly_cons(c); while (cons) { - ao_lisp_poly_patom(cons->car); + ao_lisp_poly_display(cons->car); cons = ao_lisp_poly_cons(cons->cdr); } } diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp index d9b1c1f2..191ef005 100644 --- a/src/lisp/ao_lisp_const.lisp +++ b/src/lisp/ao_lisp_const.lisp @@ -463,11 +463,9 @@ (define string (lexpr (chars) (list->string chars))) -(patom "apply\n") +(display "apply\n") (apply cons '(a b)) -(define save ()) - (define map (lexpr (proc lists) (let ((args (lambda (lists) (if (null? lists) () @@ -488,28 +486,30 @@ (apply map proc lists) #t)) -(for-each patom '("hello" " " "world" "\n")) +(for-each display '("hello" " " "world" "\n")) + +(define -string-ml (lambda (strings) + (if (null? strings) () + (cons (string->list (car strings)) (-string-ml (cdr strings)))))) (define string-map (lexpr (proc strings) - (let ((make-lists (lambda (strings) - (if (null? strings) () - (cons (string->list (car strings)) (make-lists (cdr strings)))))) - ) - (list->string (apply map proc (make-lists strings)))))) + (list->string (apply map proc (-string-ml strings)))))) (string-map 1+ "HAL") (define string-for-each (lexpr (proc strings) - (apply string-map proc strings) - #t)) + (apply for-each proc (-string-ml strings)))) + +(string-for-each write-char "IBM\n") -(string-for-each patom "IBM") +(define newline (lambda () (write-char #\newline))) +(newline) (call-with-current-continuation (lambda (exit) (for-each (lambda (x) - (print "test" x) + (write "test" x) (if (negative? x) (exit x))) '(54 0 37 -3 245 19)) diff --git a/src/lisp/ao_lisp_error.c b/src/lisp/ao_lisp_error.c index 54a9be10..d1c9b941 100644 --- a/src/lisp/ao_lisp_error.c +++ b/src/lisp/ao_lisp_error.c @@ -28,7 +28,7 @@ ao_lisp_error_poly(char *name, ao_poly poly, ao_poly last) printf("\t\t "); else first = 0; - ao_lisp_poly_print(cons->car); + ao_lisp_poly_write(cons->car); printf("\n"); if (poly == last) break; @@ -38,7 +38,7 @@ ao_lisp_error_poly(char *name, ao_poly poly, ao_poly last) } else printf(")\n"); } else { - ao_lisp_poly_print(poly); + ao_lisp_poly_write(poly); printf("\n"); } } @@ -66,9 +66,9 @@ ao_lisp_error_frame(int indent, char *name, struct ao_lisp_frame *frame) tabs(indent); printf(" "); } - ao_lisp_poly_print(frame->vals[f].atom); + ao_lisp_poly_write(frame->vals[f].atom); printf(" = "); - ao_lisp_poly_print(frame->vals[f].val); + ao_lisp_poly_write(frame->vals[f].val); printf("\n"); } if (frame->prev) @@ -92,11 +92,11 @@ ao_lisp_error(int error, char *format, ...) vprintf(format, args); va_end(args); printf("\n"); - printf("Value: "); ao_lisp_poly_print(ao_lisp_v); printf("\n"); + printf("Value: "); ao_lisp_poly_write(ao_lisp_v); printf("\n"); printf("Stack:\n"); - ao_lisp_stack_print(ao_lisp_stack_poly(ao_lisp_stack)); + ao_lisp_stack_write(ao_lisp_stack_poly(ao_lisp_stack)); printf("Globals:\n\t"); - ao_lisp_frame_print(ao_lisp_frame_poly(ao_lisp_frame_global)); + ao_lisp_frame_write(ao_lisp_frame_poly(ao_lisp_frame_global)); printf("\n"); return AO_LISP_NIL; } diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c index 844e7ce7..758a9232 100644 --- a/src/lisp/ao_lisp_eval.c +++ b/src/lisp/ao_lisp_eval.c @@ -270,7 +270,7 @@ ao_lisp_eval_exec(void) DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n"); }); builtin = ao_lisp_poly_builtin(ao_lisp_v); - if (builtin->args & AO_LISP_FUNC_FREE_ARGS && !ao_lisp_stack_marked(ao_lisp_stack) && !ao_lisp_skip_cons_free) + if (builtin && builtin->args & AO_LISP_FUNC_FREE_ARGS && !ao_lisp_stack_marked(ao_lisp_stack) && !ao_lisp_skip_cons_free) ao_lisp_cons_free(ao_lisp_poly_cons(ao_lisp_stack->values)); ao_lisp_v = v; diff --git a/src/lisp/ao_lisp_frame.c b/src/lisp/ao_lisp_frame.c index 05f6d253..ebdb7757 100644 --- a/src/lisp/ao_lisp_frame.c +++ b/src/lisp/ao_lisp_frame.c @@ -102,7 +102,7 @@ const struct ao_lisp_type ao_lisp_frame_type = { }; void -ao_lisp_frame_print(ao_poly p) +ao_lisp_frame_write(ao_poly p) { struct ao_lisp_frame *frame = ao_lisp_poly_frame(p); int f; @@ -116,12 +116,12 @@ ao_lisp_frame_print(ao_poly p) for (f = 0; f < frame->num; f++) { if (f != 0) printf(", "); - ao_lisp_poly_print(frame->vals[f].atom); + ao_lisp_poly_write(frame->vals[f].atom); printf(" = "); - ao_lisp_poly_print(frame->vals[f].val); + ao_lisp_poly_write(frame->vals[f].val); } if (frame->prev) - ao_lisp_poly_print(frame->prev); + ao_lisp_poly_write(frame->prev); frame->type &= ~AO_LISP_FRAME_PRINT; } } diff --git a/src/lisp/ao_lisp_int.c b/src/lisp/ao_lisp_int.c index 77f65e95..3b5341bd 100644 --- a/src/lisp/ao_lisp_int.c +++ b/src/lisp/ao_lisp_int.c @@ -15,7 +15,7 @@ #include "ao_lisp.h" void -ao_lisp_int_print(ao_poly p) +ao_lisp_int_write(ao_poly p) { int i = ao_lisp_poly_int(p); printf("%d", i); diff --git a/src/lisp/ao_lisp_lambda.c b/src/lisp/ao_lisp_lambda.c index cc333d6f..71aebed0 100644 --- a/src/lisp/ao_lisp_lambda.c +++ b/src/lisp/ao_lisp_lambda.c @@ -50,7 +50,7 @@ const struct ao_lisp_type ao_lisp_lambda_type = { }; void -ao_lisp_lambda_print(ao_poly poly) +ao_lisp_lambda_write(ao_poly poly) { struct ao_lisp_lambda *lambda = ao_lisp_poly_lambda(poly); struct ao_lisp_cons *cons = ao_lisp_poly_cons(lambda->code); @@ -59,7 +59,7 @@ ao_lisp_lambda_print(ao_poly poly) printf("%s", ao_lisp_args_name(lambda->args)); while (cons) { printf(" "); - ao_lisp_poly_print(cons->car); + ao_lisp_poly_write(cons->car); cons = ao_lisp_poly_cons(cons->cdr); } printf(")"); diff --git a/src/lisp/ao_lisp_make_builtin b/src/lisp/ao_lisp_make_builtin index 11838e33..531e388d 100644 --- a/src/lisp/ao_lisp_make_builtin +++ b/src/lisp/ao_lisp_make_builtin @@ -137,7 +137,9 @@ dump_consts(builtin_t[*] builtins) { for (int i = 0; i < dim(builtins); i++) { for (int j = 0; j < dim(builtins[i].lisp_names); j++) { printf ("\t{ .name = \"%s\", .args = AO_LISP_FUNC_%s, .func = builtin_%s },\n", - builtins[i].lisp_names[j], builtins[i].type, builtins[i].c_name); + builtins[i].lisp_names[j], + builtins[i].type, + builtins[i].c_name); } } printf("};\n"); diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c index 826c98b9..f23d34db 100644 --- a/src/lisp/ao_lisp_make_const.c +++ b/src/lisp/ao_lisp_make_const.c @@ -31,7 +31,7 @@ ao_lisp_make_builtin(enum ao_lisp_builtin_id func, int args) { struct builtin_func { char *name; int args; - int func; + enum ao_lisp_builtin_id func; }; #define AO_LISP_BUILTIN_CONSTS @@ -146,7 +146,7 @@ ao_is_macro(ao_poly p) struct ao_lisp_lambda *lambda; ao_poly ret; - MACRO_DEBUG(indent(); printf ("is macro "); ao_lisp_poly_print(p); printf("\n"); ++macro_scan_depth); + MACRO_DEBUG(indent(); printf ("is macro "); ao_lisp_poly_write(p); printf("\n"); ++macro_scan_depth); switch (ao_lisp_poly_type(p)) { case AO_LISP_ATOM: if (ao_lisp_macro_push(p)) @@ -181,7 +181,7 @@ ao_is_macro(ao_poly p) ret = AO_LISP_NIL; break; } - MACRO_DEBUG(--macro_scan_depth; indent(); printf ("... "); ao_lisp_poly_print(ret); printf("\n")); + MACRO_DEBUG(--macro_scan_depth; indent(); printf ("... "); ao_lisp_poly_write(ret); printf("\n")); return ret; } @@ -195,7 +195,7 @@ ao_has_macro(ao_poly p) if (p == AO_LISP_NIL) return AO_LISP_NIL; - MACRO_DEBUG(indent(); printf("has macro "); ao_lisp_poly_print(p); printf("\n"); ++macro_scan_depth); + MACRO_DEBUG(indent(); printf("has macro "); ao_lisp_poly_write(p); printf("\n"); ++macro_scan_depth); switch (ao_lisp_poly_type(p)) { case AO_LISP_LAMBDA: lambda = ao_lisp_poly_lambda(p); @@ -222,7 +222,7 @@ ao_has_macro(ao_poly p) p = AO_LISP_NIL; break; } - MACRO_DEBUG(--macro_scan_depth; indent(); printf("... "); ao_lisp_poly_print(p); printf("\n")); + MACRO_DEBUG(--macro_scan_depth; indent(); printf("... "); ao_lisp_poly_write(p); printf("\n")); return p; } @@ -237,7 +237,7 @@ ao_lisp_read_eval_abort(void) out = ao_lisp_eval(in); if (ao_lisp_exception) return 0; - ao_lisp_poly_print(out); + ao_lisp_poly_write(out); putchar ('\n'); } return 1; @@ -273,6 +273,7 @@ main(int argc, char **argv) int in_atom = 0; char *out_name = NULL; int c; + enum ao_lisp_builtin_id prev_func; in = stdin; out = stdout; @@ -292,8 +293,10 @@ main(int argc, char **argv) ao_lisp_bool_get(0); ao_lisp_bool_get(1); + prev_func = _builtin_last; for (f = 0; f < (int) N_FUNC; f++) { - b = ao_lisp_make_builtin(funcs[f].func, funcs[f].args); + if (funcs[f].func != prev_func) + 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), ao_lisp_builtin_poly(b)); @@ -327,7 +330,7 @@ main(int argc, char **argv) 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); + ao_lisp_poly_write(val); printf("\n"); exit(1); } diff --git a/src/lisp/ao_lisp_os.h b/src/lisp/ao_lisp_os.h index 5fa3686b..4285cb8c 100644 --- a/src/lisp/ao_lisp_os.h +++ b/src/lisp/ao_lisp_os.h @@ -41,13 +41,23 @@ ao_lisp_os_led(int led) printf("leds set to 0x%x\n", led); } +#define AO_LISP_JIFFIES_PER_SECOND 100 + static inline void -ao_lisp_os_delay(int delay) +ao_lisp_os_delay(int jiffies) { struct timespec ts = { - .tv_sec = delay / 1000, - .tv_nsec = (delay % 1000) * 1000000, + .tv_sec = jiffies / AO_LISP_JIFFIES_PER_SECOND, + .tv_nsec = (jiffies % AO_LISP_JIFFIES_PER_SECOND) * (1000000000L / AO_LISP_JIFFIES_PER_SECOND) }; nanosleep(&ts, NULL); } + +static inline int +ao_lisp_os_jiffy(void) +{ + struct timespec tp; + clock_gettime(CLOCK_MONOTONIC, &tp); + return tp.tv_sec * AO_LISP_JIFFIES_PER_SECOND + (tp.tv_nsec / (1000000000L / AO_LISP_JIFFIES_PER_SECOND)); +} #endif diff --git a/src/lisp/ao_lisp_poly.c b/src/lisp/ao_lisp_poly.c index 160734b1..7e4c98d2 100644 --- a/src/lisp/ao_lisp_poly.c +++ b/src/lisp/ao_lisp_poly.c @@ -15,46 +15,46 @@ #include "ao_lisp.h" struct ao_lisp_funcs { - void (*print)(ao_poly); - void (*patom)(ao_poly); + void (*write)(ao_poly); + void (*display)(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, + .write = ao_lisp_cons_write, + .display = ao_lisp_cons_display, }, [AO_LISP_STRING] = { - .print = ao_lisp_string_print, - .patom = ao_lisp_string_patom, + .write = ao_lisp_string_write, + .display = ao_lisp_string_display, }, [AO_LISP_INT] = { - .print = ao_lisp_int_print, - .patom = ao_lisp_int_print, + .write = ao_lisp_int_write, + .display = ao_lisp_int_write, }, [AO_LISP_ATOM] = { - .print = ao_lisp_atom_print, - .patom = ao_lisp_atom_print, + .write = ao_lisp_atom_write, + .display = ao_lisp_atom_write, }, [AO_LISP_BUILTIN] = { - .print = ao_lisp_builtin_print, - .patom = ao_lisp_builtin_print, + .write = ao_lisp_builtin_write, + .display = ao_lisp_builtin_write, }, [AO_LISP_FRAME] = { - .print = ao_lisp_frame_print, - .patom = ao_lisp_frame_print, + .write = ao_lisp_frame_write, + .display = ao_lisp_frame_write, }, [AO_LISP_LAMBDA] = { - .print = ao_lisp_lambda_print, - .patom = ao_lisp_lambda_print, + .write = ao_lisp_lambda_write, + .display = ao_lisp_lambda_write, }, [AO_LISP_STACK] = { - .print = ao_lisp_stack_print, - .patom = ao_lisp_stack_print, + .write = ao_lisp_stack_write, + .display = ao_lisp_stack_write, }, [AO_LISP_BOOL] = { - .print = ao_lisp_bool_print, - .patom = ao_lisp_bool_print, + .write = ao_lisp_bool_write, + .display = ao_lisp_bool_write, }, }; @@ -69,21 +69,21 @@ funcs(ao_poly p) } void -ao_lisp_poly_print(ao_poly p) +ao_lisp_poly_write(ao_poly p) { const struct ao_lisp_funcs *f = funcs(p); - if (f && f->print) - f->print(p); + if (f && f->write) + f->write(p); } void -ao_lisp_poly_patom(ao_poly p) +ao_lisp_poly_display(ao_poly p) { const struct ao_lisp_funcs *f = funcs(p); - if (f && f->patom) - f->patom(p); + if (f && f->display) + f->display(p); } void * diff --git a/src/lisp/ao_lisp_rep.c b/src/lisp/ao_lisp_rep.c index ef7dbaf2..43cc387f 100644 --- a/src/lisp/ao_lisp_rep.c +++ b/src/lisp/ao_lisp_rep.c @@ -24,9 +24,11 @@ ao_lisp_read_eval_print(void) break; out = ao_lisp_eval(in); if (ao_lisp_exception) { + if (ao_lisp_exception & AO_LISP_EXIT) + break; ao_lisp_exception = 0; } else { - ao_lisp_poly_print(out); + ao_lisp_poly_write(out); putchar ('\n'); } } diff --git a/src/lisp/ao_lisp_save.c b/src/lisp/ao_lisp_save.c index cbc8e925..c990e9c6 100644 --- a/src/lisp/ao_lisp_save.c +++ b/src/lisp/ao_lisp_save.c @@ -69,6 +69,7 @@ ao_lisp_do_restore(struct ao_lisp_cons *cons) /* Re-create the evaluator stack */ if (!ao_lisp_eval_restart()) return _ao_lisp_bool_false; + return _ao_lisp_bool_true; } #endif diff --git a/src/lisp/ao_lisp_stack.c b/src/lisp/ao_lisp_stack.c index 729a63ba..af68b656 100644 --- a/src/lisp/ao_lisp_stack.c +++ b/src/lisp/ao_lisp_stack.c @@ -156,7 +156,7 @@ ao_lisp_stack_clear(void) } void -ao_lisp_stack_print(ao_poly poly) +ao_lisp_stack_write(ao_poly poly) { struct ao_lisp_stack *s = ao_lisp_poly_stack(poly); @@ -167,7 +167,7 @@ ao_lisp_stack_print(ao_poly poly) } s->type |= AO_LISP_STACK_PRINT; printf("\t[\n"); - printf("\t\texpr: "); ao_lisp_poly_print(s->list); printf("\n"); + printf("\t\texpr: "); ao_lisp_poly_write(s->list); printf("\n"); printf("\t\tstate: %s\n", ao_lisp_state_names[s->state]); ao_lisp_error_poly ("values: ", s->values, s->values_tail); ao_lisp_error_poly ("sexprs: ", s->sexprs, AO_LISP_NIL); diff --git a/src/lisp/ao_lisp_string.c b/src/lisp/ao_lisp_string.c index af23f7b3..87f9289c 100644 --- a/src/lisp/ao_lisp_string.c +++ b/src/lisp/ao_lisp_string.c @@ -122,7 +122,7 @@ ao_lisp_string_unpack(char *a) } void -ao_lisp_string_print(ao_poly p) +ao_lisp_string_write(ao_poly p) { char *s = ao_lisp_poly_string(p); char c; @@ -148,7 +148,7 @@ ao_lisp_string_print(ao_poly p) } void -ao_lisp_string_patom(ao_poly p) +ao_lisp_string_display(ao_poly p) { char *s = ao_lisp_poly_string(p); char c; -- 2.30.2