pebblisp/src/object.c

#include "object.h"
#include "pebblisp.h"
#include "env.h"

#include <stdio.h>
#include <string.h>

#ifdef STANDALONE

#include "threads.h"

size_t bytes = 0;

size_t getBytes()
{
    return bytes;
}

#undef malloc
#undef calloc

void* smalloc(size_t size)
{
    bytes += size;
    return malloc(size);
}

void* scalloc(size_t size, size_t count)
{
    bytes += (size * count);
    return calloc(size, count);

}

#define malloc(x) smalloc(x)
#define calloc(x, y) scalloc(x, y)
#endif

/**
 * Returns the length of a given list Object
 * @param listObj The list to get the length of
 * @return Length of the list if non-null and of the list type. Otherwise -1
 */
int listLength(const Object* listObj)
{
    int len = 0;
    FOR_POINTER_IN_LIST(listObj) {
        len++;
    }
    return len;
}

/**
 * Returns a pointer to the Object at the given index in a given list
 * @param listObj The list to fetch an Object from
 * @param n The index to to fetch from the list
 * @return A pointer to the Object, if it is found, or NULL on an error
 */
Object* itemAt(const Object* listObj, int n)
{
    FOR_POINTER_IN_LIST(listObj) {
        if (n-- == 0) {
            return POINTER;
        }
    }
    return NULL;
}

/**
 * Returns a pointer to the last Object in the given list.
 * @param listObj The list to find the tail of
 * @return A pointer to the last Object if it is found, or NULL on an error
 */
Object* tail(const Object* listObj)
{
    if (!listObj || !isListy(*listObj)) {
        return NULL;
    }

    Object* tail = NULL;
    FOR_POINTER_IN_LIST(listObj) {
        tail = POINTER;
    }
    return tail;
}

int allocations = 0;

int getAllocations()
{
    return allocations;
}

/**
 * Allocate a copy of a given object into the given pointer.
 * Does nothing if `spot` is NULL
 * @param spot A pointer to the Object pointer that needs allocating
 * @param src The Object to copy from
 */
void allocObject(Object** spot, const Object src)
{
#ifdef ALLOCATION_CAP
    if (allocations >= 10000) {
        printf("MAX ALLOCATIONS EXCEEDED\n");
        *spot = NULL;
        return;
    }
#endif
    allocations++;
    *spot = malloc(sizeof(struct Object));
    **spot = src;
    (*spot)->forward = NULL;
}

/**
 * Adds an Object to the end of a list
 * Does nothing if `dest` is NULL or not a list type
 * @param dest The list to append to
 * @param src The Object to copy into the list
 * @returns A pointer to the tail of the destination list
 */
Object* nf_addToList(Object* dest, const Object src)
{
    if (dest->list == NULL) {
        allocObject(&dest->list, src);
        return dest->list;
    }

    Object* listTail = tail(dest);
    allocObject(&listTail->forward, src);
    return listTail->forward;
}

#ifndef SIMPLE_ERRORS
static const char* errorText[] = {
    "MISMATCHED_PARENS",
    "NULL_ENV",
    "EMPTY_ENV",
    "NULL_PARSE",
    "NULL_LAMBDA_LIST",
    "NULL_MAP_ARGS",
    "LAMBDA_ARGS_NOT_LIST",
    "DID_NOT_FIND_SYMBOL",
    "BAD_TYPE",
    "BAD_PARAMS",
    "BAD_NUMBER",
    "UNSUPPORTED_NUMBER_TYPE",
    "NOT_ENOUGH_ARGUMENTS",
    "NOT_A_LIST",
    "SCRIPT_NOT_FOUND",
    "NO_CLONE_SPECIFIED",
    "CAN_ONLY_EVAL_STRINGS",
    "UNEXPECTED_EOF",
    "INDEX_PAST_END" };
#endif

size_t inflate(struct string* s, size_t additional)
{
    size_t length = (s->cursor - s->allocPoint) + additional;

    int needsInflation = 0;
    while (length > s->capacity - 8) {
        s->capacity *= 2;
        needsInflation = 1;
    }

    if (needsInflation) {
        char* oldAlloc = s->allocPoint;
        s->allocPoint = malloc(sizeof(char) * s->capacity);
        size_t l = sprintf(s->allocPoint, "%s", oldAlloc);
        s->cursor = s->allocPoint + l;
        free(oldAlloc);
    }

    return s->capacity;
}

int stringNObj(struct string* s, const Object* obj);

/**
 * Creates a string from a given list Object
 * Blocks out with parens
 * Returns immediately if `dest` is NULL, or `obj` is not a list type
 * @param dest The string to copy the list text into
 * @param obj The list Object to make a string from
 */
