uclisp/src/builtins.c

#include "uclisp.h"
#include "internal.h"
#include "utility.h"
#include "builtins.h"
#include "state.h"

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

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
            assert(0);
        }
        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) {
            assert(0);
            break;
        }
    }


    ucl_state_delete(let_state);
    return result;
}