uclisp/src/builtins.c

#include "uclisp.h"
#include "internal.h"
#include "utility.h"
#include "builtins.h"
#include "scope.h"
#include "lisp.h"

#include <assert.h>
#include <stddef.h>
#include <string.h>
#include <stdlib.h>
#include <stdio.h>

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;
}