pebblisp/src/pebblisp.c

#include "pebblisp.h"
#include "tokens.h"
#include <stdlib.h>
#include <string.h>
#include <stdio.h>

#ifndef STANDALONE
#undef printf
#define printf(...) APP_LOG(APP_LOG_LEVEL_DEBUG, __VA_ARGS__)
#endif

Object evalDefArgs(const Object *argForms, struct Environment *env)
{
    const Object *newSymbol = argForms;
    const char *name = newSymbol->string;

    if(argForms->type == TYPE_LIST && argForms->forward->type == TYPE_LIST) {
        FOR_POINTERS_IN_LISTS(argForms, argForms->forward) {
            Object newValue = eval(P2, env);
            addToEnv(env, P1->string, newValue);
            cleanObject(&newValue);
        }
        return cloneObject(*newSymbol);
    }

    Object newValue = eval(newSymbol->forward, env);

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

    return cloneObject(*newSymbol);
}

Object evalIfArgs(const Object *argForms, struct Environment *env)
{
    return eval(argForms, env).number ?
            eval(argForms->forward, env) :
            eval(argForms->forward->forward, env);
}

Object evalLambdaArgs(const Object *argForms)
{
    return constructLambda(
            argForms, // Params
            argForms ? argForms->forward : NULL // Body
    );
}

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;
    Object outputList = listObject();

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

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

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

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

    return outputList;
}

Object evalBuiltIns(const Object *first, const Object *rest,
                    struct Environment *env)
{
    if(first->type != TYPE_SYMBOL) {
        return errorObject(NOT_A_SYMBOL);
    }

    if(strcmp(first->string, "def") == 0) {
        return evalDefArgs(rest, env);
    } else if(strcmp(first->string, "if") == 0) {
        return evalIfArgs(rest, env);
    } else if(strcmp(first->string, "fn") == 0) {
        return evalLambdaArgs(rest);
    } else if(strcmp(first->string, "map") == 0) {
        return evalMapArgs(rest, env);
    }

    return errorObject(BUILT_IN_NOT_FOUND);
}

void evalForms(Object *destList, const Object *src, struct Environment *env)
{
    int length = listLength(src) - 1; // Not counting first_form
    for(int i = 0; i < length; i++) { // Evaluates all in list
        Object *ptr = itemAt(src, i + 1); // Skip the first
        destList[i] = eval(ptr, env);
    }
}

Object evalList(const Object *obj, struct Environment *env)
{
    const int evalLength = listLength(obj);

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

    if(evalLength == 1) {
        if(listLength(obj->list) == 0)
            return cloneObject(*obj);
        return eval(obj->list, env);
    }

    Object *first_form = obj->list;

    { // Try to eval built-ins
        const Object builtIn =
                evalBuiltIns(first_form, first_form->forward, env);

        if(!isError(builtIn, BUILT_IN_NOT_FOUND) &&
            !isError(builtIn, NOT_A_SYMBOL)) {
            return builtIn;
        }
    }

    Object first_eval = eval(first_form, env);
    if(first_eval.type == TYPE_FUNC) {
        int length = evalLength - 1; // Not counting first_form
        Object rest[length];
        evalForms(rest, obj, env);

        Object func_eval = rest[0];
        if(length == 1) {
            func_eval = first_eval.func(
                    func_eval, errorObject(ONLY_ONE_ARGUMENT), env);
            // Consider it a partial function if only one arg
            if(isError(func_eval, ONLY_ONE_ARGUMENT))
                return cloneObject(*obj);
        } else {
            for(int i = 1; i < length; i++) {
                Object toClean = func_eval;
                func_eval = first_eval.func(func_eval, rest[i], env);
                cleanObject(&toClean);
                cleanObject(&rest[i]);
            }
        }

        return func_eval;

    } else if (first_eval.type == TYPE_LAMBDA) {
        struct Environment newEnv = envForLambda(
                &first_eval.lambda->params,
                first_form->forward,
                env
        );
        Object ret = eval(&first_eval.lambda->body, &newEnv);
        deleteEnv(&newEnv);
        cleanObject(&first_eval);
        Object *t = tail(&ret);
        if(t) {
            // cleanObject(&ret);
            return cloneObject(*t);
        }
        return ret;

    } else {
        Object list = listObject();
        FOR_POINTER_IN_LIST(obj) {
            nf_addToList(&list, eval(POINTER, env));
        }
        return list;
    }
}

