From 08f94ca2309a6d3eb6c1e14d4dcd1c5574a25c02 Mon Sep 17 00:00:00 2001 From: ~keith Date: Fri, 4 Feb 2022 19:14:24 +0000 Subject: [PATCH] sforms and macros can be Lisp code too --- doc/stdlib_forms.md | 9 +++ main.c | 139 +++++++++++++++++++++++++++++++------------- main.h | 17 +++++- native_funs.c | 2 +- 4 files changed, 123 insertions(+), 44 deletions(-) diff --git a/doc/stdlib_forms.md b/doc/stdlib_forms.md index af0f622..365546f 100644 --- a/doc/stdlib_forms.md +++ b/doc/stdlib_forms.md @@ -51,3 +51,12 @@ argument definitions, followed by zero or more `body-form`s. An argument definition is simply the name of the locally scoped variable which it should be bound to. `&optional`, `&rest`, and `&key` arguments are not yet supported. + +## `defmacro` + +``` +(defmacro ({arg}*) {body-form}*) +``` +`defmacro` defines a new macro in Keithlisp. It takes the same arguments +as `defun`, but sets the `RAWARG`, `EVALRES`, and `EARLY` flags in the +function definition, making it behave like a macro. diff --git a/main.c b/main.c index bbab43f..e7ab33b 100644 --- a/main.c +++ b/main.c @@ -201,25 +201,42 @@ bool fetch_tokens(lisp_cons** tokens) { return true; } -lisp_atom lisp_defun_native(lisp_string* lstr, lisp_native_fun funptr) { - lisp_atom atom = lisp_atom_init(lstr); +// funs-alist entry: (name . (flags . fun)) - unless flags is 0 +lisp_cons* lisp_create_fundef(lisp_atom atom, long flags, lisp_value fun) { lisp_cons* cons = dbg_malloc(sizeof(lisp_cons)); cons->car.type = LISP_T_ATOM; cons->car.value.atom = atom; - cons->cdr.type = LISP_T_FUNPTR; - cons->cdr.value.funptr = funptr; + if (flags) { + cons->cdr.type = LISP_T_CONS; + cons->cdr.value.cons = dbg_malloc(sizeof(lisp_cons)); + cons->cdr.value.cons->car.type = LISP_T_INT; + cons->cdr.value.cons->car.value._int = flags; + cons->cdr.value.cons->cdr = fun; + } else { + cons->cdr = fun; + } lisp_alist_put(&funs_alist, cons); + return cons; +} + +lisp_atom lisp_defun_native(lisp_string* lstr, lisp_native_fun funptr) { + lisp_atom atom = lisp_atom_init(lstr); + lisp_create_fundef(atom, 0, (lisp_value){.type = LISP_T_FUNPTR, .value = {.funptr = funptr}}); return atom; } -lisp_cons* lisp_defun_lisp_fun(lisp_atom atom, lisp_cons* fun) { - lisp_cons* cons = dbg_malloc(sizeof(lisp_cons)); - cons->car.type = LISP_T_ATOM; - cons->car.value.atom = atom; - cons->cdr.type = LISP_T_CONS; - cons->cdr.value.cons = fun; - lisp_alist_put(&funs_alist, cons); - return cons; +lisp_cons* lisp_defun(lisp_atom atom, lisp_cons* fun) { + return lisp_create_fundef(atom, 0, (lisp_value){.type = LISP_T_CONS, .value = {.cons = fun}}); +} + +lisp_atom lisp_defun_special_native(lisp_string* lstr, long flags, lisp_native_fun funptr) { + lisp_atom atom = lisp_atom_init(lstr); + lisp_create_fundef(atom, flags, (lisp_value){.type = LISP_T_FUNPTR, .value = {.funptr = funptr}}); + return atom; +} + +lisp_cons* lisp_defun_special(lisp_atom atom, long flags, lisp_cons* fun) { + return lisp_create_fundef(atom, flags, (lisp_value){.type = LISP_T_CONS, .value = {.cons = fun}}); } void lisp_evaluate_value(lisp_value input, lisp_value* result) { @@ -245,6 +262,7 @@ void lisp_evaluate(lisp_cons* cons, lisp_value* value) { value->value.cons = NULL; // can't use a switch here + /* if (cons->car.value.atom == atom_quote) { *value = cons->cdr.value.cons->car; return; @@ -258,45 +276,69 @@ void lisp_evaluate(lisp_cons* cons, lisp_value* value) { lisp_sform_defun(cons->cdr.value.cons, value); return; } + */ lisp_cons* fun_cons = lisp_alist_get(funs_alist, cons->car); if (fun_cons == NULL) { fprintf(stderr, "EVAL ERROR! (no such fun)\n"); return; } + long fun_flags = 0; + lisp_value fun_val; + if (fun_cons->cdr.type == LISP_T_CONS && fun_cons->cdr.value.cons != NULL + && fun_cons->cdr.value.cons->car.type == LISP_T_INT) { + fun_flags = fun_cons->cdr.value.cons->car.value._int; + fun_val = fun_cons->cdr.value.cons->cdr; + } else { + fun_val = fun_cons->cdr; + } + lisp_cons* args = NULL; lisp_cons* args_tail = NULL; - cons = cons->cdr.value.cons; - while (cons != NULL) { - lisp_cons* arg_cons = dbg_malloc(sizeof(lisp_cons)); - arg_cons->cdr.type = LISP_T_CONS; - arg_cons->cdr.value.cons = NULL; - lisp_evaluate_value(cons->car, &arg_cons->car); + if ((fun_flags & LISP_FFLAG_RAWARG) == 0) { cons = cons->cdr.value.cons; - if (args == NULL) - args = arg_cons; - if (args_tail == NULL) - args_tail = args; - else { - args_tail->cdr.value.cons = arg_cons; - args_tail = arg_cons; + while (cons != NULL) { + lisp_cons* arg_cons = dbg_malloc(sizeof(lisp_cons)); + arg_cons->cdr.type = LISP_T_CONS; + arg_cons->cdr.value.cons = NULL; + lisp_evaluate_value(cons->car, &arg_cons->car); + cons = cons->cdr.value.cons; + if (args == NULL) + args = arg_cons; + if (args_tail == NULL) + args_tail = args; + else { + args_tail->cdr.value.cons = arg_cons; + args_tail = arg_cons; + } } - } - if (fun_cons->cdr.type == LISP_T_FUNPTR) { - // native-fun - (*fun_cons->cdr.value.funptr)(args, value); - while (args != NULL) { - args_tail = args->cdr.value.cons; - dbg_free(args); - args = args_tail; - } - } else if (fun_cons->cdr.type == LISP_T_CONS) { - // lisp-fun - lisp_evaluate_lisp_fun(fun_cons->cdr.value.cons, args, value); } else { - fprintf(stderr, "EVAL ERROR! (not a native-fun)\n"); + args = recursive_copy(cons->cdr.value.cons); + } + + if (fun_val.type == LISP_T_FUNPTR) { + // native-fun + (*fun_val.value.funptr)(args, value); + } else if (fun_val.type == LISP_T_CONS) { + // defun + lisp_evaluate_defun(fun_val.value.cons, args, value); + } else { + fprintf(stderr, "EVAL ERROR! (not native-fun or defun)\n"); return; } + + // free args + while (args != NULL) { + args_tail = args->cdr.value.cons; + dbg_free(args); + args = args_tail; + } + + if (fun_flags & LISP_FFLAG_EVALRES) + lisp_evaluate_value(*value, value); +} +void lisp_sform_quote(lisp_cons* cons, lisp_value* value) { + *value = cons->car; } lisp_atom atom_cond; void lisp_sform_cond(lisp_cons* cons, lisp_value* value) { @@ -366,7 +408,16 @@ void lisp_sform_defun(lisp_cons* cons, lisp_value* value) { lisp_atom fun_name = cons->car.value.atom; lisp_cons* fun_data = recursive_copy(cons->cdr.value.cons); - lisp_defun_lisp_fun(fun_name, fun_data); + lisp_defun(fun_name, fun_data); + value->type = LISP_T_CONS; + value->value.cons = fun_data; +} +lisp_atom atom_defmacro; +void lisp_sform_defmacro(lisp_cons* cons, lisp_value* value) { + lisp_atom fun_name = cons->car.value.atom; + lisp_cons* fun_data = recursive_copy(cons->cdr.value.cons); + + lisp_defun_special(fun_name, LISP_FFLAG_EARLY|LISP_FFLAG_RAWARG|LISP_FFLAG_EVALRES, fun_data); value->type = LISP_T_CONS; value->value.cons = fun_data; } @@ -397,7 +448,7 @@ lisp_cons* recursive_copy(lisp_cons* cons) { return new_root; } -void lisp_evaluate_lisp_fun(lisp_cons* fun, lisp_cons* args, lisp_value* value) { +void lisp_evaluate_defun(lisp_cons* fun, lisp_cons* args, lisp_value* value) { // allocate local vars lisp_cons* head = fun->car.value.cons; while (head != NULL) { @@ -453,11 +504,19 @@ int main() { printf("sizeof(lisp_cons) = %lu\n", sizeof(lisp_cons)); atom_t = lisp_atom_init(lisp_string_create("t")); + /* atom_quote = lisp_atom_init(lisp_string_create("quote")); atom_cond = lisp_atom_init(lisp_string_create("cond")); atom_let = lisp_atom_init(lisp_string_create("let")); atom_defun = lisp_atom_init(lisp_string_create("defun")); + */ + + atom_quote = lisp_defun_special_native(lisp_string_create("quote"), LISP_FFLAG_RAWARG, &lisp_sform_quote); + atom_cond = lisp_defun_special_native(lisp_string_create("cond"), LISP_FFLAG_RAWARG, &lisp_sform_cond); + atom_let = lisp_defun_special_native(lisp_string_create("let"), LISP_FFLAG_RAWARG, &lisp_sform_let); + atom_defun = lisp_defun_special_native(lisp_string_create("defun"), LISP_FFLAG_RAWARG, &lisp_sform_defun); + atom_defmacro = lisp_defun_special_native(lisp_string_create("defmacro"), LISP_FFLAG_RAWARG, &lisp_sform_defmacro); atom_cons = lisp_atom_init(lisp_string_create("cons")); atom_atom = lisp_atom_init(lisp_string_create("atom")); diff --git a/main.h b/main.h index 2f802e8..1e02d2a 100644 --- a/main.h +++ b/main.h @@ -16,7 +16,7 @@ /* LISP_USE_ATOMS_ALIST: * If enabled, atom names will be stored in atoms_alist. * This assists debugging and reflection, but makes atom evaluation - * slower and uses more memory. */ + * slightly slower and uses more memory. */ #define LISP_USE_ATOMS_ALIST extern lisp_cons* syms_alist; @@ -33,6 +33,10 @@ __attribute__((always_inline)) static inline lisp_cons* lisp_cons_pop(lisp_cons* return old_head; } +#define LISP_FFLAG_RAWARG 0x1 +#define LISP_FFLAG_EVALRES 0x2 +#define LISP_FFLAG_EARLY 0x4 + extern lisp_atom atom_t; extern lisp_atom atom_quote; @@ -53,8 +57,12 @@ lisp_cons* lisp_alist_del(lisp_cons** alist, lisp_value key); void print_cons(lisp_cons* cons); void print_value(lisp_value value); +lisp_cons* lisp_create_fundef(lisp_atom atom, long flags, lisp_value fun); lisp_atom lisp_defun_native(lisp_string* lstr, lisp_native_fun funptr); -lisp_cons* lisp_defun_lisp_fun(lisp_atom atom, lisp_cons* fun); +lisp_cons* lisp_defun(lisp_atom atom, lisp_cons* fun); + +lisp_atom lisp_defun_special_native(lisp_string* lstr, long flags, lisp_native_fun funptr); +lisp_cons* lisp_defun_special(lisp_atom atom, long flags, lisp_cons* fun); void lisp_evaluate_value(lisp_value input, lisp_value* result); void lisp_evaluate(lisp_cons* cons, lisp_value* value); @@ -64,8 +72,11 @@ extern lisp_atom atom_let; void lisp_sform_let(lisp_cons* cons, lisp_value* value); extern lisp_atom atom_defun; void lisp_sform_defun(lisp_cons* cons, lisp_value* value); +extern lisp_atom atom_defmacro; +void lisp_sform_defmacro(lisp_cons* cons, lisp_value* value); + lisp_cons* recursive_copy(lisp_cons* cons); -void lisp_evaluate_lisp_fun(lisp_cons* fun, lisp_cons* args, lisp_value* value); +void lisp_evaluate_defun(lisp_cons* fun, lisp_cons* args, lisp_value* value); #endif diff --git a/native_funs.c b/native_funs.c index af8b4fa..3512282 100644 --- a/native_funs.c +++ b/native_funs.c @@ -643,7 +643,7 @@ void lispf_internals_atoms_alist(lisp_cons* cons, lisp_value* value) { void lispf_internals_fun_set(lisp_cons* cons, lisp_value* value) { value->type = LISP_T_CONS; - value->value.cons = lisp_defun_lisp_fun(cons->car.value.atom, cons->cdr.value.cons->car.value.cons); + value->value.cons = lisp_defun(cons->car.value.atom, cons->cdr.value.cons->car.value.cons); } void init_native_funs() {