pebblisp/src/pebblisp.c

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

#include "tokens.h"
#include "pebblisp.h"

#ifdef STANDALONE

#include "web.h"

#endif

/**
 * Inserts a variable into the environment with a given name and value.
 *
 * If `argForms` (symbol) and `argForms->forward` (value) are lists of the same
 * length, define each symbol element with the corresponding value element.
 * I.e. `(def (a b) (5 20))` would store `a` as `5` and `b` as `20`.
 *
 * @param argForms The symbol(s) and value(s) to define in the environment
 * @param env The environment to add the new definition to
 * @return The symbol(s) defined
 */
Object def(Object* params, unused int length, unused struct Environment* env)
{
    const char* name = params[0].string;

    Object finalValue = eval(&params[1], env);

    addToEnv(env, name, finalValue);
    cleanObject(&finalValue);

    return cloneObject(params[0]);
}

/**
 * Add a struct to the environment with a given name and fields.
 *
 * Not a typical pl function because I don't feel like adding more syntactic sugar right now.
 *
 * (struct Point (x y))
 */
Object evalStructArgs(const Object* symbol, const Object* fields, unused struct Environment* env)
{
    const char* name = symbol->string;

    if (!fields || !isListy(*fields)) {
        throw(NOT_A_LIST, "In definition of struct %s, expected a list of fields.", name);
    }

    int fieldCount = listLength(fields);
    struct StructDef def = {
        .name = strdup(name),
        .fieldCount = fieldCount,
        .names = malloc(sizeof(char*) * fieldCount),
    };

    int i = 0;
    FOR_POINTER_IN_LIST(fields) {
        def.names[i] = strdup(POINTER->string);
        i++;
    }

    addStructDef(def);

    return trueObject();
}

/**
 * Not a typical pl function because delayed evaluation is annoying in those right now.
 */
Object evalIfArgs(const Object* argForms, struct Environment* env)
{
    Object condition = eval(argForms, env);
    Object result = condition.number ? eval(argForms->forward, env)
                                     : eval(argForms->forward->forward, env);
    cleanObject(&condition);
    return result;
}

Object mapO(Object* params, int length, struct Environment* env)
{
    if (length < 2) {
        throw(NULL_MAP_ARGS, "(map) expects at least 2 parameters, but only received %d.", length);
    }

    Object lambda = eval(&params[0], env);
    const Object* inputList = &params[1];

    if (!isFuncy(lambda)) {
        throw(BAD_TYPE, "First argument of (map) should be func-like.");
    }

    BuildListNamed(outputList);
    FOR_POINTER_IN_LIST(inputList) {
        // Create a new list for each element,
        // since lambda evaluation looks for a list
        Object tempInput = cloneObject(*POINTER);

        Object* lambdaParams = &lambda.lambda->params;
        struct Environment newEnv = envForLambda(lambdaParams, &tempInput, listLength(lambdaParams), env);

        // Add the lambda evaluation to the list
        addToList(outputList, eval(&lambda.lambda->body, &newEnv));
        deleteEnv(&newEnv);
        cleanObject(&tempInput);
    }
    cleanObject(&lambda);

    return outputList;
}

/**
 * Evaluates a paramList whose first element is a function, applying that function
 *
 * Tries to either apply the function to its parameters, or create a partial
 * function, if not enough parameters were passed.
 *
 * @param function The object evaluated to be TYPE_FUNC
 * @param paramList Ongoing (forward->forward) list of parameters to the function
 * @param length Length of `paramList` - 1, to exclude the already-evaluated element
 * @param env The environment to evaluate in
 */
Object listEvalFunc(const Object* function, const Object* paramList,
                    const int length, struct Environment* env)
{
    Object rest[length];

    for (int i = 0; i < length; i++) {
        rest[i] = eval(paramList, env);
        paramList = paramList->forward;
    }

    Object result = function->func(rest, length, env);
    for (int i = 0; i < length; i++) {
        cleanObject(&rest[i]);
    }
    return result;
}

/**
 * Evaluates a list whose first element is a lambda, applying that lambda
 *
 * Tries to apply the lambda to its parameters. Doesn't attempt partial
 * application.
 *
 * @param lambda The object evaluated to be TYPE_LAMBDA
 * @param passedArguments Ongoing (forward->forward) list of parameters to the lambda
 * @param env The environment to evaluate in
 */
Object listEvalLambda(Object* lambda, const Object* passedArguments, int evalLength,
                      struct Environment* env)
{
    struct Environment newEnv =
        envForLambda(&lambda->lambda->params, passedArguments, evalLength, env);
    Object ret = eval(&lambda->lambda->body, &newEnv);
    deleteEnv(&newEnv);
    cleanObject(lambda);

