--- /dev/null
+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
#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;
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;
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);
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;
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);
/* 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);
/* 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;
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;
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);
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);
#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)
{
}
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);
};
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);
#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));
}
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
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"
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 *
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
}
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;
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;
}
}
}
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);
}
}
(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) ()
(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))
printf("\t\t ");
else
first = 0;
- ao_lisp_poly_print(cons->car);
+ ao_lisp_poly_write(cons->car);
printf("\n");
if (poly == last)
break;
} else
printf(")\n");
} else {
- ao_lisp_poly_print(poly);
+ ao_lisp_poly_write(poly);
printf("\n");
}
}
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)
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;
}
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;
};
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;
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;
}
}
#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);
};
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);
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(")");
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");
struct builtin_func {
char *name;
int args;
- int func;
+ enum ao_lisp_builtin_id func;
};
#define AO_LISP_BUILTIN_CONSTS
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))
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;
}
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);
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;
}
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;
int in_atom = 0;
char *out_name = NULL;
int c;
+ enum ao_lisp_builtin_id prev_func;
in = stdin;
out = stdout;
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));
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);
}
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
#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,
},
};
}
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 *
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');
}
}
/* Re-create the evaluator stack */
if (!ao_lisp_eval_restart())
return _ao_lisp_bool_false;
+
return _ao_lisp_bool_true;
}
#endif
}
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);
}
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);
}
void
-ao_lisp_string_print(ao_poly p)
+ao_lisp_string_write(ao_poly p)
{
char *s = ao_lisp_poly_string(p);
char c;
}
void
-ao_lisp_string_patom(ao_poly p)
+ao_lisp_string_display(ao_poly p)
{
char *s = ao_lisp_poly_string(p);
char c;
projects / fw / altos / commitdiff