lesson-lisp/builtins.c

#include "builtins.h"

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

struct Builtin {
    const char *name;
    struct Object *(*func)(struct Object *args);
};

// Evaluation
static struct Object *func_eval(struct Object *args);
// 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 Builtin builtins[] = {
    // Evaluation
    { "eval",      func_eval      },
    // Basic data structures
    { "cons",      func_cons      },
    { "quote",     func_quote     },
    // Type predicates
    { "boolean?",  func_booleanQN },
    { "char?",     func_charQN    },
    { "null?",     func_nullQN    },
    { "number?",   func_numberQN  },
    { "pair?",     func_pairQN    },
    { "string?",   func_stringQN  },
    { "symbol?",   func_symbolQN  },
    // Logical operators
    { "and",       func_and       },
    { "or",        func_or        },
    // IO
    { "display",   func_display   },
    { "displayln", func_displayln },
    { "newline",   func_newline   },
    // Other
    { "+",         func_sum       },
    { NULL,        NULL           },
};

static struct Object *builtins_call(const char *name, struct Object *args)
{
    for (size_t index = 0; builtins[index].name; ++index) {
        if (strcmp(builtins[index].name, name) == 0) {
            return builtins[index].func(args);
        }
    }

    abort();
}

struct Object *builtins_eval(struct Object *program)
{
    // NULL is an empty list, can't eval
    assert(program);

    // Almost everything evaluates to itself
    if (program->type != TYPE_PAIR && program->type != TYPE_SYMBOL) {
        return program;
    }

    // Symbols are variable names, but we can't lookup
    assert(program->type != TYPE_SYMBOL);

    // The first item of pair should be an symbol - a function name
    assert(program->pair.a && program->pair.a->type == TYPE_SYMBOL);

    return builtins_call(program->pair.a->s, program->pair.b);
}

/**************
 * Evaluation *
 **************/

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

    return builtins_eval(args->pair.a);
}

/*************************
 * 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 = builtins_eval(args->pair.a);
    struct Object *const cdr = builtins_eval(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 = builtins_eval(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 = builtins_eval(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 = builtins_eval(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 = builtins_eval(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 = builtins_eval(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 = builtins_eval(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 = builtins_eval(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 = builtins_eval(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 = builtins_eval(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 = builtins_eval(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;
}