    Object* t = tail(&ret);
    if (t) {
        Object o = cloneObject(*t);
        cleanObject(&ret);
        return o;
    }
    return ret;
}

/**
 * Run a func-like object with the given parameters
 * @param funcy The func-like. Should be a fresh object! Will be freed!
 * @param passedArguments Ongoing (forward->forward) list of arguments.
 * @param evalLength Number of parameters to the func-like object.
 * @param env
 * @return The result from the func-like object.
 */
Object funcyEval(Object* funcy, const Object* passedArguments, int evalLength,
                 struct Environment* env)
{
    if (!funcy) {
        eprintf("HIGHLY ILLEGAL NULL FUNC-LIKE!!!\n");
        throw(BAD_TYPE, "Expected func-like object, but received null");
    }
    switch (funcy->type) {
        case TYPE_LAMBDA:
            return listEvalLambda(funcy, passedArguments, evalLength, env);
        case TYPE_FUNC:
            return listEvalFunc(funcy, passedArguments, evalLength, env);
        default:
            eprintf("HIGHLY ILLEGAL NOT-FUNC IN funcyEval()!!!\n");
            throw(BAD_TYPE, "Expected func-like object, but received %s", getTypeName(funcy));
    }
}

/**
 * Evaluates a given list, including the application of functions and lambdas
 *
 * Engages in several behaviors, depending on list contents:
 * - () => ()
 * - (x y z) => (eval_x eval_y eval_z)
 * - (function x y) => evaluated function(x, y)
 * - (function ...) => evaluated function(...) applied to each arg
 * - (function x) => functionx() partial function
 * - (lambda x) => evaluated lambda(x)
 *
 * @param obj The list to be evaluated
 * @param env The environment to evaluate in
 */
Object evalList(const Object* obj, struct Environment* env)
{
    const int evalLength = listLength(obj);

    if (evalLength == 0) {
        return cloneObject(*obj);
    }

    Object* first_form = obj->list;
    if (first_form->type == TYPE_SYMBOL) {
        if (strcmp(first_form->string, "if") == 0) {
            return evalIfArgs(first_form->forward, env);
        } else if (strcmp(first_form->string, "fn") == 0) {
            Object* params = first_form->forward;
            Object* doc = NULL;
            Object* body = NULL;
            if (params) {
                int twoParams = params->forward && params->forward->forward;
                doc = twoParams ? params->forward : NULL;
                body = twoParams ? params->forward->forward : params->forward;
            }
            return constructLambda(params, doc, body, env);
        } else if (strcmp(first_form->string, "struct") == 0) {
            return evalStructArgs(first_form->forward, first_form->forward->forward, env);
        }

        int i = getStructIndex(first_form->string);
        if (i >= 0) {
            Object structo = structObject(i);
            int s = 0;
            FOR_POINTER_IN_LIST(obj) {
                if (s != 0) { // Skip the field name
                    structo.structObject->fields[s - 1] = eval(POINTER, env);
                }
                s++;
            }
            return structo;
        }
    }

    // Evaluate the list based on the first element's type
    Object first_eval = eval(first_form, env);
    switch (first_eval.type) {
        case TYPE_FUNC:
            // Uses evalLength - 1 because we skip the first form (the function itself)
            return listEvalFunc(&first_eval, first_form->forward, evalLength - 1, env);

        case TYPE_LAMBDA:
            return listEvalLambda(&first_eval, first_form->forward, evalLength - 1, env);

        default: { // Return list with each element evaluated
            Object list = listObject();
            int i = 0;
            Object* t = nf_addToList(&list, first_eval);
            FOR_POINTER_IN_LIST(obj) {
                if (i != 0) {
                    allocObject(&t->forward, eval(POINTER, env));
                    t = t->forward;
                }
                i++;
            }
            return list;
        }
    }
}

Object runStatic(const Object* staticF, struct Environment* env)
{
    struct StaticFunction* f = staticF->staticF;
    Object evaluatedArgs[f->argCount];
    for (int i = 0; i < f->argCount; i++) {
        evaluatedArgs[i] = eval(&f->arguments[i], env);
    }
    Object ret = f->func(evaluatedArgs, f->argCount, env);
    for (int i = 0; i < f->argCount; i++) {
        cleanObject(&evaluatedArgs[i]);
    }
    return ret;
}

Object eval(const Object* obj, struct Environment* env)
{
    switch (obj->type) {
        case TYPE_LAMBDA:
        case TYPE_FUNC:
        case TYPE_ERROR:
        case TYPE_OTHER:
        case TYPE_NUMBER:
        case TYPE_BOOL:
        case TYPE_STRING:
        case TYPE_STRUCT:
        case TYPE_SLIST:
        case TYPE_PROMISE:
            return cloneObject(*obj);

        case TYPE_STATIC_FUNC:
            return runStatic(obj, env);

        case TYPE_SYMBOL:
            return fetchFromEnvironment(obj->string, env);

        case TYPE_LIST:
            return evalList(obj, env);
    }

    throw(BAD_TYPE, "Object being evaluated has a type number of %d", obj->type);
}

