sforms and macros can be Lisp code too
This commit is contained in:
parent
ad98504f4f
commit
08f94ca230
|
@ -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.
|
||||
|
|
139
main.c
139
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"));
|
||||
|
|
17
main.h
17
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
|
||||
|
|
|
@ -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() {
|
||||
|
|
Loading…
Reference in New Issue