#include "uclisp.h" #include "internal.h" #include "utility.h" #include "builtins.h" #include "state.h" #include #include #include #include #include LISP_FUNC_1(ucl_builtin_type, state, 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_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(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); struct ucl_object *result = ucl_string_create(outstr); free(outstr); return result; } LISP_FUNC_0(ucl_builtin_now_millis_mono, state) { // TODO: Implement and move to a 'platform' file return NULL; } static 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); } } LISP_FUNC_1(ucl_builtin_print, state, arg0) { ucl_print_obj(arg0); return ucl_nil_create(); } 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; } struct ucl_object *ucl_builtin_list(struct ucl_state *state, struct ucl_object *args) { struct ucl_object *head = ucl_nil_create(); FOREACH_LIST(args, iter, item) { ucl_list_append(head, item); } return head; }