#include "uclisp.h" #include "internal.h" #include "utility.h" #include "builtins.h" #include "state.h" #include #include #include #include LISP_FUNC_1(ucl_builtin_type, state, arg) { switch (arg->type) { case UCL_TYPE_CELL: return ucl_symbol_create(strdup("list")); case UCL_TYPE_SYMBOL: return ucl_symbol_create(strdup("symbol")); case UCL_TYPE_INT: return ucl_symbol_create(strdup("int")); case UCL_TYPE_STRING: return ucl_symbol_create(strdup("string")); case UCL_TYPE_ERROR: return ucl_symbol_create(strdup("error")); case UCL_TYPE_COUNT: assert(0); return NULL; } } LISP_FUNC_1(ucl_builtin_error, state, arg) { if (arg->type != UCL_TYPE_STRING) { return ucl_error_create("Expected type string passed to 'error'"); } return ucl_error_create(strdup(arg->error)); } LISP_FUNC_1(ucl_builtin_symbol_p, state, arg) { return ucl_predicate(arg->type == UCL_TYPE_SYMBOL); } LISP_FUNC_1(ucl_builtin_string_p, state, arg) { return ucl_predicate(arg->type == UCL_TYPE_STRING); } LISP_FUNC_1(ucl_builtin_int_p, state, arg) { return ucl_predicate(arg->type == UCL_TYPE_INT); } LISP_FUNC_1(ucl_builtin_list_p, state, arg) { return ucl_predicate(arg->type == UCL_TYPE_CELL); } LISP_FUNC_1(ucl_builtin_error_p, state, arg) { return ucl_predicate(arg->type == UCL_TYPE_ERROR); } LISP_FUNC_1(ucl_builtin_car, state, arg) { return ucl_car(arg); } LISP_FUNC_1(ucl_builtin_cdr, state, arg) { return ucl_cdr(arg); } LISP_FUNC_2(ucl_builtin_add, state, 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, state, 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, state, 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, state, 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'"); } return ucl_int_create(arg0->integer / arg1->integer); } LISP_FUNC_2(ucl_builtin_mod, state, 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, state, 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(strlen(arg0->string) + strlen(arg1->string)); outstr[0] = '\0'; strcat(outstr, arg0->string); strcat(outstr, arg1->string); return ucl_string_create(outstr); } LISP_FUNC_0(ucl_builtin_now_millis_mono, state) { // TODO: Implement and move to a 'platform' file return NULL; } struct ucl_object *ucl_builtin_let(struct ucl_state *state, struct ucl_object *args) { // TODO: Check arguments struct ucl_object *assignments = ucl_car(args); struct ucl_object *expressions = ucl_cdr(args); struct ucl_state *let_state = ucl_state_create_child(state); 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_state, expr); assert(sym->type == UCL_TYPE_SYMBOL); //assert(ucl_list_length(expr)->integer == 1); if (value->type == UCL_TYPE_ERROR) { // TODO cleanup return value; } ucl_state_put(let_state, sym->symbol, value); } struct ucl_object *result = NULL; FOREACH_LIST(expressions, iter, item) { result = ucl_evaluate(let_state, item); if (result->type == UCL_TYPE_ERROR) { return result; } } ucl_state_delete(let_state); return result; }