summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lisp/README11
-rw-r--r--src/lisp/ao_lisp.h33
-rw-r--r--src/lisp/ao_lisp_atom.c2
-rw-r--r--src/lisp/ao_lisp_bool.c2
-rw-r--r--src/lisp/ao_lisp_builtin.c74
-rw-r--r--src/lisp/ao_lisp_builtin.txt10
-rw-r--r--src/lisp/ao_lisp_cons.c10
-rw-r--r--src/lisp/ao_lisp_const.lisp26
-rw-r--r--src/lisp/ao_lisp_error.c14
-rw-r--r--src/lisp/ao_lisp_eval.c2
-rw-r--r--src/lisp/ao_lisp_frame.c8
-rw-r--r--src/lisp/ao_lisp_int.c2
-rw-r--r--src/lisp/ao_lisp_lambda.c4
-rw-r--r--src/lisp/ao_lisp_make_builtin4
-rw-r--r--src/lisp/ao_lisp_make_const.c19
-rw-r--r--src/lisp/ao_lisp_os.h16
-rw-r--r--src/lisp/ao_lisp_poly.c52
-rw-r--r--src/lisp/ao_lisp_rep.c4
-rw-r--r--src/lisp/ao_lisp_save.c1
-rw-r--r--src/lisp/ao_lisp_stack.c4
-rw-r--r--src/lisp/ao_lisp_string.c4
21 files changed, 199 insertions, 103 deletions
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;
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 13:22:36 +0000