Object eval(const Object *obj, struct Environment *env)
{
    switch(obj->type) {
        case TYPE_ERROR:
        case TYPE_FUNC:
            return *obj;

        case TYPE_OTHER:
        case TYPE_NUMBER:
        case TYPE_BOOL:
        case TYPE_STRING:
            return cloneObject(*obj);

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

        case TYPE_LIST:
            return evalList(obj, env);

        case TYPE_LAMBDA:
            return eval(&obj->lambda->body, env);
    }

    return errorObject(BAD_TYPE);
}

Object catObjects(const Object obj1, const Object obj2, struct Environment *env)
{
    Object evalObj1 = eval(&obj1, env);
    Object evalObj2 = eval(&obj2, env);

    char str1[100] = "";
    char str2[100] = "";
    stringObj(str1, &evalObj1);
    stringObj(str2, &evalObj2);
    cleanObject(&evalObj1);
    cleanObject(&evalObj2);
    int length = strlen(str1) + strlen(str2) + 1;

    Object o = newObject(TYPE_STRING);
    o.string = calloc(sizeof(char), length);
    strcat(o.string, str1);
    strcat(o.string, str2);

    return o;
}

Object listEquality(const Object *list1, const Object *list2)
{
    FOR_POINTERS_IN_LISTS(list1, list2) {
        if(P1->type != P2->type || P1->number != P2->number)
            return boolObject(0);
    }
    return boolObject(1);
}

Object _basicOp(const Object *obj1, const Object *obj2, const char op,
                struct Environment *env)
{
    const int n1 = obj1->number;
    const int n2 = obj2->number;

    switch(op){
        case '+':
            if(obj1->type == TYPE_STRING || obj2->type == TYPE_STRING)
                return catObjects(*obj1, *obj2, env);
            return numberObject(n1 + n2);
        case '-':
            return numberObject(n1 - n2);
        case '*':
            return numberObject(n1 * n2);
        case '/':
            return numberObject(n1 / n2);
        case '%':
            return numberObject(n1 % n2);

        case '=':
            if(obj1->type == TYPE_STRING && obj2->type == TYPE_STRING)
                return boolObject(!strcmp(obj1->string, obj2->string));
            if(obj1->type == TYPE_LIST && obj2->type == TYPE_LIST)
                return listEquality(obj1, obj2);
            return boolObject(n1 == n2 && obj1->type == obj2->type);
        case '>':
            return boolObject(n1 > n2);
        case '<':
            return boolObject(n1 < n2);
    }

    return *obj1;
}

Object basicOp(const Object *obj1, const Object *obj2, const char op,
               struct Environment *env)
{
    if(isError(*obj2, ONLY_ONE_ARGUMENT))
        return *obj2;

    int lists = (obj1->type == TYPE_LIST) + (obj2->type == TYPE_LIST);
    if(lists == 0) {
        return _basicOp(obj1, obj2, op, env);

    } else if(lists == 1) { // Single operand is applied to each element in list
        const Object *listObj = (obj1->type == TYPE_LIST)? obj1 : obj2;
        const Object *singleObj = (obj1->type == TYPE_LIST)? obj2 : obj1;

        Object newList = listObject();
        FOR_POINTER_IN_LIST(listObj) {
            Object adding = eval(POINTER, env);
            nf_addToList(&newList, _basicOp(&adding, singleObj, op, env));
        }
        return newList;

    } else { // 2 lists with the op applied to matching indices of both lists
        if(listLength(obj1) == listLength(obj2)) {
            Object newList = listObject();
            FOR_POINTERS_IN_LISTS(obj1, obj2) {
                const Object ev1 = eval(P1, env);
                const Object ev2 = eval(P2, env);
                nf_addToList(&newList, _basicOp(&ev1, &ev2, op, env));
            }
            return newList;
        } else {
            return errorObject(LISTS_NOT_SAME_SIZE);
        }
    }
}

