diff options
| -rw-r--r-- | src/lambdakey-v1.0/ao_lisp_os.h | 6 | ||||
| -rw-r--r-- | src/lisp/ao_lisp.h | 17 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_builtin.c | 47 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_cons.c | 11 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_lambda.c | 11 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_make_const.c | 4 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_os.h | 5 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_string.c | 52 | ||||
| -rw-r--r-- | src/test/ao_lisp_os.h | 5 |
9 files changed, 142 insertions, 16 deletions
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 @@ -36,6 +36,12 @@ ao_lisp_getc() { } static inline void +ao_lisp_os_flush(void) +{ + flush(); +} + +static inline void ao_lisp_abort(void) { ao_panic(1); 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, }; @@ -201,6 +205,16 @@ ao_lisp_last(struct ao_lisp_cons *cons) } 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) { if (!ao_lisp_check_argc(_ao_lisp_atom_quote, cons, 1, 1)) @@ -471,6 +485,35 @@ ao_lisp_greater_equal(struct ao_lisp_cons *cons) } 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) { ao_poly led; @@ -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 @@ -28,6 +28,11 @@ ao_lisp_getc() { } static inline void +ao_lisp_os_flush() { + fflush(stdout); +} + +static inline void ao_lisp_abort(void) { abort(); 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 @@ -25,6 +25,11 @@ extern int ao_lisp_getc(void); static inline void +ao_lisp_os_flush() { + fflush(stdout); +} + +static inline void ao_lisp_abort(void) { abort(); |