#include "uclisp.h" #include "internal.h" #include "utility.h" #include "builtins.h" #include "scope.h" #include "lisp.h" #include #include #include #include #include LISP_FUNC_1(ucl_builtin_type, scope, arg) { switch (arg->type) { case UCL_TYPE_CELL: return ucl_symbol_create("list"); case UCL_TYPE_SYMBOL: return ucl_symbol_create("symbol"); case UCL_TYPE_INT: return ucl_symbol_create("int"); case UCL_TYPE_STRING: return ucl_symbol_create("string"); case UCL_TYPE_ERROR: return ucl_symbol_create("error"); case UCL_TYPE_BUILTIN: return ucl_symbol_create("builtin"); case UCL_TYPE_SPECIAL: return ucl_symbol_create("special"); case UCL_TYPE_COUNT: assert(0); return NULL; } assert(0); return ucl_error_create("Unreachable error in 'ucl_builtin_type'"); } LISP_FUNC_1(ucl_builtin_error, scope, arg) { if (arg->type != UCL_TYPE_STRING) { return ucl_error_create("Expected type string passed to 'error'"); } return ucl_error_create(arg->error); } LISP_FUNC_1(ucl_builtin_symbol_p, scope, arg) { return ucl_predicate(arg->type == UCL_TYPE_SYMBOL); } LISP_FUNC_1(ucl_builtin_string_p, scope, arg) { return ucl_predicate(arg->type == UCL_TYPE_STRING); } LISP_FUNC_1(ucl_builtin_int_p, scope, arg) { return ucl_predicate(arg->type == UCL_TYPE_INT); } LISP_FUNC_1(ucl_builtin_list_p, scope, arg) { return ucl_predicate(arg->type == UCL_TYPE_CELL); } LISP_FUNC_1(ucl_builtin_error_p, scope, arg) { return ucl_predicate(arg->type == UCL_TYPE_ERROR); } LISP_FUNC_1(ucl_builtin_car, scope, arg) { return ucl_car(arg); } LISP_FUNC_1(ucl_builtin_cdr, scope, arg) { return ucl_cdr(arg); } LISP_FUNC_2(ucl_builtin_nth, scope, n, list) { UCL_COND_OR_RET_ERROR(n->type == UCL_TYPE_INT, "First argument to nth must be an integer"); UCL_COND_OR_RET_ERROR(list->type == UCL_TYPE_CELL, "Second argument to nth must be a list"); return ucl_list_nth(list, n->integer); } LISP_FUNC_2(ucl_builtin_add, scope, arg0, arg1) { if (arg0->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 0 to 'add'"); } if (arg1->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 1 to 'add'"); } return ucl_int_create(arg0->integer + arg1->integer); } LISP_FUNC_2(ucl_builtin_sub, scope, arg0, arg1) { if (arg0->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 0 to 'sub'"); } if (arg1->type != UCL_TYPE_INT) { return ucl_error_create(("Invalid type of argument 1 to 'sub'")); } return ucl_int_create(arg0->integer - arg1->integer); } LISP_FUNC_2(ucl_builtin_mul, scope, arg0, arg1) { if (arg0->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 0 to 'mul'"); } if (arg1->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 1 to 'mul'"); } return ucl_int_create(arg0->integer * arg1->integer); } LISP_FUNC_2(ucl_builtin_div, scope, arg0, arg1) { if (arg0->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 0 to 'div'"); } if (arg1->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 1 to 'div'"); } UCL_COND_OR_RET_ERROR(arg1->integer != 0, "Division by zero"); return ucl_int_create(arg0->integer / arg1->integer); } LISP_FUNC_2(ucl_builtin_mod, scope, arg0, arg1) { if (arg0->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 0 to 'mod'"); } if (arg1->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 1 to 'mod'"); } return ucl_int_create(arg0->integer % arg1->integer); } LISP_FUNC_2(ucl_builtin_concat, scope, arg0, arg1) { if (arg0->type != UCL_TYPE_STRING) { return ucl_error_create("Invalid type of argument 0 to 'concat'"); } if (arg1->type != UCL_TYPE_STRING) { return ucl_error_create("Invalid type of argument 1 to 'concat'"); } int len = strlen(arg0->string) + strlen(arg1->string); char *outstr = malloc(len); outstr[0] = '\0'; strcat(outstr, arg0->string); strcat(outstr, arg1->string); struct ucl_object *result = ucl_string_create(outstr); free(outstr); return result; } LISP_FUNC_0(ucl_builtin_now_millis_mono, scope) { // TODO: Implement and move to a 'platform' file return NULL; } LISP_FUNC_1(ucl_builtin_print, scope, arg0) { ucl_print_obj(arg0); return ucl_nil_create(); } LISP_FUNC_1(ucl_builtin_printl, scope, arg0) { ucl_print_obj(arg0); printf("\n"); return ucl_nil_create(); } struct ucl_object *ucl_builtin_list(struct ucl_scope *scope, struct ucl_object *args) { struct ucl_object *head = ucl_nil_create(); FOREACH_LIST(args, iter, item) { ucl_list_append(head, item); } return head; } LISP_FUNC_2(ucl_builtin_mapcar, scope, 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(scope, form); UCL_RET_IF_ERROR(value); ucl_list_append(result, value); } return result; } LISP_FUNC_2(ucl_builtin_filter, scope, predicate, elems) { // TODO: Support arbitrary number of 'elems' lists struct ucl_object *result = ucl_nil_create(); struct ucl_object *result_tail = result; FOREACH_LIST(elems, iter, elem) { struct ucl_object *form = ucl_tuple_create(predicate, elem); struct ucl_object *value = ucl_evaluate(scope, form); UCL_RET_IF_ERROR(value); if (ucl_truthy_bool(value)) { result_tail = ucl_list_append(result_tail, elem); } } return result; } LISP_FUNC_3(ucl_builtin_reduce, scope, fun, elems, initial_value) { // TODO: Support arbitrary number of 'elems' lists struct ucl_object *result = initial_value; FOREACH_LIST(elems, iter, elem) { struct ucl_object *form = ucl_tuple_create(fun, elem); ucl_list_append(form, result); result = ucl_evaluate(scope, form); UCL_RET_IF_ERROR(result); } return result; } LISP_FUNC_2(ucl_builtin_equal, scope, arg0, arg1) { return ucl_equal(arg0, arg1); } LISP_FUNC_2(ucl_builtin_gt, scope, arg0, arg1) { UCL_COND_OR_RET_ERROR(arg0->type == UCL_TYPE_INT, "First argument to > must be an integer"); UCL_COND_OR_RET_ERROR(arg0->type == UCL_TYPE_INT, "Second argument to > must be an integer"); return ucl_predicate(arg0->integer > arg1->integer); } LISP_FUNC_2(ucl_builtin_ge, scope, arg0, arg1) { UCL_COND_OR_RET_ERROR(arg0->type == UCL_TYPE_INT, "First argument to >= must be an integer"); UCL_COND_OR_RET_ERROR(arg0->type == UCL_TYPE_INT, "Second argument to >= must be an integer"); return ucl_predicate(arg0->integer > arg1->integer); } LISP_FUNC_2(ucl_builtin_lt, scope, arg0, arg1) { UCL_COND_OR_RET_ERROR(arg0->type == UCL_TYPE_INT, "First argument to < must be an integer"); UCL_COND_OR_RET_ERROR(arg0->type == UCL_TYPE_INT, "Second argument to < must be an integer"); return ucl_predicate(arg0->integer < arg1->integer); } LISP_FUNC_2(ucl_builtin_le, scope, arg0, arg1) { UCL_COND_OR_RET_ERROR(arg0->type == UCL_TYPE_INT, "First argument to <= must be an integer"); UCL_COND_OR_RET_ERROR(arg0->type == UCL_TYPE_INT, "Second argument to <= must be an integer"); return ucl_predicate(arg0->integer < arg1->integer); } LISP_FUNC_2(ucl_builtin_num_eq, scope, arg0, arg1) { UCL_COND_OR_RET_ERROR(arg0->type == UCL_TYPE_INT, "First argument to = must be an integer"); UCL_COND_OR_RET_ERROR(arg0->type == UCL_TYPE_INT, "Second argument to = must be an integer"); return ucl_predicate(arg0->integer == arg1->integer); } LISP_FUNC_2(ucl_builtin_xor, scope, arg0, arg1) { return ucl_predicate(ucl_truthy_bool(arg0) || ucl_truthy_bool(arg1)); } LISP_FUNC_1(ucl_builtin_not, scope, arg0) { return ucl_predicate(!ucl_truthy_bool(arg0)); } LISP_FUNC_2(ucl_builtin_append, scope, list, elem) { ucl_list_append(list, elem); return list; }