#include "internal.h" #include "lisp.h" #include "uclisp.h" #include "utility.h" #include #include #include #include #include struct ucl_object *ucl_car(struct ucl_object *list) { UCL_COND_OR_RET_ERROR( list != NULL && list->type == UCL_TYPE_CELL, "Invalid type of argument 0 to 'ucl_car'"); struct ucl_object *car = list->cell.car; if (car == NULL) { return ucl_nil_create(); } return car; } struct ucl_object *ucl_cdr(struct ucl_object *list) { UCL_COND_OR_RET_ERROR( list != NULL && list->type == UCL_TYPE_CELL, "Invalid type of argument 0 to 'ucl_cdr'"); struct ucl_object *cdr = list->cell.cdr; if (cdr == NULL) { return ucl_nil_create(); } return cdr; } struct ucl_object *ucl_nil_create() { return ucl_cell_create(NULL, NULL); } struct ucl_object *ucl_t_create() { return ucl_symbol_create("t"); } struct ucl_object *ucl_predicate(bool value) { if (value) { return ucl_t_create(); } else { return ucl_nil_create(); } } struct ucl_object *ucl_list_length(struct ucl_object *list) { UCL_COND_OR_RET_ERROR( list != NULL && list->type == UCL_TYPE_CELL, "Invalid type of argument 0 to 'ucl_list_length'"); struct ucl_object *node = list; if (list->cell.car == NULL) { return ucl_int_create(0); } int length = 1; while (node->cell.cdr != NULL) { node = node->cell.cdr; length++; } return ucl_int_create(length); } 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_nth'"); int length = ucl_list_length(list)->integer; UCL_COND_OR_RET_ERROR(length > n, "Position n >= list length in ucl_list_nth"); struct ucl_object *node = list; for (int i = 0; i < n; i++) { node = node->cell.cdr; } return node->cell.car; } bool ucl_truthy_bool(struct ucl_object *obj) { // TODO: Implement me better if (obj->type == UCL_TYPE_INT) { return obj->integer; } else if (obj->type == UCL_TYPE_SYMBOL) { return true; } else if (obj->type == UCL_TYPE_CELL) { return obj->cell.car != NULL; } assert(0); return false; } struct ucl_object *ucl_truthy(struct ucl_object *obj) { return ucl_predicate(ucl_truthy_bool(obj)); } struct ucl_object *ucl_tuple_create(struct ucl_object *obj0, struct ucl_object *obj1) { struct ucl_object *tuple = ucl_cell_create(obj0, NULL); ucl_list_append(tuple, obj1); return tuple; } struct ucl_object *ucl_list_append(struct ucl_object *list, struct ucl_object *obj) { struct ucl_object *iter = list; if (list->cell.car == NULL) { list->cell.car = obj; return list; } while (iter->cell.cdr != NULL) { iter = iter->cell.cdr; } iter->cell.cdr = ucl_cell_create(obj, NULL); return list; } void ucl_print_obj(struct ucl_object *obj) { switch (obj->type) { case UCL_TYPE_SYMBOL: printf("%s", obj->symbol); break; case UCL_TYPE_INT: printf("%d", obj->integer); break; case UCL_TYPE_STRING: printf("\"%s\"", obj->string); break; case UCL_TYPE_ERROR: printf("(error \"%s\")", obj->error); break; case UCL_TYPE_BUILTIN: printf("", obj->builtin); break; case UCL_TYPE_CELL: { int first = true; printf("%s", "("); FOREACH_LIST(obj, iter, item) { if (!first) { printf(" "); } ucl_print_obj(item); first = false; } printf("%s", ")"); break; } case UCL_TYPE_COUNT: assert(0); } } struct ucl_object *ucl_progn(struct ucl_state *state, struct ucl_object *forms) { struct ucl_object *result = NULL; FOREACH_LIST(forms, iter, form) { result = ucl_evaluate(state, form); if (result->type == UCL_TYPE_ERROR) { return result; } } return (result == NULL) ? ucl_nil_create() : result; } struct ucl_object *ucl_equal( struct ucl_object *arg0, struct ucl_object *arg1) { if (arg0->type != arg1->type) { return ucl_nil_create(); } switch (arg0->type) { case UCL_TYPE_INT: return ucl_predicate(arg0->integer == arg1->integer); case UCL_TYPE_SYMBOL: return ucl_predicate(!strcmp(arg0->symbol, arg1->symbol)); case UCL_TYPE_CELL: { struct ucl_object *car_equal = ucl_equal(arg0->cell.car, arg1->cell.car); if (!ucl_truthy(car_equal)) { return car_equal; } return ucl_equal(arg0->cell.cdr, arg1->cell.cdr); } case UCL_TYPE_BUILTIN: return ucl_predicate(arg0->special == arg1->builtin); case UCL_TYPE_SPECIAL: return ucl_predicate(arg0->special == arg1->builtin); case UCL_TYPE_STRING: return ucl_predicate(!strcmp(arg0->string, arg1->string)); case UCL_TYPE_ERROR: case UCL_TYPE_COUNT: return ucl_error_create(""); } }