uclisp/src/utility.c

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

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

struct ucl_object *ucl_car(struct ucl_object *list) {
    UCL_COND_OR_RET_ERROR(
        list != NULL && list->type == UCL_TYPE_CELL,
        "Invalid type of argument 0 to 'ucl_car'");

    struct ucl_object *car = list->cell.car;
    if (car == NULL) {
        return ucl_nil_create();
    }

    return car;
}

struct ucl_object *ucl_cdr(struct ucl_object *list) {
    UCL_COND_OR_RET_ERROR(
        list != NULL && list->type == UCL_TYPE_CELL,
        "Invalid type of argument 0 to 'ucl_cdr'");

    struct ucl_object *cdr = list->cell.cdr;
    if (cdr == NULL) {
        return ucl_nil_create();
    }

    return cdr;
}

struct ucl_object *ucl_nil_create() {
    return ucl_cell_create(NULL, NULL);
}

struct ucl_object *ucl_t_create() {
    return ucl_symbol_create("t");
}

struct ucl_object *ucl_predicate(bool value) {
    if (value) {
        return ucl_t_create();
    } else {
        return ucl_nil_create();
    }
}

struct ucl_object *ucl_list_length(struct ucl_object *list) {
    UCL_COND_OR_RET_ERROR(
        list != NULL && list->type == UCL_TYPE_CELL,
        "Invalid type of argument 0 to 'ucl_list_length'");

    struct ucl_object *node = list;
    if (list->cell.car == NULL) {
        return ucl_int_create(0);
    }

    int length = 1;
    while (node->cell.cdr != NULL) {
        node = node->cell.cdr;
        length++;
    }

    return ucl_int_create(length);
}

struct ucl_object *ucl_list_nth(struct ucl_object *list, int n) {
    UCL_COND_OR_RET_ERROR(
        list != NULL && list->type == UCL_TYPE_CELL,
        "Invalid type of argument 0 to 'ucl_list_nth'");

    int length = ucl_list_length(list)->integer;
    UCL_COND_OR_RET_ERROR(length > n, "Position n >= list length in ucl_list_nth");
    UCL_COND_OR_RET_ERROR(n >= 0, "Index to ucl_list_nth was less that zero");

    struct ucl_object *node = list;
    for (int i = 0; i < n; i++) {
        node = node->cell.cdr;
    }

    return node->cell.car;
}

bool ucl_truthy_bool(struct ucl_object *obj) {
    // TODO: Implement me better
    if (obj->type == UCL_TYPE_INT) {
        return obj->integer;
    } else if (obj->type == UCL_TYPE_SYMBOL) {
        return true;
    } else if (obj->type == UCL_TYPE_CELL) {
        return obj->cell.car != NULL;
    }

    assert(0);
    return false;
}

struct ucl_object *ucl_truthy(struct ucl_object *obj) {
    return ucl_predicate(ucl_truthy_bool(obj));
}

struct ucl_object *ucl_tuple_create(struct ucl_object *obj0, struct ucl_object *obj1) {
    struct ucl_object *tuple = ucl_cell_create(obj0, NULL);
    ucl_list_append(tuple, obj1);
    return tuple;
}

struct ucl_object *ucl_list_append(struct ucl_object *list, struct ucl_object *obj) {
    struct ucl_object *iter = list;

    if (list->cell.car == NULL) {
        list->cell.car = obj;
        return list;
    }

    while (iter->cell.cdr != NULL) {
        iter = iter->cell.cdr;
    }
    iter->cell.cdr = ucl_cell_create(obj, NULL);

    return iter->cell.cdr;
}

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_SPECIAL:
            printf("<special %p>", obj->special);
            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);
    }
}

struct ucl_object *ucl_progn(struct ucl_scope *state, struct ucl_object *forms) {
    struct ucl_object *result = NULL;
    FOREACH_LIST(forms, iter, form) {
        result = ucl_evaluate(state, form);
        if (result->type == UCL_TYPE_ERROR) {
            return result;
        }
    }

    return (result == NULL) ? ucl_nil_create() : result;
}


struct ucl_object *ucl_equal(
    struct ucl_object *arg0, struct ucl_object *arg1) {
    if (arg0 == arg1) {
        return ucl_t_create();
    }

    if ((arg0 == NULL) || (arg1 == NULL)) {
        return ucl_nil_create();
    }

    if (arg0->type != arg1->type) {
        return ucl_nil_create();
    }

    switch (arg0->type) {
        case UCL_TYPE_INT:
            return ucl_predicate(arg0->integer == arg1->integer);
        case UCL_TYPE_SYMBOL:
            return ucl_predicate(!strcmp(arg0->symbol, arg1->symbol));
        case UCL_TYPE_CELL: {
            struct ucl_object *car_equal = ucl_equal(arg0->cell.car, arg1->cell.car);
            if (!ucl_truthy(car_equal)) {
                return car_equal;
            }
            return ucl_equal(arg0->cell.cdr, arg1->cell.cdr);
        }
        case UCL_TYPE_BUILTIN:
            return ucl_predicate(arg0->special == arg1->builtin);
        case UCL_TYPE_SPECIAL:
            return ucl_predicate(arg0->special == arg1->builtin);
        case UCL_TYPE_STRING:
            return ucl_predicate(!strcmp(arg0->string, arg1->string));
        case UCL_TYPE_ERROR:
        case UCL_TYPE_COUNT:
            return ucl_error_create("");
    }

    assert(0);
    return ucl_error_create("Unreachable error in ucl_equal");
}