lesson-lisp/builtins.c

#include "builtins.h"

#include "object.h"

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

// Basic data structures
static struct Object *func_cons(struct Object *args);
static struct Object *func_quote(struct Object *args);
// Type predicates
static struct Object *func_booleanQN(struct Object *args);
static struct Object *func_charQN(struct Object *args);
static struct Object *func_nullQN(struct Object *args);
static struct Object *func_numberQN(struct Object *args);
static struct Object *func_pairQN(struct Object *args);
static struct Object *func_stringQN(struct Object *args);
static struct Object *func_symbolQN(struct Object *args);
// Logical operators
static struct Object *func_and(struct Object *args);
static struct Object *func_or(struct Object *args);
// IO
static struct Object *func_display(struct Object *args);
static struct Object *func_displayln(struct Object *args);
static struct Object *func_newline(struct Object *args);
// Other
static struct Object *func_sum(struct Object *args);

static struct Object builtins[] = {
    // Basic data structures
    { .type = TYPE_PROCEDURE, .procedure = { "cons",      func_cons      } },
    { .type = TYPE_PROCEDURE, .procedure = { "quote",     func_quote     } },
    // Type predicates
    { .type = TYPE_PROCEDURE, .procedure = { "boolean?",  func_booleanQN } },
    { .type = TYPE_PROCEDURE, .procedure = { "char?",     func_charQN    } },
    { .type = TYPE_PROCEDURE, .procedure = { "null?",     func_nullQN    } },
    { .type = TYPE_PROCEDURE, .procedure = { "number?",   func_numberQN  } },
    { .type = TYPE_PROCEDURE, .procedure = { "pair?",     func_pairQN    } },
    { .type = TYPE_PROCEDURE, .procedure = { "string?",   func_stringQN  } },
    { .type = TYPE_PROCEDURE, .procedure = { "symbol?",   func_symbolQN  } },
    // Logical operators
    { .type = TYPE_PROCEDURE, .procedure = { "and",       func_and       } },
    { .type = TYPE_PROCEDURE, .procedure = { "or",        func_or        } },
    // IO
    { .type = TYPE_PROCEDURE, .procedure = { "display",   func_display   } },
    { .type = TYPE_PROCEDURE, .procedure = { "displayln", func_displayln } },
    { .type = TYPE_PROCEDURE, .procedure = { "newline",   func_newline   } },
    // Other
    { .type = TYPE_PROCEDURE, .procedure = { "+",         func_sum       } },
    { .type = TYPE_PROCEDURE, .procedure = { NULL,        NULL           } },
};

struct Object *builtins_get(const char *name)
{
    for (size_t index = 0; builtins[index].procedure.name; ++index) {
        if (strcmp(name, builtins[index].procedure.name) == 0) {
            return &builtins[index];
        }
    }

    abort();
}

/*************************
 * Basic data structures *
 *************************/

struct Object *func_cons(struct Object *const args)
{
    assert(args);
    assert(args->type == TYPE_PAIR);
    assert(args->pair.a);
    assert(args->pair.b);
    assert(args->pair.b->type == TYPE_PAIR);
    assert(args->pair.b->pair.a);
    assert(args->pair.b->pair.b == NULL);

    struct Object *const car = args->pair.a;
    struct Object *const cdr = args->pair.b->pair.a;

    return Object_new_pair(car, cdr);
}

struct Object *func_quote(struct Object *const args)
{
    if (!args) return NULL;

    assert(args->type == TYPE_PAIR);
    assert(args->pair.b == NULL);

    return args->pair.a;
}

/*******************
 * Type predicates *
 *******************/

struct Object *func_booleanQN(struct Object *args)
{
    assert(args);
    assert(args->type == TYPE_PAIR);
    assert(args->pair.b == NULL);

    struct Object *const object = args->pair.a;
    return Object_new_boolean(object && object->type == TYPE_BOOLEAN);
}

struct Object *func_charQN(struct Object *args)
{
    assert(args);
    assert(args->type == TYPE_PAIR);
    assert(args->pair.b == NULL);

    struct Object *const object = args->pair.a;
    return Object_new_boolean(object && object->type == TYPE_CHAR);
}

