pebblisp/src/pebblisp.c

#ifdef STANDALONE
#define _GNU_SOURCE

#include <signal.h>
#include <ucontext.h>

#endif

#include "pebblisp.h"

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

#include <readline/readline.h>
#include <readline/history.h>

#include "tokens.h"
#include "plfunc.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 evalDefArgs(const Object* symbol, const Object* value,
                   struct Environment* env)
{
    const char* name = symbol->string;

    Object finalValue = eval(value, env);

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

    return cloneObject(*symbol);
}

/**
 * Add a struct to the environment with a given name and fields.
 *
 * (struct point (x y))
 */
Object evalStructArgs(const Object* symbol, const Object* fields, 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 boolObject(1);
}

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 evalLambdaArgs(const Object* argForms, struct Environment* env)
{
    return constructLambda(argForms, argForms ? argForms->forward : NULL, env);
}

Object evalMapArgs(const Object* argForms, struct Environment* env)
{
    if (!argForms) {
        return errorObject(NULL_MAP_ARGS);
    }

    Object lambda = eval(argForms, env);
    const Object* inputList = argForms->forward;

    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* params = &lambda.lambda->params;
            struct Environment newEnv = envForLambda(params, &tempInput, listLength(params), 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, "def") == 0) {
        return evalDefArgs(rest, rest->forward, env);
#ifndef LOW_MEM
    } else if (strcmp(first->string, "defe") == 0) {
        Object symbol = eval(rest, env);
        Object e = evalDefArgs(&symbol, rest->forward, env);
        cleanObject(&symbol);
        return e;
#endif
    } else 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, "map") == 0) {
        return evalMapArgs(rest, env);
    } else if (strcmp(first->string, "struct") == 0) {
        return evalStructArgs(rest, rest->forward, env);
    }

    *found = 0;
    return *first;
}

/**
 * Evaluates a list 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 list The list being evaluated
 * @param function First element of the list, already evaluated to be a function
 * @param length Length of `list` - 1, to exclude the already-evaluated element
 * @param env The environment to evaluate in
 */
Object listEvalFunc(const Object* list, const Object* function,
                    const int length, struct Environment* env)
{
    Object rest[length];

    const Object* start = list->list->forward;
    for (int i = 0; i < length; i++) {
        rest[i] = eval(start, env);
        start = start->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)
{
    Object funcList = startList(func);
    nf_addToList(&funcList, arg1);
    Object current = cloneObject(arg2);
    nf_addToList(&funcList, current);
    Object first_eval = eval(funcList.list, env);
    arg1 = listEvalFunc(&funcList, &first_eval, 2, env);
    cleanObject(&funcList);
    return arg1;
}

/**
 * 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
            return listEvalFunc(obj, &first_eval, 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 possessive(Object* params, int length, struct Environment* env)
{
    Object structo = params[0];
    Object field = params[1];

    if (structo.type != TYPE_STRUCT) {
        printf("`'s` must be used on a struct!\n");
        return errorObject(NULL_PARSE);
    }
    if (!isStringy(field)) {
        printf("`'s` field name must be stringy! Received a ");
        printType(&field);
        printObj(&field);
        printf("\n");
        return errorObject(NULL_PARSE);
    }

    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 isHelp = 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')",
              if (isHelp && 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);
        isHelp = next->text[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) {errorObject(UNSUPPORTED_NUMBER_TYPE), s};
        }
    } else if (s->length == 1 && (c == 'T' || c == 't')) {
        return (Result) {boolObject(1), s};
    } else if (s->length == 1 && (c == 'F' || c == 'f')) {
        return (Result) {boolObject(0), s};
    } else if (c == '"'/* || c == '\''*/) {
        return (Result) {objFromSlice(s->text, s->length), s};
    } else {
        if (s->text[s->length] == '\'' && s->text[s->length + 1] == 's') {
            Object possessiveFunc = newObject(TYPE_FUNC);
            possessiveFunc.func = &possessive;
            Object list = startList(possessiveFunc);
            Object possesser = symFromSlice(s->text, s->length);
            nf_addToList(&list, possesser);
            struct Slice* next = s + 3;
            Object possessed = objFromSlice(&next->text[-1], next->length + 1);
            nf_addToList(&list, possessed);
            return (Result) {list, next};
        }
        return (Result) {symFromSlice(s->text, s->length), s};
    }
}

struct Slice* lastOpen = NULL;

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
                obj.error->plContext = malloc(sizeof(struct Slice));
                *obj.error->plContext = *lastOpen;
                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;
}

#ifdef STANDALONE

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

void repl(struct Environment* env)
{
    char* buf;
    using_history();
    while ((buf = readline("pebblisp::> ")) != NULL) {
        if (strcmp("q", buf) == 0) {
            free(buf);
            break;
        }
        add_history(buf);
        Object o = parseEval(buf, env);
        size_t length;
        char *output = stringObj(&o, &length);
        printColored(output);
        printf("\n");
        cleanObject(&o);
        free(buf);
    }
}

void loadArgsIntoEnv(int argc, const char* argv[], struct Environment* env)
{
    Object args = listObject();
    for (int i = 0; i < argc; i++) {
        nf_addToList(&args, stringFromSlice(argv[i], strlen(argv[i])));
    }
    addToEnv(env, "args", args);
}

int nestedSegfault = 0;

void handler(int nSignum, siginfo_t* si, void* vcontext)
{
    if (nestedSegfault) {
        printf("Nested segfault!!!\n");
        exit(139);
    }
    nestedSegfault = 1;

    printf("Segfaulted!\n");
    if (lastOpen) {
        printf("line: %d\n%s\n", lastOpen->lineNumber, lastOpen->text);
    } else {
        printf("Happened before token processing.\n");
    }
    ucontext_t* context = vcontext;
    context->uc_mcontext.gregs[REG_RIP]++;
    exit(139);
}

int main(int argc, const char* argv[])
{
    struct Environment env = defaultEnv();
    setGlobal(&env);

    int ret = -1;
    if (argc == 2) {
        if (strcmp(argv[1], "--run-tests") == 0) {
            ret = runTests(0);
        } else if (strcmp(argv[1], "--run-tests=detailed") == 0) {
            ret = runTests(1);
        }
    }
    if (ret != -1) {
        shredDictionary();
        deleteEnv(global());
        return ret;
    }

    struct sigaction action;
    memset(&action, 0, sizeof(struct sigaction));
    action.sa_flags = SA_SIGINFO;
    action.sa_sigaction = handler;
    sigaction(SIGSEGV, &action, NULL);

    readFile(SCRIPTDIR "/lib.pbl", &env);
    if (argc >= 2) {
        FILE* file = fopen(argv[1], "r");
        if (file) {
            // Executing a file
            loadArgsIntoEnv(argc, argv, &env);
            _readFile(file, &env);
        } else {
            // Running arguments directly as pl code
            Object r = numberObject(0);
            for (int i = 1; i < argc; i++) {
                r = parseEval(argv[i], &env);
                printAndClean(&r);
            }
        }
    } else {
        // Running a repl
        loadArgsIntoEnv(argc, argv, &env);
        repl(&env);
    }
    deleteEnv(&env);
    shredDictionary();
    // fprintf(stderr, "\nHEAP-ALLOCATED OBJECTS: %d\n", getAllocations());
    // fprintf(stderr, "TOTAL OBJECT.C ALLOC: %zu\n", getBytes());
}

#endif