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 = malloc(sizeof(char) * (strlen(name) + 1)),
        .fieldCount = fieldCount,
        .names = malloc(sizeof(char*) * fieldCount),
    };
    strcpy(def.name, name);

    int i = 0;
    FOR_POINTER_IN_LIST(fields) {
        def.names[i] = malloc(sizeof(char) * (strlen(POINTER->string) + 1));
        strcpy(def.names[i], 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 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_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) {
        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;
        }
    } else {
        return (Result) { errorObject(NULL_PARSE), NULL };
    }
}

#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);
    }
}

Object parseDecimal(struct Slice* s)
{
    int num = 0;
    for (int i = 0; i < s->length; i++) {
        if (!isDigit(s->text[i])) {
            return errorObject(BAD_NUMBER);
        }
        num *= 10;
        num += s->text[i] - '0';
    }
    return numberObject(num);
}

Object parseHex(struct Slice* s)
{
    int num = 0;
    for (int i = 2; i < s->length; i++) {
        const char c = s->text[i];
        if (!isHex(c)) {
            return errorObject(BAD_NUMBER);
        }
        num *= 16;
        if (isDigit(c)) {
            num += c - '0';
        } else /* is hex */ {
            num += c - 'a' + 10;
        }
    }
    return numberObject(num);
}

Object parseBin(struct Slice* s)
{
    int num = 0;
    for (int i = 2; i < s->length; i++) {
        const char c = s->text[i];
        if (c != '0' && c != '1') {
            return errorObject(BAD_NUMBER);
        }
        num *= 2;
        num += c - '0';
    }
    return numberObject(num);
}

struct InlinedFunction {
    Object (* func)(Object*, int, struct Environment*);
    Object* arguments;
    int argCount;
    //struct Environment* env;
};

Result parseAtom(struct Slice* s)
{
    const char c = s->text[0];
    if (isDigit(c)) {
        if (c != '0' || s->length == 1) {
            return (Result) { parseDecimal(s), s };
#ifndef LOW_MEM
        } else if (s->text[1] == 'x') {
            return (Result) { parseHex(s), s };
        } else if (s->text[1] == 'b') {
            return (Result) { parseBin(s), s };
#endif
        } else {
            return (Result) { errorWithContext(UNSUPPORTED_NUMBER_TYPE, s->text), s };
        }
    } else if (s->length == 1 && c == 'T') {
        return (Result) { trueObject(), s };
    } else if (s->length == 1 && c == 'F') {
        return (Result) { falseObject(), s };
    } else if (c == '"'/* || c == '\''*/) {
        return (Result) { objFromSlice(s->text, s->length), s };
    } else if (s->text[s->length] == '.') {
        /*
        struct InlinedFunction f ={
            .func = structAccess,
            .arguments = malloc(sizeof(Object) * 2),
            .argCount = 2,
        };
        f.arguments[0] = symFromSlice(s->text, s->length);
        struct Slice* next = s + 2;
        f.arguments[1] = stringFromSlice(next->text, next->length);

        return (Result) { list, next };
        */
        Object structAccessFunc = newObject(TYPE_FUNC);
        structAccessFunc.func = &structAccess;
        Object list = startList(structAccessFunc);
        Object theStruct = symFromSlice(s->text, s->length);
        nf_addToList(&list, theStruct);
        struct Slice* next = s + 2;
        Object structField = stringFromSlice(next->text, next->length);
        nf_addToList(&list, structField);
        return (Result) { list, 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) {
            cleanObject(&obj);
            Object parsed = parse(tok).obj;
            if (parsed.type == TYPE_ERROR) {
                obj = parsed; // TODO Check necessity
#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

/// 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)
{
    Object r = numberObject(0);
    char page[4096] = "";
    const int LINE_MAX = 256;
    char line[LINE_MAX];
    if (fgets(line, LINE_MAX, input)) {
        if (line[0] != '#' || line[1] != '!') {
            strcat(page, line);
        }
    }
    int isQuote = 0;
    while (fgets(line, LINE_MAX, input)) {
        int i;
        for (i = 0; i < LINE_MAX; i++) {
            if (line[i] != ' ') {
                if (line[i] == ';') {
                    break;
                } else {
                    int j;
                    for (j = i; j < LINE_MAX; j++) {
                        if (line[j] == '"') {
                            isQuote = !isQuote;
                        } else if (line[j] == '\0' || (!isQuote && line[j] == ';')) {
                            break;
                        }
                    }
                    strncat(page, line, j);
                    strcat(page, " ");
                    break;
                }
            }
        }
    }

    r = parseEval(page, env);
    cleanObject(&r);

    fclose(input);
    return 0;
}

#endif // STANDALONE