#include "scope.h" #include "lisp.h" #include "uclisp.h" #include "utility.h" #include "internal.h" #include // TODO: Macro support? struct ucl_object *ucl_special_let(struct ucl_scope *scope, struct ucl_object *args) { // TODO: Check arguments struct ucl_object *assignments = ucl_car(args); struct ucl_object *expressions = ucl_cdr(args); struct ucl_scope *let_scope = ucl_scope_create_child(scope); FOREACH_LIST(assignments, iter, item) { // TODO: Check arguments struct ucl_object *sym = ucl_car(item); struct ucl_object *expr = ucl_car(ucl_cdr(item)); struct ucl_object *value = ucl_evaluate(let_scope, expr); assert(sym->type == UCL_TYPE_SYMBOL); //assert(ucl_list_length(expr)->integer == 1); if (value->type == UCL_TYPE_ERROR) { ucl_scope_delete(let_scope); return value; } ucl_scope_put(let_scope, sym->symbol, value); } struct ucl_object *result = ucl_progn(let_scope, expressions); ucl_scope_delete(let_scope); return result; } struct ucl_object *ucl_special_if(struct ucl_scope *scope, struct ucl_object *args) { // TODO: Check arguments struct ucl_object *cond = ucl_car(args); struct ucl_object *true_form = ucl_list_nth(args, 1); struct ucl_object *false_forms = ucl_cdr(ucl_cdr(args)); struct ucl_object *cond_result = ucl_evaluate(scope, cond); UCL_RET_IF_ERROR(cond_result); if (ucl_truthy(cond_result)->type == UCL_TYPE_SYMBOL) { return ucl_evaluate(scope, true_form); } return ucl_progn(scope, false_forms); } struct ucl_object *ucl_special_defun(struct ucl_scope *scope, struct ucl_object *args) { // TODO: Check arguments struct ucl_object *fun_sym = ucl_car(args); if (fun_sym->type != UCL_TYPE_SYMBOL) { return ucl_error_create("First argument to defun must be a symbol"); } struct ucl_object *fun_args = ucl_list_nth(args, 1); if (fun_args->type != UCL_TYPE_CELL) { // TODO: Check that the list contains only symbols return ucl_error_create("Second argument to defun must be a list of symbols"); } // For now, other elements are just forms to be evaluated. Maybe one day // there will be docstrings, maybe not! // Functions are added to the root scope ucl_scope_put(ucl_scope_get_root(scope), fun_sym->symbol, ucl_cdr(args)); return fun_sym; } struct ucl_object *ucl_special_lambda(struct ucl_scope *scope, struct ucl_object *args) { // TODO: Check arguments struct ucl_object *fun_args = ucl_list_nth(args, 0); if (fun_args->type != UCL_TYPE_CELL) { // TODO: Check that the list contains only symbols return ucl_error_create("First argument to lambda must be a list of symbols"); } return args; } struct ucl_object *ucl_special_dotimes(struct ucl_scope *scope, struct ucl_object *args) { // TODO: Check arguments struct ucl_object *assignment = ucl_car(args); struct ucl_object *body = ucl_cdr(args); struct ucl_object *var = ucl_car(assignment); struct ucl_object *times = ucl_evaluate(scope, ucl_list_nth(assignment, 1)); UCL_COND_OR_RET_ERROR(var->type == UCL_TYPE_SYMBOL, "'var' argument to dotimes must be an symbol"); UCL_COND_OR_RET_ERROR(times->type == UCL_TYPE_INT, "'times' argument to dotimes must be an int"); struct ucl_scope *let_scope = ucl_scope_create_child(scope); for (int i = 0; i < times->integer; i++) { ucl_scope_put(let_scope, var->symbol, ucl_int_create(i)); struct ucl_object *iterval = ucl_progn(let_scope, body); UCL_RET_IF_ERROR(iterval); } return ucl_nil_create(); } struct ucl_object *ucl_special_dolist(struct ucl_scope *scope, struct ucl_object *args) { // TODO: Check arguments struct ucl_object *assignment = ucl_car(args); struct ucl_object *body = ucl_cdr(args); struct ucl_object *var = ucl_car(assignment); struct ucl_object *list = ucl_evaluate(scope, ucl_list_nth(assignment, 1)); UCL_COND_OR_RET_ERROR(var->type == UCL_TYPE_SYMBOL, "'var' argument to dolist must be an symbol"); UCL_COND_OR_RET_ERROR(list->type == UCL_TYPE_CELL, "'list' argument to dolist must be a list"); struct ucl_scope *let_scope = ucl_scope_create_child(scope); FOREACH_LIST(list, iter, item) { ucl_scope_put(let_scope, var->symbol, item); struct ucl_object *iterval = ucl_progn(let_scope, body); if (iterval->type == UCL_TYPE_ERROR) { ucl_scope_delete(let_scope); } UCL_RET_IF_ERROR(iterval); } return ucl_nil_create(); } struct ucl_object *ucl_special_while(struct ucl_scope *scope, struct ucl_object *args) { // TODO: Check arguments struct ucl_object *condition = ucl_car(args); struct ucl_object *body = ucl_cdr(args); while (1) { struct ucl_object* cond_val = ucl_evaluate(scope, condition); UCL_RET_IF_ERROR(cond_val); if (!ucl_truthy_bool(cond_val)) { return ucl_nil_create(); } struct ucl_object *val = ucl_progn(scope, body); UCL_RET_IF_ERROR(val); } } struct ucl_object *ucl_special_setq(struct ucl_scope *scope, struct ucl_object *args) { // TODO: Check arguments struct ucl_object *sym = ucl_car(args); if (sym->type != UCL_TYPE_SYMBOL) { return ucl_error_create("First argument to setq must be a symbol"); } struct ucl_object *value = ucl_evaluate(scope, ucl_list_nth(args, 1)); UCL_RET_IF_ERROR(value); ucl_scope_put(scope, sym->symbol, value); return value; } struct ucl_object *ucl_special_progn(struct ucl_scope *scope, struct ucl_object *args) { return ucl_progn(scope, args); } struct ucl_object *ucl_special_quote(struct ucl_scope *scope, struct ucl_object *args) { return ucl_car(args); } struct ucl_object *ucl_special_and(struct ucl_scope *scope, struct ucl_object *args) { struct ucl_object *value = ucl_t_create(); FOREACH_LIST(args, iter, form) { value = ucl_evaluate(scope, form); if (!ucl_truthy_bool(value)) { return value; } } return value; } struct ucl_object *ucl_special_or(struct ucl_scope *scope, struct ucl_object *args) { struct ucl_object *value = ucl_nil_create(); FOREACH_LIST(args, iter, form) { value = ucl_evaluate(scope, form); if (ucl_truthy_bool(value)) { return value; } } return value; }