add let special form

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.**

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
+`set` changes the value associated with `atom` in the syms-alist, or
-the association if it does not already exist. It returns `value`.
+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
+`fun` returns the function associated with `atom` in the funs-alist, or
-if no such function exists.
+nil if no such function exists.

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) {
+		vars_head = vars_head->cdr.value.cons;
-	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;
 	}
-	lisp_cons* new_alist = dbg_malloc(sizeof(lisp_cons));
+	// evaluate body
-	lisp_cons* pair = dbg_malloc(sizeof(lisp_cons));
+	lisp_cons* body_head = cons->cdr.value.cons;
-	pair->car = key;
+	while (body_head != NULL) {
-	pair->cdr = *value;
+		lisp_evaluate_value(body_head->car, value);
-	new_alist->car.type = LISP_T_CONS;
+		body_head = body_head->cdr.value.cons;
-	new_alist->car.value.cons = pair;
+	}
-	new_alist->cdr.type = LISP_T_CONS;
+	// delete local vars
-	new_alist->cdr.value.cons = syms_alist;
+	vars_head = cons->car.value.cons;
-	syms_alist = new_alist;
+	while (vars_head != NULL) {
-	return;
+		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) {
+		vars_head = vars_head->cdr.value.cons;
-	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;
 }
 
 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);
 

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

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);
 }

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

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;