(defun) and support for functions defined in Lisp
This commit is contained in:
parent
fb3d5b90c6
commit
ad98504f4f
7 changed files with 137 additions and 8 deletions
|
@ -4,13 +4,13 @@ other S-expressions.
|
|||
|
||||
## `quote`
|
||||
```
|
||||
quote form
|
||||
(quote form)
|
||||
```
|
||||
`quote` returns `form` as-is, without performing any evaluation on it.
|
||||
|
||||
## `cond`
|
||||
```
|
||||
cond {(test {body-form}*)}*
|
||||
(cond {(test {body-form}*)}*)
|
||||
```
|
||||
`cond` is Keithlisp's basic conditional operator. It consists of zero or
|
||||
more clauses (a `test`, followed by zero or more `body-form`s).
|
||||
|
@ -23,7 +23,7 @@ or no clauses were given, `cond` returns nil.
|
|||
|
||||
## `let`
|
||||
```
|
||||
let ({var | (var value)}*) {body-form}*
|
||||
(let ({var | (var value)}*) {body-form}*)
|
||||
```
|
||||
`let` defines locally scoped variables in Keithlisp. It consists of a
|
||||
list of variable definitions, followed by zero or more `body-form`s.
|
||||
|
@ -39,3 +39,15 @@ the last one. Before returning, it removes the topmost entry for each
|
|||
local variable from the syms-alist. **If a locally scoped entry was
|
||||
removed manually, the outer scope's corresponding entry will be removed
|
||||
if it exists.**
|
||||
|
||||
## `defun`
|
||||
|
||||
```
|
||||
(defun ({arg}*) {body-form}*)
|
||||
```
|
||||
`defun` defines a new function in Keithlisp. It consists of a list of
|
||||
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.
|
||||
|
|
|
@ -27,3 +27,11 @@ currently defined function.
|
|||
original string of every atom that Keithlisp has parsed. It returns nil
|
||||
if the atoms-alist has been disabled.
|
||||
|
||||
## `fun-set!`
|
||||
```
|
||||
(fun-set! name value)
|
||||
```
|
||||
`fun-set!` directly modifies the funs-alist, creating a new association
|
||||
defining `name` as `value`. It returns the entry it has created. This is
|
||||
more or less the equivalent of `set` for function definitions.
|
||||
|
||||
|
|
|
@ -16,7 +16,7 @@ __attribute__((always_inline)) static inline char* lisp_string_data(lisp_string*
|
|||
char* lisp_string_create(char* str);
|
||||
char* lisp_string_create_raw(char* buf, int len);
|
||||
char* lisp_string_alloc(int len);
|
||||
char* lisp_string_copy(lisp_string* lstr);
|
||||
lisp_string* lisp_string_copy(lisp_string* lstr);
|
||||
int lisp_string_cmp(lisp_string* a_lstr, lisp_string* b_lstr);
|
||||
void lisp_string_print(lisp_string* lstr);
|
||||
|
||||
|
|
104
main.c
104
main.c
|
@ -212,6 +212,16 @@ lisp_atom lisp_defun_native(lisp_string* lstr, lisp_native_fun 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;
|
||||
}
|
||||
|
||||
void lisp_evaluate_value(lisp_value input, lisp_value* result) {
|
||||
if (input.type == LISP_T_ATOM) {
|
||||
if (input.value.atom == atom_t) {
|
||||
|
@ -233,18 +243,22 @@ void lisp_evaluate_value(lisp_value input, lisp_value* result) {
|
|||
void lisp_evaluate(lisp_cons* cons, lisp_value* value) {
|
||||
value->type = LISP_T_CONS;
|
||||
value->value.cons = NULL;
|
||||
|
||||
// can't use a switch here
|
||||
if (cons->car.value.atom == atom_quote) {
|
||||
*value = cons->cdr.value.cons->car;
|
||||
return;
|
||||
}
|
||||
if (cons->car.value.atom == atom_cond) {
|
||||
} else if (cons->car.value.atom == atom_cond) {
|
||||
lisp_sform_cond(cons->cdr.value.cons, value);
|
||||
return;
|
||||
}
|
||||
if (cons->car.value.atom == atom_let) {
|
||||
} else if (cons->car.value.atom == atom_let) {
|
||||
lisp_sform_let(cons->cdr.value.cons, value);
|
||||
return;
|
||||
} else if (cons->car.value.atom == atom_defun) {
|
||||
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");
|
||||
|
@ -276,6 +290,9 @@ void lisp_evaluate(lisp_cons* cons, lisp_value* value) {
|
|||
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");
|
||||
return;
|
||||
|
@ -344,6 +361,84 @@ void lisp_sform_let(lisp_cons* cons, lisp_value* value) {
|
|||
vars_head = vars_head->cdr.value.cons;
|
||||
}
|
||||
}
|
||||
lisp_atom atom_defun;
|
||||
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);
|
||||
value->type = LISP_T_CONS;
|
||||
value->value.cons = fun_data;
|
||||
}
|
||||
|
||||
lisp_cons* recursive_copy(lisp_cons* cons) {
|
||||
lisp_cons* new_cons = dbg_malloc(sizeof(lisp_cons));
|
||||
lisp_cons* new_root = new_cons;
|
||||
while (cons != NULL) {
|
||||
new_cons->car = cons->car;
|
||||
new_cons->cdr = cons->cdr;
|
||||
|
||||
if (cons->car.type == LISP_T_STRING)
|
||||
new_cons->car.value.string = lisp_string_copy(cons->car.value.string);
|
||||
else if (cons->car.type == LISP_T_CONS)
|
||||
new_cons->car.value.cons = recursive_copy(cons->car.value.cons);
|
||||
|
||||
if (cons->cdr.type == LISP_T_STRING)
|
||||
new_cons->cdr.value.string = lisp_string_copy(cons->cdr.value.string);
|
||||
|
||||
if (cons->cdr.type == LISP_T_CONS && cons->cdr.value.cons != NULL) {
|
||||
cons = cons->cdr.value.cons;
|
||||
new_cons->cdr.value.cons = dbg_malloc(sizeof(lisp_cons));
|
||||
new_cons = new_cons->cdr.value.cons;
|
||||
} else {
|
||||
cons = NULL;
|
||||
}
|
||||
}
|
||||
return new_root;
|
||||
}
|
||||
|
||||
void lisp_evaluate_lisp_fun(lisp_cons* fun, lisp_cons* args, lisp_value* value) {
|
||||
// allocate local vars
|
||||
lisp_cons* head = fun->car.value.cons;
|
||||
while (head != NULL) {
|
||||
// create cons pair for new var
|
||||
lisp_cons* pair = dbg_malloc(sizeof(lisp_cons));
|
||||
pair->car.type = LISP_T_ATOM;
|
||||
pair->car.value.atom = head->car.value.atom;
|
||||
pair->cdr = args->car;
|
||||
args = args->cdr.value.cons;
|
||||
// add to alist
|
||||
lisp_cons* new_alist = dbg_malloc(sizeof(lisp_cons));
|
||||
new_alist->car.type = LISP_T_CONS;
|
||||
new_alist->car.value.cons = pair;
|
||||
new_alist->cdr.type = LISP_T_CONS;
|
||||
new_alist->cdr.value.cons = syms_alist;
|
||||
syms_alist = new_alist;
|
||||
|
||||
head = head->cdr.value.cons;
|
||||
}
|
||||
|
||||
// evaluate body
|
||||
head = fun->cdr.value.cons;
|
||||
while (head != NULL) {
|
||||
lisp_evaluate_value(head->car, value);
|
||||
head = head->cdr.value.cons;
|
||||
}
|
||||
|
||||
// delete local vars
|
||||
head = fun->car.value.cons;
|
||||
while (head != NULL) {
|
||||
lisp_value key;
|
||||
if (head->car.type == LISP_T_CONS)
|
||||
key = head->car.value.cons->car;
|
||||
else
|
||||
key = head->car;
|
||||
lisp_cons* pair = lisp_alist_del(&syms_alist, key);
|
||||
dbg_free(pair);
|
||||
|
||||
head = head->cdr.value.cons;
|
||||
}
|
||||
}
|
||||
|
||||
lisp_atom atom_cons;
|
||||
lisp_atom atom_atom;
|
||||
|
@ -362,6 +457,7 @@ int main() {
|
|||
|
||||
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_cons = lisp_atom_init(lisp_string_create("cons"));
|
||||
atom_atom = lisp_atom_init(lisp_string_create("atom"));
|
||||
|
|
6
main.h
6
main.h
|
@ -54,6 +54,7 @@ void print_cons(lisp_cons* cons);
|
|||
void print_value(lisp_value value);
|
||||
|
||||
lisp_atom lisp_defun_native(lisp_string* lstr, lisp_native_fun funptr);
|
||||
lisp_cons* lisp_defun_lisp_fun(lisp_atom atom, lisp_cons* fun);
|
||||
|
||||
void lisp_evaluate_value(lisp_value input, lisp_value* result);
|
||||
void lisp_evaluate(lisp_cons* cons, lisp_value* value);
|
||||
|
@ -61,5 +62,10 @@ extern lisp_atom atom_cond;
|
|||
void lisp_sform_cond(lisp_cons* cons, lisp_value* value);
|
||||
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);
|
||||
lisp_cons* recursive_copy(lisp_cons* cons);
|
||||
|
||||
void lisp_evaluate_lisp_fun(lisp_cons* fun, lisp_cons* args, lisp_value* value);
|
||||
|
||||
#endif
|
||||
|
|
|
@ -641,6 +641,11 @@ void lispf_internals_atoms_alist(lisp_cons* cons, lisp_value* value) {
|
|||
value->value.cons = atoms_alist;
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
void init_native_funs() {
|
||||
// arithmetic
|
||||
lisp_defun_native(lisp_string_create("+"), &lispf_add);
|
||||
|
@ -692,4 +697,5 @@ void init_native_funs() {
|
|||
lisp_defun_native(lisp_string_create("syms-alist!"), &lispf_internals_syms_alist);
|
||||
lisp_defun_native(lisp_string_create("funs-alist!"), &lispf_internals_funs_alist);
|
||||
lisp_defun_native(lisp_string_create("atoms-alist!"), &lispf_internals_atoms_alist);
|
||||
lisp_defun_native(lisp_string_create("fun-set!"), &lispf_internals_fun_set);
|
||||
}
|
||||
|
|
|
@ -51,6 +51,7 @@ void lispf_print(lisp_cons* cons, lisp_value* value);
|
|||
void lispf_internals_syms_alist(lisp_cons* cons, lisp_value* value);
|
||||
void lispf_internals_funs_alist(lisp_cons* cons, lisp_value* value);
|
||||
void lispf_internals_atoms_alist(lisp_cons* cons, lisp_value* value);
|
||||
void lispf_internals_fun_set(lisp_cons* cons, lisp_value* value);
|
||||
|
||||
void init_native_funs();
|
||||
#endif
|
||||
|
|
Loading…
Reference in a new issue