struct Object *func_nullQN(struct Object *args)
{
    assert(args);
    assert(args->type == TYPE_PAIR);
    assert(args->pair.b == NULL);

    struct Object *const object = args->pair.a;
    return Object_new_boolean(object == NULL);
}

struct Object *func_numberQN(struct Object *args)
{
    assert(args);
    assert(args->type == TYPE_PAIR);
    assert(args->pair.b == NULL);

    struct Object *const object = args->pair.a;
    return Object_new_boolean(object && object->type == TYPE_NUMBER);
}

struct Object *func_pairQN(struct Object *args)
{
    assert(args);
    assert(args->type == TYPE_PAIR);
    assert(args->pair.b == NULL);

    struct Object *const object = args->pair.a;
    return Object_new_boolean(object && object->type == TYPE_PAIR);
}

struct Object *func_stringQN(struct Object *args)
{
    assert(args);
    assert(args->type == TYPE_PAIR);
    assert(args->pair.b == NULL);

    struct Object *const object = args->pair.a;
    return Object_new_boolean(object && object->type == TYPE_STRING);
}

struct Object *func_symbolQN(struct Object *args)
{
    assert(args);
    assert(args->type == TYPE_PAIR);
    assert(args->pair.b == NULL);

    struct Object *const object = args->pair.a;
    return Object_new_boolean(object && object->type == TYPE_SYMBOL);
}

/*********************
 * Logical operators *
 *********************/

struct Object *func_and(struct Object *args)
{
    struct Object *result = Object_new_boolean(true);

    while (args) {
        assert(args->type == TYPE_PAIR);
        result = args->pair.a;
        if (IS_FALSE(result)) break;
        args = args->pair.b;
    }

    return result;
}

struct Object *func_or(struct Object *args)
{
    struct Object *result = Object_new_boolean(false);

    while (args) {
        assert(args->type == TYPE_PAIR);
        result = args->pair.a;
        if (!IS_FALSE(result)) break;
        args = args->pair.b;
    }

    return result;
}

/******
 * IO *
 ******/

static void display_pair(struct Object *pair);

struct Object *func_display(struct Object *const args)
{
    assert(args);
    assert(args->type == TYPE_PAIR);
    assert(args->pair.b == NULL);

    struct Object *const object = args->pair.a;

    if (!object) {
        printf("()");
        return NULL;
    }

    switch (object->type) {
    case TYPE_PROCEDURE:
        if (object->procedure.name) {
            printf("#<procedure:%s>", object->procedure.name);
        } else {
            printf("#<procedure>");
        }
        break;
    case TYPE_PAIR:
        printf("(");
        display_pair(object);
        printf(")");
        break;
    case TYPE_BOOLEAN:
        printf("%s", object->boolean ? "#t" : "#f");
        break;
    case TYPE_CHAR:
        printf("#\\TODO"); // TODO
        break;
    case TYPE_SYMBOL:
    case TYPE_STRING:
        printf("%s", object->s);
        break;
    case TYPE_NUMBER:
        printf("%li", object->i);
        break;
    }

    return NULL;
}

struct Object *func_displayln(struct Object *const args)
{
    func_display(args);
    func_newline(NULL);
    return NULL;
}

struct Object *func_newline(struct Object *const args)
{
    assert(args == NULL);
    printf("\n");
    return NULL;
}

void display_pair(struct Object *const pair)
{
    assert(pair);
    assert(pair->type == TYPE_PAIR);

    func_display(Object_new_pair(pair->pair.a, NULL));

    if (!pair->pair.b) return;

    printf(" ");

    if (pair->pair.b->type == TYPE_PAIR) {
        display_pair(pair->pair.b);
        return;
    }

    printf(". ");
    func_display(Object_new_pair(pair->pair.b, NULL));
}

/*********
 * Other *
 *********/

struct Object *func_sum(struct Object *const args)
{
    struct Object *const object = Object_new_number(0);

    if (!args) return object;

    assert(args->type == TYPE_PAIR);
    assert(args->pair.a);
    assert(args->pair.a->type == TYPE_NUMBER);

    object->i = args->pair.a->i;

    if (!args->pair.b) return object;

    struct Object *const b_sum = func_sum(args->pair.b);

    object->i += b_sum->i;

    return object;
}