diff --git a/doc/stdlib_forms.md b/doc/stdlib_forms.md index a60d315..b493cd1 100644 --- a/doc/stdlib_forms.md +++ b/doc/stdlib_forms.md @@ -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.** diff --git a/doc/stdlib_misc.md b/doc/stdlib_misc.md index b4b631a..fd76fe1 100644 --- a/doc/stdlib_misc.md +++ b/doc/stdlib_misc.md @@ -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. diff --git a/main.c b/main.c index 0b914d7..522bcc5 100644 --- a/main.c +++ b/main.c @@ -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); diff --git a/main.h b/main.h index 7d43580..01bbcf8 100644 --- a/main.h +++ b/main.h @@ -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 diff --git a/native_funs.c b/native_funs.c index d4e41a7..e58f1e7 100644 --- a/native_funs.c +++ b/native_funs.c @@ -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); } diff --git a/native_funs.h b/native_funs.h index a340391..043b1c0 100644 --- a/native_funs.h +++ b/native_funs.h @@ -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 diff --git a/parse.c b/parse.c index 5c98c4b..06258b1 100644 --- a/parse.c +++ b/parse.c @@ -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;