void stringList(struct string* s, const Object* obj)
{
    s->cursor += sprintf(s->cursor, "(");

    FOR_POINTER_IN_LIST(obj) {
        s->cursor += sprintf(s->cursor, " ");
        stringNObj(s, POINTER);
        inflate(s, 0);
    }
    s->cursor += sprintf(s->cursor, " )");
}

/**
 * Creates a string from a given struct Object
 * Blocks out with curly braces
 */
void stringStruct(struct string* s, const Object* obj)
{
    struct StructObject* so = obj->structObject;
    s->cursor += sprintf(s->cursor, "{");

    struct StructDef* def = getStructAt(so->definition);
    for (int i = 0; i < def->fieldCount; i++) {
        s->cursor += sprintf(s->cursor, " %s: ", def->names[i]);
        int isString = so->fields[i].type == TYPE_STRING;
        if (isString) {
            s->cursor += sprintf(s->cursor, "\"");
        }

        stringNObj(s, &so->fields[i]);

        if (isString) {
            s->cursor += sprintf(s->cursor, "\"");
        }
        s->cursor += sprintf(s->cursor, ",");
    }
    s->cursor--;
    s->cursor += sprintf(s->cursor, " }");
}

/**
 * Creates a string from a given Object
 * Returns NULL if either param is NULL
 *
 * Prints
 * -# Numbers without spaces
 * -# Symbols as their name
 * -# Bools as 'T' or 'F'
 * -# Strings as their string value
 * -# Lists using stringList()
 * -# Errors as the integer value, prepended with 'E'
 * -# Otherwise as the raw number, prepended with 'X'
 *
 * @param dest The string to copy the list text into
 * @param obj The list Object to make a string from
 */
int stringNObj(struct string* s, const Object* obj)
{
    inflate(s, 16);
    switch (obj->type) {
        case TYPE_NUMBER:
            s->cursor += sprintf(s->cursor, "%ld", obj->number);
            break;
        case TYPE_BOOL:
            s->cursor += sprintf(s->cursor, "%s", obj->number ? "T" : "F");
            break;
        case TYPE_SYMBOL:
        case TYPE_STRING: {
            size_t stringLen = strlen(obj->string);
            inflate(s, stringLen);
            const char* format = obj->type == TYPE_STRING ? "%s" : "`%s`";
            s->cursor += sprintf(s->cursor, format, obj->string);
            break;
        }
        case TYPE_STRUCT:
            stringStruct(s, obj);
            break;
        case TYPE_SLIST:
            s->cursor += sprintf(s->cursor, "'");
        case TYPE_LIST:
            stringList(s, obj);
            break;
        case TYPE_PROMISE:
            s->cursor += sprintf(s->cursor, isDone(obj->promise) ? "<DONE>" : "<PENDING>");
            break;
        case TYPE_ERROR: {
            int code = getErrorCode(*obj);
#ifdef SIMPLE_ERRORS
            s->cursor += sprintf(s->cursor, "E[%d]", (int)code);
#else
            inflate(s, 128);
            if (obj->error->context && obj->error->context[0] != '\0') {
                s->cursor += sprintf(s->cursor, "%s: %s", errorText[code],
                                     obj->error->context);
            } else if (code >= 0 && code <= INDEX_PAST_END) {
                s->cursor += sprintf(s->cursor, "%s", errorText[code]);
            } else {
                s->cursor += sprintf(s->cursor, "BROKEN ERROR CODE: %d", code);
            }
#endif
            break;
        }
        case TYPE_FUNC:
            s->cursor += sprintf(s->cursor, "F%ld", obj->number);
            break;
        case TYPE_LAMBDA: {
#ifdef STANDALONE
#ifdef DEBUG
            s->cursor += sprintf(s->cursor, "\\x%d", obj->number);
#endif
            char* docString = obj->lambda->params.docString;
            if (docString) {
                inflate(s, strlen(docString));
                s->cursor += sprintf(s->cursor, "%s\n", docString);
            }
            stringNObj(s, &obj->lambda->params);
            s->cursor += sprintf(s->cursor, " -> ");
            stringNObj(s, &obj->lambda->body);
            s->cursor += sprintf(s->cursor, ">");
#else
            s->cursor += sprintf(s->cursor, "\\x%d", obj->number);
#endif
            break;
        }
        case TYPE_OTHER:
            s->cursor += sprintf(s->cursor, "%p", obj->other->data);
            break;
    }

    if (!isValidType(*obj)) {
        s->cursor += sprintf(s->cursor, "BAD_TYPE(%d) X%ld", obj->type, obj->number);
    }

    return 0;
}

