max/uclisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add mapcar builtin, more tests, fixes

Browse Source
This commit is contained in:
Max Regan
2022-11-05 20:47:33 -04:00
parent f9ace289f1
commit 4da62ad2da
7 changed files with 144 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
src/builtins.c
View File

@@ -182,3 +182,15 @@ struct ucl_object *ucl_builtin_list(struct ucl_state *state, struct ucl_object *
return head;
}
LISP_FUNC_2(ucl_builtin_mapcar, state, fun, elems) {
// TODO: Support arbitrary number of 'elems' lists
struct ucl_object *result = ucl_nil_create();
FOREACH_LIST(elems, iter, elem) {
struct ucl_object *form = ucl_tuple_create(fun, elem);
struct ucl_object *value = ucl_evaluate(state, form);
UCL_RET_IF_ERROR(value);
ucl_list_append(result, value);
}
return result;
}

2
src/builtins.h
View File

@@ -23,6 +23,8 @@ struct ucl_object *ucl_builtin_car(struct ucl_state *state, struct ucl_object *a
struct ucl_object *ucl_builtin_cdr(struct ucl_state *state, struct ucl_object *args);
struct ucl_object *ucl_builtin_nth(struct ucl_state *state, struct ucl_object *args);
struct ucl_object *ucl_builtin_list(struct ucl_state *state, struct ucl_object *args);
struct ucl_object *ucl_builtin_mapcar(struct ucl_state *state, struct ucl_object *args);
struct ucl_object *ucl_builtin_print(struct ucl_state *state, struct ucl_object *args);
struct ucl_object *ucl_builtin_printl(struct ucl_state *state, struct ucl_object *args);

22
src/evaluate.c
View File

@@ -15,6 +15,7 @@ struct ucl_object *ucl_evaluate_builtin_form(struct ucl_state *state, struct ucl
FOREACH_LIST(list, iter, item) {
struct ucl_object *obj = ucl_evaluate(state, item);
UCL_RET_IF_ERROR(obj);
ucl_list_append(evaluated_list, obj);
};
@@ -47,20 +48,7 @@ struct ucl_object *ucl_evaluate_special_form(struct ucl_state *state, struct ucl
// TODO: Recursively eval args
const char *fun_sym = ucl_car(list)->symbol;
struct ucl_object *fun = ucl_state_get(state, ucl_car(list)->symbol);
struct ucl_object *args = ucl_cdr(list);
struct ucl_object *result = NULL;
result = fun->special(state, args);
return result;
}
struct ucl_object *ucl_evaluate_lisp_form(struct ucl_state *state, struct ucl_object *list) {
// TODO: Recursively eval args
const char *fun_sym = ucl_car(list)->symbol;
struct ucl_object *fun = ucl_state_get(state, ucl_car(list)->symbol);
struct ucl_object *fun = ucl_state_get(state, fun_sym);
struct ucl_object *args = ucl_cdr(list);
struct ucl_object *result = NULL;
@@ -74,11 +62,7 @@ struct ucl_object *ucl_evaluate_list(struct ucl_state *state, struct ucl_object
return list;
}
struct ucl_object *fun_sym = ucl_car(list);
if (fun_sym->type != UCL_TYPE_SYMBOL) {
return ucl_error_create("Unknown function symbol");
}
struct ucl_object *fun = ucl_state_get(state, fun_sym->symbol);
struct ucl_object *fun = ucl_evaluate(state, ucl_car(list));
UCL_RET_IF_ERROR(fun);
if (fun->type == UCL_TYPE_SPECIAL) {

5
src/main.c
View File

@@ -26,7 +26,6 @@ int main(int argc, const char **argv) {
ucl_state_put(state, "print", ucl_builtin_create(ucl_builtin_print));
ucl_state_put(state, "printl", ucl_builtin_create(ucl_builtin_printl));
ucl_state_put(state, "list", ucl_builtin_create(ucl_builtin_list));
// TODO:
// - object -> string
// - formatted printing?
@@ -47,9 +46,13 @@ int main(int argc, const char **argv) {
ucl_state_put(state, "string-p", ucl_builtin_create(ucl_builtin_string_p));
ucl_state_put(state, "int-p", ucl_builtin_create(ucl_builtin_int_p));
ucl_state_put(state, "list-p", ucl_builtin_create(ucl_builtin_list_p));
ucl_state_put(state, "list", ucl_builtin_create(ucl_builtin_list));
ucl_state_put(state, "car", ucl_builtin_create(ucl_builtin_car));
ucl_state_put(state, "cdr", ucl_builtin_create(ucl_builtin_cdr));
ucl_state_put(state, "nth", ucl_builtin_create(ucl_builtin_nth));
ucl_state_put(state, "mapcar", ucl_builtin_create(ucl_builtin_mapcar));
// TODO:
// - equality
// - map

4
src/special.c
View File

@@ -27,7 +27,7 @@ struct ucl_object *ucl_special_let(struct ucl_state *state, struct ucl_object *a
ucl_state_put(let_state, sym->symbol, value);
}
struct ucl_object *result = ucl_progn(state, expressions);
struct ucl_object *result = ucl_progn(let_state, expressions);
ucl_state_delete(let_state);
return result;
}
@@ -95,7 +95,7 @@ struct ucl_object *ucl_special_setq(struct ucl_state *state, struct ucl_object *
ucl_state_put(root_state, sym->symbol, value);
return sym;
return value;
}
struct ucl_object *ucl_special_progn(struct ucl_state *state, struct ucl_object *args) {

2
src/utility.c
View File

@@ -73,7 +73,7 @@ struct ucl_object *ucl_list_length(struct ucl_object *list) {
struct ucl_object *ucl_list_nth(struct ucl_object *list, int n) {
UCL_COND_OR_RET_ERROR(
list != NULL && list->type == UCL_TYPE_CELL,
"Invalid type of argument 0 to 'ucl_list_'");
"Invalid type of argument 0 to 'ucl_list_nth'");
int length = ucl_list_length(list)->integer;
UCL_COND_OR_RET_ERROR(length > n, "Position n >= list length in ucl_list_nth");

120
test/test_e2e.c
View File

@@ -24,6 +24,13 @@ void setUp(void) {
ucl_state_put(state, "+", ucl_builtin_create(ucl_builtin_add));
ucl_state_put(state, "error", ucl_builtin_create(ucl_builtin_error));
ucl_state_put(state, "list", ucl_builtin_create(ucl_builtin_list));
ucl_state_put(state, "setq", ucl_special_create(ucl_special_setq));
ucl_state_put(state, "car", ucl_builtin_create(ucl_builtin_car));
ucl_state_put(state, "cdr", ucl_builtin_create(ucl_builtin_cdr));
ucl_state_put(state, "nth", ucl_builtin_create(ucl_builtin_nth));
ucl_state_put(state, "mapcar", ucl_builtin_create(ucl_builtin_mapcar));
ucl_state_put(state, "lambda", ucl_special_create(ucl_special_lambda));
ucl_state_put(state, "quote", ucl_special_create(ucl_special_quote));
}
void tearDown(void) {
@@ -130,6 +137,108 @@ void test_eval_defun(void) {
TEST_ASSERT_EQUAL_STRING(response->symbol, "foo");
}
void test_call_function(void) {
response = eval("(defun foo (a b) (+ a b))");
TEST_ASSERT_OBJ_SYMBOL(response);
TEST_ASSERT_EQUAL_STRING(response->symbol, "foo");
response = eval("(foo 2 3)");
TEST_ASSERT_OBJ_INT(response);
TEST_ASSERT_EQUAL(response->integer, 5);
}
void test_setq(void) {
response = eval("(setq bar 2)");
TEST_ASSERT_OBJ_INT(response);
TEST_ASSERT_EQUAL(response->symbol, 2);
response = eval("bar");
TEST_ASSERT_OBJ_INT(response);
TEST_ASSERT_EQUAL(response->symbol, 2);
}
void test_setq_from_function(void) {
response = eval("(defun foo (a) (setq bar a))");
TEST_ASSERT_OBJ_SYMBOL(response);
TEST_ASSERT_EQUAL_STRING(response->symbol, "foo");
response = eval("(foo 2)");
TEST_ASSERT_OBJ_INT(response);
TEST_ASSERT_EQUAL(response->symbol, 2);
response = eval("bar");
TEST_ASSERT_OBJ_INT(response);
TEST_ASSERT_EQUAL(response->symbol, 2);
}
void test_lambda(void) {
response = eval("((lambda (x) (+ x 2)) 2)");
TEST_ASSERT_OBJ_INT(response);
TEST_ASSERT_EQUAL(response->integer, 4);
}
void test_mapcar_lambda(void) {
response = eval("(car (mapcar (quote (lambda (x) (+ x 2))) (list 5)))");
TEST_ASSERT_OBJ_INT(response);
TEST_ASSERT_EQUAL(response->integer, 7);
}
void test_mapcar_function(void) {
response = eval("(defun foo (a) (+ a 2))");
TEST_ASSERT_OBJ_SYMBOL(response);
TEST_ASSERT_EQUAL_STRING(response->symbol, "foo");
response = eval("(car (mapcar (quote foo) (list 5)))");
TEST_ASSERT_OBJ_INT(response);
TEST_ASSERT_EQUAL(response->integer, 7);
}
void test_car(void) {
response = eval("(car (list 2 3 4))");
TEST_ASSERT_OBJ_INT(response);
TEST_ASSERT_EQUAL(response->integer, 2);
}
void test_cdr(void) {
response = eval("(car (cdr (list 2 3 4)))");
TEST_ASSERT_OBJ_INT(response);
TEST_ASSERT_EQUAL(response->integer, 3);
}
void test_nth_0(void) {
response = eval("(nth 0 (list 2 3 4))");
TEST_ASSERT_OBJ_INT(response);
TEST_ASSERT_EQUAL(response->integer, 2);
}
void test_nth_1(void) {
response = eval("(nth 1 (list 2 3 4))");
TEST_ASSERT_OBJ_INT(response);
TEST_ASSERT_EQUAL(response->integer, 3);
}
void test_nth_oob(void) {
response = eval("(nth 3 (list 2 3 4))");
TEST_ASSERT_OBJ_ERROR(response);
}
int main(void) {
UNITY_BEGIN();
@@ -147,6 +256,17 @@ int main(void) {
RUN_TEST(test_eval_nested_error);
RUN_TEST(test_eval_list);
RUN_TEST(test_eval_defun);
RUN_TEST(test_call_function);
RUN_TEST(test_setq);
RUN_TEST(test_setq_from_function);
RUN_TEST(test_lambda);
RUN_TEST(test_mapcar_lambda);
RUN_TEST(test_car);
RUN_TEST(test_cdr);
RUN_TEST(test_nth_0);
RUN_TEST(test_nth_1);
RUN_TEST(test_nth_oob);
return UNITY_END();
}