#define BASIC_OP(_name, _char) \
Object _name(Object obj1, Object obj2, struct Environment *env) \
    { return basicOp(&obj1, &obj2, _char, env); }

BASIC_OP(add, '+');
BASIC_OP(sub, '-');
BASIC_OP(mul, '*');
BASIC_OP(dvi, '/');
BASIC_OP(mod, '%');
BASIC_OP(equ, '=');
BASIC_OP(gth, '>');
BASIC_OP(lth, '<');

#undef BASIC_OP

Object filter(Object obj1, Object obj2, struct Environment *env)
{
    Object filteredList = listObject();
    Object *filteringList = &obj2;
    FOR_POINTER_IN_LIST(filteringList) {
        Object conditional = cloneObject(obj1);
        nf_addToList(&conditional, *POINTER); // cloneObject()?
        Object result = eval(&conditional, env);
        cleanObject(&conditional);
        if(result.number == 1) {
            nf_addToList(&filteredList, *POINTER);
        }
    }
    return filteredList;
}

Object append(Object list, Object newElement, struct Environment *env)
{
    Object newList = cloneObject(list);
    nf_addToList(&newList, cloneObject(newElement));
    return newList;
}

Object prepend(Object list, Object newElement, struct Environment *env)
{
    Object newList = listObject();
    nf_addToList(&newList, cloneObject(newElement));
    appendList(&newList, &list);
    return newList;
}

Object at(Object index, Object list, struct Environment *env)
{
    return cloneObject(*itemAt(&list, index.number));
}

Object rest(Object list, Object ignore, struct Environment *env)
{
    Object ret = listObject();
    Object *l = &list;
    FOR_POINTER_IN_LIST(l) {
        if(POINTER == l->list)
            continue;
        nf_addToList(&ret, cloneObject(*POINTER));
    }
    return ret;
}

Object reverse(Object _list, Object ignore, struct Environment *ignore2)
{
    const Object *list = &_list;
    Object rev = listObject();

    Object *tail = NULL;
    FOR_POINTER_IN_LIST(list) {
        Object *oldTail = tail;
        allocObject(&tail, cloneObject(*POINTER));
        if(oldTail)
            tail->forward = oldTail;
    }

    rev.list = tail;
    return rev;
}

Object isNum(Object test, Object ignore, struct Environment *ignore2)
{
	return test.type == TYPE_NUMBER ?
		boolObject(1) : boolObject(0);
}

Object isString(Object test, Object ignore, struct Environment *ignore2)
{
	return test.type == TYPE_STRING ?
		boolObject(1) : boolObject(0);
}

Object print(Object p, Object ignore, struct Environment *env)
{
    p = cloneObject(p);
    p = eval(&p, env);
    _printObj(&p, 0);
    return p;
}

Object pChar(Object c, Object i1, struct Environment *i2)
{
    if(c.type != TYPE_NUMBER) {
        return errorObject(BAD_NUMBER);
    }
    printf("%c", c.number % 256);
    return numberObject(0);
}

Object printEnvO(Object i1, Object i2, struct Environment *env) {
    while(env->outer) {
        env = env-> outer;
    }

    printEnv(env);
    return numberObject(0);
}

Object parseEvalO(Object text, Object ignore, struct Environment *env)
{
    if(text.type != TYPE_STRING) {
        return errorObject(CAN_ONLY_EVAL_STRINGS);
    }
    return parseEval(text.string, env);
}

#ifdef STANDALONE
Object takeInput(Object i1, Object i2, struct Environment *i3)
{
    char input[256] = "";
    fgets(input, 256, stdin);
    return stringFromSlice(input, strlen(input) - 1);
}
#endif

void copySlice(char * dest, struct Slice *src)
{
    if(!dest || !src)
        return;
    strncpy(dest, src->text, src->length);
    dest[(int)src->length] = '\0';
}