char* stringObj(const Object* obj, size_t* length)
{
    char* alloc = malloc(8);
    struct string s = {
        .allocPoint = alloc,
        .cursor = alloc,
        .capacity = 8,
    };
    s.allocPoint[0] = '\0';
    stringNObj(&s, obj);
    *length += s.cursor - s.allocPoint;
    return s.allocPoint;
}

#if defined(DEBUG) || defined(STANDALONE)

#define SIMPLE_TYPE(_type) case _type:\
    return #_type;

const char* getTypeName(const Object* obj)
{
    if (!obj) {
        return "NULL_OBJECT";
    }
    switch (obj->type) {
        SIMPLE_TYPE(TYPE_NUMBER);
        SIMPLE_TYPE(TYPE_STRUCT);
        SIMPLE_TYPE(TYPE_BOOL);
        SIMPLE_TYPE(TYPE_LIST);
        SIMPLE_TYPE(TYPE_SLIST);
        SIMPLE_TYPE(TYPE_FUNC);
        SIMPLE_TYPE(TYPE_SYMBOL);
        SIMPLE_TYPE(TYPE_STRING);
        SIMPLE_TYPE(TYPE_PROMISE);
        SIMPLE_TYPE(TYPE_OTHER);
        SIMPLE_TYPE(TYPE_ERROR);
        SIMPLE_TYPE(TYPE_LAMBDA);
    }

    return "UNKNOWN_TYPE";
}

void _printObj(const Object* obj, int newline)
{
    if (!obj) {
        printf(newline ? "\n" : "");
        return;
    }
    size_t length;
    char* temp = stringObj(obj, &length);
    if (newline) {
        printf("%s\n", temp);
        if (obj->type == TYPE_ERROR) {
            if (obj->error && obj->error->plContext) {
                printf("%s\n", obj->error->plContext->text);
            }
        }
    } else {
        printf("%s", temp);
    }
    free(temp);
}

/**
 * Prints the given Object and a newline.
 * Uses stringObj() to create the printed string
 * @param obj The Object to print
 */
inline void printObj(const Object* obj)
{
    _printObj(obj, 1);
}

#endif

/**
 * Performs appropriate free() on a given Object and NULLs its ->forward
 *
 * Strings: The Object's ->string is freed
 * Lists: deleteList() is called on the Object (may recurse)
 * Lambdas: The body and params are cleaned, and the lambda itself is freed
 *
 * @param target The object to clean
 */
void cleanObject(Object* target)
{
    switch (target->type) {
        case TYPE_STRING:
        case TYPE_SYMBOL:
            if (!(target->string[-1] -= 1)) {
                free(target->string - 1);
            }
            break;
        case TYPE_LIST:
        case TYPE_SLIST:
            deleteList(target);
            break;
        case TYPE_LAMBDA:
            target->lambda->refs -= 1;
            if (!target->lambda->refs) {
                cleanObject(&target->lambda->params);
                cleanObject(&target->lambda->body);
                free(target->lambda->params.docString);
                free(target->lambda);
            }
            break;
        case TYPE_STRUCT:
            for (int i = 0; i < getStructAt(target->structObject->definition)->fieldCount; i++) {
                cleanObject(&target->structObject->fields[i]);
            }
            free(target->structObject->fields);
            free(target->structObject);
            break;
        case TYPE_PROMISE:
            cleanPromise(target->promise);
            break;
        case TYPE_ERROR:
#ifndef SIMPLE_ERRORS
            free(target->error->plContext);
            free(target->error->context);
            free(target->error);
#endif
            break;
        case TYPE_OTHER:
            if (target->other->cleanup) {
                target->other->cleanup(target);
            }
            break;
        case TYPE_BOOL:
        case TYPE_NUMBER:
        case TYPE_FUNC:
            break;
    }
}

/**
 * Print the given object with a newline, then clean it
 * @param target The object to print and clean
 */
#ifdef STANDALONE

void printAndClean(Object* target)
{
    printObj(target);
    cleanObject(target);
}

#endif

/**
 * Frees all objects in a given list
 * Runs cleanObject() on every item in the list (may recurse)
 *
 * @param dest The list object to clean up
 */
void deleteList(Object* dest)
{
    Object* march = dest->list;
    while (march != NULL) {
        Object* prevMarch = march;
        march = march->forward;
        cleanObject(prevMarch);
        free(prevMarch);
    }
}

