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>
#include <stdio.h>

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("<builtin %p>", 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;
}