void debugSlice(struct Slice *s)
{
    if(!s) {
        printf("NULL SLICE\n");
        return;
    }
    printf("Debug Slice\n    text:'");
    for(int i = 0; i < s->length; i++) {
        printf("%c", s->text[i]);
        if(s->text[i] == '\0')
            printf("NULLCHAR\n");
    }
    printf("'\n");
    printf("  length: %d\n", s->length);
}

Result parse(struct Slice *slices)
{
    struct Slice *token = slices;
    if(token && token->text) {
        struct Slice *rest = &slices[1];
        if(token->text[0] == '(') {
            // todo check for null rest
            return readSeq(rest);
        } else { // todo error on missing close paren
            return (Result){parseAtom(token), rest};
        }
    } else {
        return (Result){errorObject(NULL_PARSE), NULL};
    }
}

Result readSeq(struct Slice *tokens)
{
    Object res = listObject();
    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);
        if(r.obj.type == TYPE_ERROR)
            return r;
        nf_addToList(&res, cloneObject(r.obj));
        tokens = r.slices;
        cleanObject(&r.obj);
    }
}

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

Object parseAtom(struct Slice *s)
{
    const char c = s->text[0];
    if(isDigit(c)) {
        if(c != '0' || s->length == 1) {
            return parseDecimal(s);
        } else if(c == '0' && s->text[1] == 'x') {
            return parseHex(s);
        } else if(c == '0' && s->text[1] == 'b') {
            return parseBin(s);
        } else {
            return errorObject(UNSUPPORTED_NUMBER_TYPE);
        }
    } else if (s->length == 1 && (c == 'T' || c == 't')) {
        return boolObject(1);
    } else if (s->length == 1 && (c == 'F' || c == 'f')) {
        return boolObject(0);
    } else if (c == '"' || c == '\'') {
        return objFromSlice(s->text, s->length);
    } else {
        return symFromSlice(s->text, s->length);
    }
}

Object parseEval(const char *input, struct Environment *env)
{
    struct Slice *tokens = nf_tokenize(input);
    if(!tokens)
        return errorObject(MISMATCHED_PARENS);
    if(!tokens->text)
        return symFromSlice(" ", 1);

    #ifdef DEBUG
    struct Slice *debug = tokens;
    printd("start slice\n");
    if(debug) {
        while(debug->text) {
            char tok[100];
            copySlice(tok, debug);
            printd("slice: '%s'\n", tok);
            debug++;
        }
    }
    #endif

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

        if(parens == 0) {
            cleanObject(&obj);
            Object parsed = parse(tok).obj;
            if(parsed.type == TYPE_ERROR)
                return parsed;
            if(tok[i].text[0] == ')') {
                tok = &tok[i + 1];
                i = -1;
            }
            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;
    }
    Object r = numberObject(0);
    char page[4096] = "";
    const unsigned LINE_MAX = 256;
    char line[LINE_MAX];
    if(fgets(line, LINE_MAX, input)){
        if(line[0] != '#' || line[1] != '!') {
            strncat(page, line, strlen(line) - 1);
        }
    }
    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 = 0;
                    for(j = i; j < LINE_MAX; j++) {
                        if(line[j] == ';' || line[j] == '\0')
                            break;
                    }
                    strncat(page, line, j);
                    strcat(page, " ");
                    break;
                }
            }
        }
    }

    r = parseEval(page, env);
    cleanObject(&r);
    printf("\n");

    fclose(input);
    return 0;
}

void repl(struct Environment *env)
{
    char input[200] = "";
    while(input[0] != 'q') {
        printf("pebblisp>> ");
        fgets(input, 100, stdin);
        Object obj = parseEval(input, env);
        printAndClean(&obj);
    }
}

int main(int argc, const char* argv[])
{
    struct Environment env = defaultEnv();
    if(argc >= 2) {
        if(readFile(argv[1], &env) != 0) {
            Object r = numberObject(0);
            for(int i = 1; i < argc; i++) {
                r = parseEval(argv[i], &env);
                printAndClean(&r);
            }
        }
    } else {
        repl(&env);
    }
    deleteEnv(&env);
}
#endif