void _copyList(Object* dest, const Object* src)
{
    FOR_POINTER_IN_LIST(src) {
        if (isListy(*POINTER)) {
            nf_addToList(dest, *POINTER);
            tail(dest)->list = NULL;
            _copyList(tail(dest), POINTER);
        } else if (isStringy(*POINTER)) {
            nf_addToList(dest, cloneString(*POINTER));
        } else {
            nf_addToList(dest, cloneObject(*POINTER));
        }
    }
}

/**
 * Does a deep copy of all items from `src` to `dest`
 * Does nothing if either param is NULL, or not a list type
 * Does a shallow delete of items from `dest` before copying
 * May recurse into lists in the list
 *
 * @param dest The list to copy to
 * @param src The list to copy from
 */
Object copyList(const Object* src)
{
    Object list = *src;
    list.forward = NULL;
    list.list = NULL;
    _copyList(&list, src);
    return list;
}

/**
 * Does a deep copy of all items from `src` to the end of `dest`
 * Does nothing if either param is NULL, or not a list type
 * May recurse into lists in the list
 *
 * @param dest The list to copy to
 * @param src The list to copy from
 */
void appendList(Object* dest, const Object* src)
{
    _copyList(dest, src);
}

/**
 * Returns a basic Object with NULL forward and the given type
 * @param type The type of Object to create
 * @return The created Object
 */
inline Object newObject(Type type)
{
    Object no;
    no.forward = NULL;
    no.type = type;
    return no;
}

// Returns an empty list Object
inline Object listObject()
{
    Object list = newObject(TYPE_LIST);
    list.list = NULL;
    return list;
}

// Returns an empty struct Object
inline Object structObject(int definition)
{
    Object structo = newObject(TYPE_STRUCT);
    structo.structObject = malloc(sizeof(struct StructObject));
    structo.structObject->definition = definition;
    structo.structObject->fields = malloc(sizeof(Object) * getStructAt(definition)->fieldCount);
    return structo;
}

// Returns a list Object starting with the given Object
inline Object startList(const Object start)
{
    Object list = listObject();
    nf_addToList(&list, start);
    return list;
}

inline int isNumber(const Object test)
{
    return test.type == TYPE_NUMBER;
}

inline int isListy(const Object test)
{
    return test.type == TYPE_LIST || test.type == TYPE_SLIST;
}

inline int isStringy(const Object test)
{
    return test.type == TYPE_STRING || test.type == TYPE_SYMBOL;
}

inline int isBool(const Object test)
{
    return test.type == TYPE_BOOL;
}

inline int isStruct(const Object test)
{
    return test.type == TYPE_STRUCT;
}

inline int isFuncy(const Object test)
{
    return test.type == TYPE_LAMBDA || test.type == TYPE_FUNC;
}

inline int isValidType(const Object test)
{
    switch (test.type) {
        case TYPE_NUMBER:
        case TYPE_BOOL:
        case TYPE_LIST:
        case TYPE_STRUCT:
        case TYPE_SLIST:
        case TYPE_FUNC:
        case TYPE_SYMBOL:
        case TYPE_LAMBDA:
        case TYPE_STRING:
        case TYPE_PROMISE:
        case TYPE_OTHER:
        case TYPE_ERROR:
            return 1;
    }

    return 0;
}

/**
 * Clones the given lambda with new allocations
 * Will behave unexpectedly if given something other than a lambda object!
 */
inline Object cloneLambda(const Object old)
{
    old.lambda->refs += 1;
    return old;
}

Object cloneString(Object obj)
{
    obj.string[-1] += 1;
    return obj;
}

// Returns an Object with a deep copy of the given Object
Object cloneOther(const Object src)
{
    return src.other->clone ? src.other->clone(src.other) : src;
}

Object cloneStruct(Object src);

inline Object cloneObject(const Object src)
{
    switch (src.type) {
        case TYPE_SLIST:
        case TYPE_LIST:
            return copyList(&src);
        case TYPE_LAMBDA:
            return cloneLambda(src);
        case TYPE_STRUCT:
            return cloneStruct(src);
        case TYPE_STRING:
        case TYPE_SYMBOL:
            return cloneString(src);
        case TYPE_PROMISE:
            return clonePromise(src);
        case TYPE_ERROR:
            return errorWithContext(getErrorCode(src), src.error->context);
        case TYPE_OTHER:
            return cloneOther(src);
        case TYPE_BOOL:
        case TYPE_NUMBER:
        case TYPE_FUNC:
            return src;
    }

    return src;
}

Object cloneStruct(const Object src)
{
    Object structo = structObject(src.structObject->definition);
    struct StructObject* so = structo.structObject;
    for (int i = 0; i < getStructAt(so->definition)->fieldCount; i++) {
        so->fields[i] = cloneObject(src.structObject->fields[i]);
    }
    return structo;
}

