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 (!isListy(*fields)) {
        return errorObject(NOT_A_LIST);
    }

    struct StructDef def;
    def.name = malloc(sizeof(char) * (strlen(name) + 1));
    strcpy(def.name, name);

    def.fieldCount = listLength(fields);
    def.names = malloc(sizeof(char*) * def.fieldCount);

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

/**
 * Not a typical pl function because it relies almost exclusively on symbols
 */
Object evalLambdaArgs(const Object* argForms, struct Environment* env)
{
    return constructLambda(argForms, argForms ? argForms->forward : NULL, env);
}

Object mapO(Object* params, int length, struct Environment* env)
{
    if (length < 2) {
        return errorObject(NULL_MAP_ARGS);
    }

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

    if (lambda.type != TYPE_LAMBDA) {
        return errorObject(BAD_TYPE);
    }

    Object outputList = listObject();
    if (inputList) {
        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
            Object lambda_output = eval(&lambda.lambda->body, &newEnv);
            nf_addToList(&outputList, lambda_output);
            deleteEnv(&newEnv);
            cleanObject(&tempInput);
        }
    }
    cleanObject(&lambda);

    return outputList;
}

Object evalBuiltIns(const Object* first, const Object* rest,
                    struct Environment* env, int* found)
{
    *found = 1;
    if (strcmp(first->string, "if") == 0) {
        return evalIfArgs(rest, env);
    } else if (strcmp(first->string, "fn") == 0) {
        return evalLambdaArgs(rest, env);
    } else if (strcmp(first->string, "struct") == 0) {
        return evalStructArgs(rest, rest->forward, env);
    }

    *found = 0;
    return *first;
}

/**
 * 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 First element of the paramList, already evaluated to be a function
 * @param paramList The 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;
}

Object simpleFuncEval(const Object func, Object arg1, Object arg2, struct Environment* env)
{
    arg2 = cloneObject(arg2);
    arg1.forward = &arg2;
    Object first_eval = eval(&func, env);
    Object ret = listEvalFunc(&first_eval, &arg1, 2, env);
    cleanObject(&first_eval);
    cleanObject(&arg2);
    return ret;
}

/**
 * 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 First element of the list, already evaluated to be a lambda
 * @param remaining The first element after `lambda`
 * @param env The environment to evaluate in
 */
Object listEvalLambda(Object* lambda, const Object* remaining, int evalLength,
                      struct Environment* env)
{
    struct Environment newEnv =
        envForLambda(&lambda->lambda->params, remaining, evalLength - 1, 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;
}

/**
 * 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) {
        int found;
        Object builtIn = evalBuiltIns(first_form, first_form->forward, env, &found);
        if (found) {
            return builtIn;
        }

        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, obj->list->forward, evalLength - 1, env);

        case TYPE_LAMBDA:
            return listEvalLambda(&first_eval, first_form->forward, evalLength, 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:
            return cloneObject(*obj);

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

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

    return errorObject(BAD_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);
    for (int i = 0; i < structDef->fieldCount; i++) {
        if (strcmp(field.string, structDef->names[i]) == 0) {
            return cloneObject(structo.structObject->fields[i]);
        }
    }

    printf("Could not find field name `%s`\n", field.string);
    return errorObject(NULL_PARSE);
}

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] == '(') {
            // todo check for null rest
            return readSeq(rest);
        } else {    // todo error on missing close paren
            Result r = parseAtom(token);
            r.slices = &r.slices[1];
            return r;
        }
    } else {
        return (Result) { errorObject(NULL_PARSE), NULL };
    }
}

#ifdef SUGAR
#define sugar(_desc, _code) ;
#else
#define sugar(_desc, _code) _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);
}

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] == '.') {
        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 = objFromSlice(&next->text[-1], next->length + 1);
        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,
                 int (* typeChecks[])(Object), int typeLength, int* failed)
{
    *failed = 1;
    if ((typeLength - 1) > length) {
        return errorWithContext(NOT_ENOUGH_ARGUMENTS, funcName);
    }
    for (int i = 0; i < typeLength - 1; i++) {
        if (typeChecks[i] && !typeChecks[i](params[i])) { // TODO: Use pl func name instead of C function name.
            return /*errorObject(BAD_TYPE); */ errorWithContextLineNo(BAD_PARAMS_ON, funcName, 0, NULL);
        }
    }
    *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