Object structAccess(Object* params, unused int length, unused struct Environment* env)
{
    checkTypes(structAccess)

    Object structo = params[0];
    Object field = params[1];

    struct StructDef* structDef = getStructAt(structo.structObject->definition);
    if (isStringy(field)) {
        for (int i = 0; i < structDef->fieldCount; i++) {
            if (strcmp(field.string, structDef->names[i]) == 0) {
                return cloneObject(structo.structObject->fields[i]);
            }
        }
        throw(NULL_PARSE, "Could not find struct field named `%s`", field.string);
    }

    if (isNumber(field)) {
        if (structDef->fieldCount < field.number || field.number < 0) {
            throw(NULL_PARSE, "Could not find struct field at index %ld. Struct `%s` has %d fields.", field.number,
                  structDef->name, structDef->fieldCount);
        }
        return cloneObject(structo.structObject->fields[field.number]);
    }

    throw(BAD_PARAMS, "Struct fields should be indexed with a string or a number, but received a %s",
          getTypeName(&field));
}

Result parse(struct Slice* slices)
{
    struct Slice* token = slices;
    if (!token || !token->text) {
        return (Result) { errorObject(NULL_PARSE), NULL };
    }

    struct Slice* rest = &slices[1];
    if (token->text[0] == '\'' && token->text[1] == '(') {
        Result r = readSeq(&slices[2]);
        if (r.obj.type == TYPE_LIST) {
            r.obj.type = TYPE_SLIST;
        }
        return r;
    } else if (token->text[0] == '(') {
        return readSeq(rest);
    } else {
        Result r = parseAtom(token);
        r.slices = &r.slices[1];
        return r;
    }
}

#ifndef NO_SUGAR
#define sugar(_desc, _code) _code
#else
#define sugar(_desc, _code) ;
#endif

Result readSeq(struct Slice* tokens)
{
    Object res = listObject();
    int forceString = 0;
    for (;;) {
        struct Slice* next = tokens;
        struct Slice* rest = next->text ? &next[1] : NULL;
        if (next->text[0] == ')') {
            return (Result) { res, rest };
        }
        Result r = parse(tokens);
        sugar("(? fil) => (? 'fil')" // or,
              "(def yee 10) => (def 'yee' 10)",
              if (forceString && r.obj.type == TYPE_SYMBOL) {
                  r.obj.type = TYPE_STRING;
              }
        )
        if (r.obj.type == TYPE_ERROR) {
            return r;
        }
        nf_addToList(&res, cloneObject(r.obj));
        tokens = r.slices;
        cleanObject(&r.obj);
        forceString = next->text[0] == '?'
                      || (strncmp(next->text, "def", 3) == 0);
    }
}

int hexChar(char c)
{
    if (isDigit(c)) {
        return c - '0';
    }
    if (c >= 'a' && c <= 'f') {
        return c - 'a' + 10;
    }
    if (c >= 'A' && c <= 'F'){
        return c - 'A' + 10;
    }
    return -1;
}

int binChar(char c)
{
    if (c == '0' || c == '1') {
        return c - '0';
    }
    return -1;
}

int decChar(char c)
{
    if (isDigit(c)) {
        return c - '0';
    }
    return -1;
}

Object parseNum(int base, const char* text, int length, int (*func)(char))
{
    int num = 0;
    for (int i = 0; i < length; i++) {
        const char c = text[i];
        int value = func(c);
        if (value < 0) {
            throw(BAD_NUMBER, "at %s", text);
        }
        num *= base;
        num += value;
    }
    return numberObject(num);
}

Object optimize(Object (* func)(Object*, int, struct Environment*), int argCount, Object args[])
{
    struct StaticFunction *f = malloc(sizeof(struct StaticFunction) + (sizeof(Object) * argCount));
    f->refs = 1;
    f->func = func;
    f->arguments = (void*) f + sizeof(struct StaticFunction);
    f->argCount = argCount;
    for (int i = 0; i < argCount; i++) {
        f->arguments[i] = args[i];
    }
    Object staticF = newObject(TYPE_STATIC_FUNC);
    staticF.staticF = f;
    return staticF;
}

#define ELEVENTH_ARGUMENT(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, ...) a11
#define COUNT_ARGUMENTS(...) ELEVENTH_ARGUMENT(dummy, ## __VA_ARGS__, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0)
#define OPTIMIZE(FUNC, ...) optimize(FUNC, COUNT_ARGUMENTS(__VA_ARGS__), (Object[]) { __VA_ARGS__ } )