inline Object numberObject(int num)
{
    Object o = newObject(TYPE_NUMBER);
    o.number = num;
    return o;
}

inline Object boolObject(int b)
{
    Object o = newObject(TYPE_BOOL);
    o.number = b != 0;
    return o;
}

/// Skips first and last chars! Assumed to be '"'
inline Object objFromSlice(const char* string, int len)
{
    return stringFromSlice(&string[1], len - 1);
}

inline Object nullTerminated(const char* string)
{
    return stringFromSlice(string, strlen(string));
}

inline Object stringFromSlice(const char* string, int len)
{
    Object o = symFromSlice(string, len);
    o.type = TYPE_STRING;
    return o;
}

inline Object symFromSlice(const char* string, int len)
{
    Object o = withLen(len, TYPE_SYMBOL);
    snprintf(o.string, len + 1, "%s", string);
    return o;
}

/// Creates a stringy object with room for a reference-count prefix and trailing null byte.
/// Thus, withLen(3, TYPE_STRING) will actually allocate a 5-byte "string".
inline Object withLen(size_t len, enum Type type)
{
    Object o = newObject(type);
    o.string = malloc(sizeof(char) * (len + 2));
    o.string[0] = 1;
    o.string += 1;
    return o;
}

inline Object constructLambda(const Object* params, const Object* docs, const Object* body, struct Environment* env)
{
    if (!params || !body) {
        return errorObject(NULL_LAMBDA_LIST);
    }

    if (params->type != TYPE_LIST || body->type != TYPE_LIST) {
        return errorObject(LAMBDA_ARGS_NOT_LIST);
    }

    if (docs && docs->type != TYPE_STRING) {
        return errorWithContext(BAD_TYPE, "fn docstring must be a string");
    }

    Object o = newObject(TYPE_LAMBDA);
    o.lambda = malloc(sizeof(struct Lambda));
    o.lambda->params = copyList(params);
    o.lambda->body = copyList(body);
    o.lambda->refs = 1;

    if (docs) {
        o.lambda->params.docString = malloc(sizeof(char) * (strlen(docs->string) + 1));
        strcpy(o.lambda->params.docString, docs->string);
    } else {
        o.lambda->params.docString = NULL;
    }

    Object* dest = &o.lambda->body;
    FOR_POINTER_IN_LIST(dest) {
        if (POINTER->type == TYPE_SYMBOL) {
            Object fetched = fetchFromEnvironment(POINTER->string, env);
            // TODO: Figure out why lambdas in particular break when doing this.
            if (!isError(fetched, DID_NOT_FIND_SYMBOL) && fetched.type != TYPE_LAMBDA) {
                fetched.forward = POINTER->forward;
                cleanObject(POINTER);
                *POINTER = fetched;
            } else {
                cleanObject(&fetched);
            }
        }
    }
    return o;
}

inline int isError(const Object obj, const enum errorCode err)
{
    return obj.type == TYPE_ERROR && getErrorCode(obj) == err;
}

inline int bothAre(const enum Type type, const Object* obj1, const Object* obj2)
{
    return (obj1->type == type) && (obj2->type == type);
}

inline int areSameType(const Object* obj1, const Object* obj2)
{
    return obj1->type == obj2->type;
}

inline Object otherObject()
{
    Object o = newObject(TYPE_OTHER);
    o.other = malloc(sizeof(struct Other));
    return o;
}

inline Object errorObject(enum errorCode err)
{
    Object o = newObject(TYPE_ERROR);
#ifdef SIMPLE_ERRORS
    o.error = err;
#else
    o.error = malloc(sizeof(struct Error));
    o.error->code = err;
    o.error->context = NULL;
    o.error->plContext = NULL;
#endif

    return o;
}

inline enum errorCode getErrorCode(const Object obj)
{
#ifdef SIMPLE_ERRORS
    return obj.error;
#else
    return obj.error->code;
#endif
}

#ifndef SIMPLE_ERRORS

inline void errorAddContext(Object* o, const char* context, int lineNo, const char* fileName)
{
    o->error->context = malloc(sizeof(char) * RESULT_LENGTH);
    char* cursor = o->error->context;
    cursor += sprintf(cursor, "%s", context);
    if (fileName) {
        sprintf(cursor, " %s:%d", fileName, lineNo);
    }
}

inline Object errorWithContextLineNo(enum errorCode code, const char* context, int lineNo, const char* fileName)
{
    Object o = errorObject(code);
    if (context) {
        errorAddContext(&o, context, lineNo, fileName);
    }
    return o;
}

#endif

struct Error noError()
{
    struct Error err;
    err.context = NULL;
    return err;
}