keith
/
keithlisp
1
0
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

add let special form

This commit is contained in:
~keith 2021-09-23 12:57:26 -04:00
parent 601451e9a9
commit b8cfcc21e1
7 changed files with 128 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
doc/stdlib_forms.md
View File

@ -20,3 +20,22 @@ non-nil, `cond` skips all remaining clauses, evaluates each `body-form`,
and returns the result of the last one (or the result of `test` if the
clause has no `body-form`s). Otherwise, if all `test`s evaluate to nil,
or no clauses were given, `cond` returns nil.
## `let`
```
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.
For each variable definition, `let` evaluates `value` if it exists, and
initializes `var` to the result. If `value` does not exist, nil is used
instead. If a variable named `var` exists outside the scope of `let`, it
will be preserved in the syms-alist, but hidden underneath the locally
scoped entry.
`let` evaluates each `body-form` in sequence and returns the result of
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.**

9
doc/stdlib_misc.md
View File

@ -20,12 +20,13 @@ interpreted as a signed 2's-complement integer.
```
(set atom value)
```
`set` changes the value associated with `atom` in syms-alist, or creates
the association if it does not already exist. It returns `value`.
`set` changes the value associated with `atom` in the syms-alist, or
creates the association if it does not already exist. It then returns
`value`.
## `fun`
```
(fun atom)
```
`fun` returns the function associated with `atom` in funs-alist, or nil
if no such function exists.
`fun` returns the function associated with `atom` in the funs-alist, or
nil if no such function exists.

79
main.c
View File

@ -121,6 +121,7 @@ lisp_cons* lisp_alist_del(lisp_cons** alist, lisp_value key) {
alist_prev->cdr = alist_cur->cdr;
else if (alist_cur->cdr.type == LISP_T_CONS)
*alist = alist_cur->cdr.value.cons;
dbg_free(alist_cur);
return pair;
}
next:
@ -230,6 +231,8 @@ void lisp_evaluate_value(lisp_value input, lisp_value* result) {
*result = input;
}
void lisp_evaluate(lisp_cons* cons, lisp_value* value) {
value->type = LISP_T_CONS;
value->value.cons = NULL;
if (cons->car.value.atom == atom_quote) {
*value = cons->cdr.value.cons->car;
return;
@ -238,11 +241,13 @@ void lisp_evaluate(lisp_cons* cons, lisp_value* value) {
lisp_sform_cond(cons->cdr.value.cons, value);
return;
}
if (cons->car.value.atom == atom_let) {
lisp_sform_let(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");
value->type = LISP_T_CONS;
value->value.cons = NULL;
return;
}
lisp_cons* args = NULL;
@ -273,8 +278,6 @@ void lisp_evaluate(lisp_cons* cons, lisp_value* value) {
}
} else {
fprintf(stderr, "EVAL ERROR! (not a native-fun)\n");
value->type = LISP_T_CONS;
value->value.cons = NULL;
return;
}
}
@ -296,35 +299,50 @@ void lisp_sform_cond(lisp_cons* cons, lisp_value* value) {
value->type = LISP_T_CONS;
value->value.cons = NULL;
}
lisp_atom atom_let;
void lisp_sform_let(lisp_cons* cons, lisp_value* value) {
// allocate local vars
lisp_cons* vars_head = cons->car.value.cons;
while (vars_head != NULL) {
// create cons pair for new var
lisp_cons* pair = dbg_malloc(sizeof(lisp_cons));
if (vars_head->car.type == LISP_T_CONS) {
pair->car = vars_head->car.value.cons->car;
lisp_evaluate_value(vars_head->car.value.cons->cdr.value.cons->car, &pair->cdr);
} else {
pair->car = vars_head->car;
pair->cdr.type = LISP_T_CONS;
pair->cdr.value.cons = NULL;
}
// 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;
void lisp_set(lisp_cons* cons, lisp_value* value) {
lisp_value key = cons->car;
*value = cons->cdr.value.cons->car;
lisp_cons** pairptr = lisp_alist_getptr(syms_alist, key);
if (pairptr != NULL) {
(*pairptr)->cdr = *value;
return;
vars_head = vars_head->cdr.value.cons;
}
lisp_cons* new_alist = dbg_malloc(sizeof(lisp_cons));
lisp_cons* pair = dbg_malloc(sizeof(lisp_cons));
pair->car = key;
pair->cdr = *value;
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;
return;
}
// evaluate body
lisp_cons* body_head = cons->cdr.value.cons;
while (body_head != NULL) {
lisp_evaluate_value(body_head->car, value);
body_head = body_head->cdr.value.cons;
}
// delete local vars
vars_head = cons->car.value.cons;
while (vars_head != NULL) {
lisp_value key;
if (vars_head->car.type == LISP_T_CONS)
key = vars_head->car.value.cons->car;
else
key = vars_head->car;
lisp_cons* pair = lisp_alist_del(&syms_alist, key);
dbg_free(pair);
void lisp_fun(lisp_cons* cons, lisp_value* value) {
lisp_cons* pair = lisp_alist_get(funs_alist, cons->car);
if (pair == NULL) {
value->type = LISP_T_CONS;
value->value.cons = NULL;
return;
vars_head = vars_head->cdr.value.cons;
}
*value = pair->cdr;
}
lisp_atom atom_cons;
@ -343,6 +361,7 @@ int main() {
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_cons = lisp_atom_init(lisp_string_create("cons"));
atom_atom = lisp_atom_init(lisp_string_create("atom"));
@ -352,8 +371,6 @@ int main() {
atom_native_fun = lisp_atom_init(lisp_string_create("native-fun"));
init_native_funs();
lisp_defun_native(lisp_string_create("set"), &lisp_set);
lisp_defun_native(lisp_string_create("fun"), &lisp_fun);
printf("Init: %4liB used\n", dbg_malloc_mem_usage);

2
main.h
View File

@ -59,5 +59,7 @@ void lisp_evaluate_value(lisp_value input, lisp_value* result);
void lisp_evaluate(lisp_cons* cons, lisp_value* value);
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);
#endif

36
native_funs.c
View File

@ -394,6 +394,40 @@ void lisp_addr_of(lisp_cons* cons, lisp_value* value) {
value->value._int = (long) cons->car.value.cons;
}
void lisp_set(lisp_cons* cons, lisp_value* value) {
// extract key and value
lisp_value key = cons->car;
*value = cons->cdr.value.cons->car;
lisp_cons** pairptr = lisp_alist_getptr(syms_alist, key);
if (pairptr != NULL) {
// just overwrite cdr, don't make a new pair
(*pairptr)->cdr = *value;
return;
}
// create cons pair for new var
lisp_cons* pair = dbg_malloc(sizeof(lisp_cons));
pair->car = key;
pair->cdr = *value;
// 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;
return;
}
void lisp_fun(lisp_cons* cons, lisp_value* value) {
lisp_cons* pair = lisp_alist_get(funs_alist, cons->car);
if (pair == NULL) {
value->type = LISP_T_CONS;
value->value.cons = NULL;
return;
}
*value = pair->cdr;
}
void init_native_funs() {
// arithmetic
lisp_defun_native(lisp_string_create("+"), &lisp_add);
@ -418,4 +452,6 @@ void init_native_funs() {
// etc
lisp_defun_native(lisp_string_create("type-of"), &lisp_type_of);
lisp_defun_native(lisp_string_create("addr-of"), &lisp_addr_of);
lisp_defun_native(lisp_string_create("set"), &lisp_set);
lisp_defun_native(lisp_string_create("fun"), &lisp_fun);
}

2
native_funs.h
View File

@ -27,6 +27,8 @@ void lisp_num_ge(lisp_cons* cons, lisp_value* value);
void lisp_type_of(lisp_cons* cons, lisp_value* value);
void lisp_addr_of(lisp_cons* cons, lisp_value* value);
void lisp_set(lisp_cons* cons, lisp_value* value);
void lisp_fun(lisp_cons* cons, lisp_value* value);
void init_native_funs();
#endif

27
parse.c
View File

@ -92,23 +92,31 @@ bool lisp_parse_number(lisp_string* token_lstr, lisp_value* value) {
float weight = 0.1f;
int exp_i = 0;
int exp = 0;
int base = 10;
for (int i = 0; i < token_len; i++) {
char c = token_data[i];
if (c >= 'a')
c = c - ('a' - 'A');
if (!exp_mode) {
if (c == '-' && i == 0) {
neg = true;
} else if (c >= '0' && c <= '9') {
valid = true;
if (!point)
_int = (_int * 10) + (c - '0');
_int = (_int * base) + (c - '0');
else {
_float += ((c - '0') * weight);
weight /= 10.0f;
}
} else if (c >= 'A' && c <= 'F' && base == 16) {
valid = true;
_int = (_int * base) + (c - ('A' - 10));
} else if (c == 'X') {
base = 16;
} else if (c == '.' && !point) {
point = true;
_float = (float) _int;
} else if (c == 'e' || c == 'E') {
} else if (c == 'E') {
valid = false;
exp_mode = true;
if (!point)
@ -169,24 +177,21 @@ bool lisp_parse_string(lisp_string* token_lstr, lisp_value* value) {
if (esc_mode) {
esc_mode = false;
switch (c) {
case 'b':
lstr_data[lstr_len++] = '\b';
break;
case 'e':
lstr_data[lstr_len++] = '\e';
break;
case 'f':
lstr_data[lstr_len++] = '\f';
break;
case 'n':
lstr_data[lstr_len++] = '\n';
break;
case 'r':
lstr_data[lstr_len++] = '\r';
break;
case 'n':
lstr_data[lstr_len++] = '\n';
break;
case 't':
lstr_data[lstr_len++] = '\t';
break;
case 'f':
lstr_data[lstr_len++] = '\f';
break;
case 'v':
lstr_data[lstr_len++] = '\v';
break;