Result parseAtom(struct Slice* s)
{
    const char c = s->text[0];
    if (isDigit(c)) {
        if (c != '0' || s->length == 1) {
            return (Result) { parseNum(10, s->text, s->length, decChar), s };
        }
#ifndef LOW_MEM
        if (s->text[1] == 'x') {
            return (Result) { parseNum(16, s->text + 2, s->length - 2, hexChar), s };
        }
        if (s->text[1] == 'b') {
            return (Result) { parseNum(2, s->text + 2, s->length - 2, binChar), s };
        }
#endif
        return (Result) { errorWithContext(UNSUPPORTED_NUMBER_TYPE, s->text), s };
    }
    if (s->length == 1 && c == 'T') {
        return (Result) { trueObject(), s };
    }
    if (s->length == 1 && c == 'F') {
        return (Result) { falseObject(), s };
    }
    if (c == '"') {
        return (Result) { objFromSlice(s->text, s->length), s };
    }
    if (s->text[s->length] == '.') {
        struct Slice* next = s + 2;
        Object staticFunc = OPTIMIZE(
            structAccess,
            symFromSlice(s->text, s->length), // struct name
            stringFromSlice(next->text, next->length) // field name
        );
        return (Result) { staticFunc, next };
    }
    return (Result) { symFromSlice(s->text, s->length), s };
}

struct Slice* lastOpen = NULL;

struct Slice* getLastOpen()
{
    return lastOpen;
}

Object parseEval(const char* input, struct Environment* env)
{
    struct Error err = noError();

    struct Slice* tokens = nf_tokenize(input, &err);
    if (err.context != NULL) {
        Object o = errorWithContext(err.code, err.context);
        free(err.context);
        return o;
    }
    if (!tokens->text) {
        return symFromSlice(" ", 1);
    }

    int i = 0;
    int parens = 0;
    Object obj = numberObject(0);
    struct Slice* tok = tokens;
    while (tok[i].text != NULL) {
        if (tok[i].text[0] == '(') {
            lastOpen = &tok[i];
            parens++;
        } else if (tok[i].text[0] == ')') {
            parens--;
        }

        if (parens != 0) {
            i++;
            continue;
        }

        cleanObject(&obj);
        Object parsed = parse(tok).obj;
        if (parsed.type == TYPE_ERROR) {
            obj = parsed;
#ifdef STANDALONE
            obj.error->plContext = malloc(sizeof(struct Slice));
            *obj.error->plContext = *lastOpen;
#endif
            break;
        }

        if (tok[i].text[0] == ')') {
            // Skip `tok` past end of list that just closed
            tok = &tok[i + 1];
            i = -1;
        }
        if (parsed.type == TYPE_SLIST) {
            obj = parsed;
        } else {
            obj = eval(&parsed, env);
            cleanObject(&parsed);
        }

        i++;
    }
    free(tokens);
    return obj;
}

Object typeCheck(const char* funcName, Object* params, int length,
                 struct TypeCheck typeChecks[], int typeLength, int* failed)
{
    *failed = 1;
    if ((typeLength - 1) > length) {
        throw(NOT_ENOUGH_ARGUMENTS, "%s requires %d arguments, but only received %d", funcName, typeLength - 1, length);
    }

    for (int i = 0; i < typeLength - 1; i++) {
        if (typeChecks[i].checkFunc && !typeChecks[i].checkFunc(params[i])) {
            throw(BAD_PARAMS, "When calling (%s), expected %s at param %d, but received %s.",
                  funcName, typeChecks[i].name, i, getTypeName(&params[i]));
        }
    }
    *failed = 0;
    return numberObject(0);
}

#ifdef STANDALONE

char* readFileToString(FILE* input)
{
    size_t capacity = 128;
    char* string = malloc(sizeof(char) * (capacity + 1));
    string[0] = 1; // Set refCount

    int c;
    int i = 1; // Skip refCount

    while ((c = fgetc(input)) != EOF) {
        string[i] = c;
        i++;
        if (i == capacity) {
            char* prev = string;
            capacity *= 2;
            string = malloc(sizeof(char) * capacity);
            memcpy(string, prev, sizeof(char) * (capacity / 2));
            free(prev);
        }
    }
    string[i] = '\0';

    return string + 1; // Offset past refCount
}

/// Returns 1 if the file could not be opened. Otherwise, 0
int readFile(const char* filename, struct Environment* env)
{
    FILE* input = fopen(filename, "r");
    if (!input) {
        return 1;
    }
    _readFile(input, env);
    return 0;
}

int _readFile(FILE* input, struct Environment* env)
{
    char* fileText = readFileToString(input);
    fclose(input);
    Object r = parseEval(fileText, env);
    cleanObject(&r);

    return 0;
}

#endif // STANDALONE