pebblisp/src/object.c

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

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

size_t bytes = 0;

int getBytes()
{
    return bytes;
}

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)

/**
 * 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)
{
    if (!listObj || !isListy(*listObj)) {
        return -1;
    }

    int len = 0;
    FOR_POINTER_IN_LIST(listObj) {
        len++;
    }
    return len;
}

Object len(Object obj1, Object o_ignore, struct Environment* e_ignore)
{
    Object o = numberObject(listLength(&obj1));
    if (o.number < 0) {
        return errorObject(NOT_A_LIST);
    }
    return o;
}

/**
 * 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)
{
    if (!listObj || !isListy(*listObj)) {
        return NULL;
    }

    FOR_POINTER_IN_LIST(listObj) {
        if (POINTER == NULL) {
            return NULL;
        }
        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;
}

/**
 * Checks if a given object is empty.
 *
 * BOOL, NUMBER, and ERROR types return true only when 0
 * LIST, LAMBDA, and FUNC types return true only when NULL
 * SYMBOL returns true only when it begins with a nullchar
 * @param obj A pointer to the object to check
 * @return True only if the non-null Object is empty/non-zero
 */
inline int isEmpty(const Object* obj)
{
    if (obj == NULL) {
        return 0;
    }

    switch (obj->type) {
        case TYPE_NUMBER:
        case TYPE_BOOL:
            return obj->number == 0;
        case TYPE_LIST:
        case TYPE_SLIST:
            return obj->list == NULL;
        case TYPE_LAMBDA:
            return obj->lambda == NULL;
        case TYPE_STRUCT:
            return obj->structObject == NULL;
        case TYPE_SYMBOL:
        case TYPE_STRING:
            return obj->string == NULL || obj->string[0] == '\0';
        case TYPE_FUNC:
            return obj->func == NULL;
        case TYPE_OTHER:
            return obj->other == NULL;
        case TYPE_ERROR:
            return getErrorCode(*obj);
    }

    return 0;
}

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

/**
 * Inserts a given Object into a list at the given index.
 * Immediately returns if `dest` is NULL or not a list type
 * Adds to the end of the list if the index is higher than the list length

 * @param dest The list to insert into
 * @param ind The index to insert at
 * @param src The Object to add to the list

 * @warning UNTESTED
 */
void insertIntoList(Object* dest, int ind, const Object src)
{
    if (!dest || !isListy(*dest)) {
        return;
    }

    // Merely append, when possible
    if (ind >= listLength(dest)) {
        nf_addToList(dest, src);
        return;
    }

    // The Objects to preceed and follow the new one
    Object* beforeNew = itemAt(dest, ind - 1);
    Object* afterNew = beforeNew->forward;

    // Replace the `before` Object's pointer
    allocObject(&beforeNew->forward, src);
    beforeNew->forward->forward = afterNew;
}

/**
 * Replace an Object in a list at a given index with a given Object
 * Attempts to clean the replaced Object before adding the new one
 * Immediately returns if `list` is NULL or not a list type
 *
 * @param list The list Object to replace an element of
 * @param i The index of the element to replace
 * @param src The Object to copy into the list
 */
void replaceListing(Object* list, int i, const Object src)
{
    if (!list || isListy(*list)) {
        return;
    }
    Object* replace = itemAt(list, i);
    Object* oldForward = replace->forward;
    cleanObject(replace);
    *replace = src;
    replace->forward = oldForward;
}

/**
 * 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
 */
void nf_addToList(Object* dest, const Object src)
{
    if (!dest || !isListy(*dest)) {
        return;
    }

    if (isEmpty(dest)) {
        allocObject(&dest->list, src);
        return;
    }

    allocObject(&tail(dest)->forward, src);
}

#ifndef SIMPLE_ERRORS
static const char* errorText[] = {"MISMATCHED_PARENS",
                                  "BAD_LIST_OF_SYMBOL_STRINGS",
                                  "TYPE_LIST_NOT_CAUGHT",
                                  "NULL_ENV",
                                  "EMPTY_ENV",
                                  "BUILT_IN_NOT_FOUND",
                                  "NULL_PARSE",
                                  "NULL_LAMBDA_LIST",
                                  "NULL_MAP_ARGS",
                                  "LAMBDA_ARGS_NOT_LIST",
                                  "DID_NOT_FIND_SYMBOL",
                                  "BAD_TYPE",
                                  "UNEXPECTED_FORM",
                                  "LISTS_NOT_SAME_SIZE",
                                  "BAD_NUMBER",
                                  "UNSUPPORTED_NUMBER_TYPE",
                                  "NOT_A_SYMBOL",
                                  "ONLY_ONE_ARGUMENT",
                                  "NOT_A_LIST",
                                  "SCRIPT_NOT_FOUND",
                                  "NO_CLONE_SPECIFIED",
                                  "CAN_ONLY_EVAL_STRINGS",
                                  "UNEXPECTED_EOF",
                                  "INDEX_PAST_END"};
#endif

/**
 * 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(char* dest, const Object* obj)
{
    if (!dest || !isListy(*obj)) {
        return;
    }

    dest[0] = '(';
    dest[1] = '\0';

    FOR_POINTER_IN_LIST(obj) {
        strcat(dest, " ");
        char tok[90] = "";
        stringObj(tok, POINTER);
        strcat(dest, tok);
    }
    strcat(dest, " )");
}

/**
 * Creates a string from a given struct Object
 * Blocks out with curly braces
 */
void stringStruct(char* dest, const Object* obj)
{
    struct StructObject* so = obj->structObject;
    dest[0] = '{';
    dest[1] = '\0';

    for (int i = 0; i < global()->structDefs[so->definition].fieldCount; i++) {
        strcat(dest, " ");
        strcat(dest, global()->structDefs[so->definition].names[i]);
        strcat(dest, ": ");
        int isString = so->fields[i].type == TYPE_STRING;
        if (isString) {
            strcat(dest, "\"");
        }

        char tok[90] = "";
        stringObj(tok, &so->fields[i]);
        strcat(dest, tok);

        if (isString) {
            strcat(dest, "\"");
        }
        strcat(dest, ",");
    }
    int i = 0;
    while (dest[i]) {
        i++;
    }
    dest[i - 1] = ' ';
    dest[i + 0] = '}';
    dest[i + 1] = '\0';
}
/**
 * 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
 */
#ifdef STANDALONE
#define stringf(_dest, _len, _format, args...) sprintf(_dest, _format, ## args)
#else
#define stringf(_dest, _len, _format, args...) snprintf(_dest, _len, _format, ## args)
#endif

char* stringNObj(char* dest, const Object* obj, const size_t len)
{
    if (!dest || !obj) {
        return NULL;
    }

    switch (obj->type) {
        case TYPE_NUMBER:
            stringf(dest, len, "%d", obj->number);
            break;
        case TYPE_BOOL:
            stringf(dest, len, "%s", obj->number ? "T" : "F");
            break;
        case TYPE_STRING:
            stringf(dest, len, "%s", obj->string);
            break;
        case TYPE_SYMBOL:
            stringf(dest, len, "`%s`", obj->string);
            break;
        case TYPE_STRUCT:
            //snprintf(dest, len, "{%s}", obj->structObject->definition->names[0]);
            stringStruct(dest, obj);
            break;
        case TYPE_LIST:
        case TYPE_SLIST:
            stringList(dest, obj);
            break;
        case TYPE_ERROR: {
            int code = getErrorCode(*obj);
#ifdef SIMPLE_ERRORS
            stringf(dest, len, "E[%d]", (int)code);
#else
            if (obj->error->context && obj->error->context[0] != '\0') {
                stringf(dest, len, "'%s': %s", errorText[code],
                        obj->error->context);
            } else {
                stringf(dest, len, "%s", errorText[code]);
            }
#endif
            break;
        }
        case TYPE_FUNC:
            stringf(dest, len, "F%d", obj->number);
            break;
        case TYPE_LAMBDA:
#ifdef STANDALONE
            dest += stringf(dest, len, "\\x%d", obj->number);
            stringNObj(dest, &obj->lambda->params, len);
            dest += strlen(dest);
            strcat(dest, " -> ");
            dest += 4;
            stringNObj(dest, &obj->lambda->body, len);
            dest += strlen(dest);
            strcat(dest, ">");
#else
            stringf(dest, len, "\\x%d", obj->number);
#endif
            break;
        case TYPE_OTHER:
            stringf(dest, len, "%p", obj->other->data);
            break;
    }

    if (!isValidType(*obj)) {
        stringf(dest, len, "BAD_TYPE(%d) X%d", obj->type, obj->number);
    }

    return dest;
}

char* stringObj(char* dest, const Object* obj)
{
    return stringNObj(dest, obj, RESULT_LENGTH);
}

/**
 * Prints a given Object only if the DEBUG flag is set
 * @param obj The Object to debug
 */
void debugObj(const Object* obj)
{
#ifdef DEBUG
    printObj(obj);
#endif
    return;
}

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

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

void printType(const Object* obj)
{
    if (!obj) {
        printf("NULL OBJECT");
        return;
    }
    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_OTHER);
        SIMPLE_TYPE(TYPE_ERROR);
        case TYPE_LAMBDA:
            printf("TYPE_LAMBDA Params:\n");
            return;
    }

    if (!isValidType(*obj)) {
        printf("UNKNOWN TYPE (%d)", obj->type);
    }
}

void nestedPrintList(const Object* list, int newline);

void _printObj(const Object* obj, int newline)
{
#ifdef DEBUG
    printType(obj);
#endif

    if (!obj) {
        printf(newline ? "\n" : "");
        return;
    }
    if (obj->type == TYPE_LAMBDA) {
        printObj(&obj->lambda->params);
        printf("->");
        printObj(&obj->lambda->body);
        return;
    }

    char temp[200] = "";
    stringObj(temp, obj);
    if (newline) {
        printf("%s\n", temp);
    } else {
        printf("%s", temp);
    }
}

/**
 * Prints the given Object and a newline.
 * Uses stringObj() to create the printed string
 * If the DEBUG flag is set, the Object's type will be printed first
 * @param obj The Object to print
 */
inline void printObj(const Object* obj)
{
    _printObj(obj, 1);
}

void nestedPrintList(const Object* list, int newline)
{
    printf("(");
    if (list && isListy(*list)) {
        FOR_POINTER_IN_LIST(list) {
            printf(" ");
            _printObj(POINTER, 0);
        }
    }
    printf(" )");

    if (newline) {
        printf("\n");
    }
}

/**
 * Prints each Object in a given list, surrounded by parentheses
 * @param list The list Object to print
 */
void printList(const Object* list)
{
    nestedPrintList(list, 1);
}

#endif

/**
 * Performs appropriate free() on a given Object and NULLs its ->forward
 * Returns immediately if param is NULL
 *
 * Strings: The Object's ->string is freed and NULLed
 * 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)
{
    if (target == NULL) {
        return;
    }

    switch (target->type) {
        case TYPE_STRING:
        case TYPE_SYMBOL:
            free(target->string);
            target->string = NULL;
            break;
        case TYPE_LIST:
        case TYPE_SLIST:
            deleteList(target);
            break;
        case TYPE_LAMBDA:
            cleanObject(&target->lambda->params);
            cleanObject(&target->lambda->body);
            free(target->lambda);
            break;
        case TYPE_STRUCT:
            for (int i = 0; i < global()->structDefs[target->structObject->definition].fieldCount; i++) {
                cleanObject(&target->structObject->fields[i]);
            }
            free(target->structObject->fields);
            free(target->structObject);
            target->structObject = NULL;
            break;
        case TYPE_ERROR:
#ifndef SIMPLE_ERRORS
            free(target->error->context);
            free(target->error);
            target->error = NULL;
#endif
            break;
        case TYPE_OTHER:
            if (target->other->cleanup) {
                target->other->cleanup(target);
            }
            break;
        case TYPE_BOOL:
        case TYPE_NUMBER:
        case TYPE_FUNC:
            break;
    }

    target->forward = NULL;
}

/**
 * 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)
{
    if (!dest) {
        return;
    }

    if (!isListy(*dest)) {
        printf("Tried to delete something other than a list\n");
        return;
    }

    Object* march = dest->list;
    while (march != NULL) {
        Object* prevMarch = march;
        march = march->forward;
        cleanObject(prevMarch);
        free(prevMarch);
    }
    dest->list = NULL;
}

void _copyList(Object* dest, const Object* src, int delete)
{
    if (!dest || !src) { printd("NULL\n");
        return;
    }
    if (!isListy(*dest) || !isListy(*src)) { printd("NOT A LIST\n");
        return;
    }

    if (delete) {
        deleteList(dest);
    }

    FOR_POINTER_IN_LIST(src) {
        if (isListy(*POINTER)) {
            nf_addToList(dest, *POINTER);
            tail(dest)->list = NULL;
            _copyList(tail(dest), POINTER, 0);
        } else if (isStringy(*POINTER)) {
            nf_addToList(dest, cloneString(*POINTER));
        } else {
            nf_addToList(dest, *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
 */
void copyList(Object* dest, const Object* src)
{
    _copyList(dest, src, 1);
}

/**
 * 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, 0);
}

/**
 * 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) * global()->structDefs[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 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 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_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)
{
    return constructLambda(&old.lambda->params, &old.lambda->body, NULL);
}

Object cloneString(Object obj)
{
    const char* string = obj.string;
    obj.string = malloc(sizeof(char) * (strlen(string) + 1));
    strcpy(obj.string, string);
    return obj;
}

// Returns an Object with a deep copy of the given Object
inline Object cloneList(const Object src)
{
    Object list = listObject();
    copyList(&list, &src);
    list.type = src.type;
    return list;
}

inline Object cloneOther(const Object src)
{
    return src.other->clone ? src.other->clone(src.other) : src;
}

Object cloneStruct(const Object src);

inline Object cloneObject(const Object src)
{
    switch (src.type) {
        case TYPE_SLIST:
        case TYPE_LIST:
            return cloneList(src);
        case TYPE_LAMBDA:
            return cloneLambda(src);
        case TYPE_STRUCT:
            return cloneStruct(src);
        case TYPE_STRING:
        case TYPE_SYMBOL:
            return cloneString(src);
        case TYPE_ERROR:
            return errorWithContext(getErrorCode(src), src.error->context);
        case TYPE_BOOL:
        case TYPE_NUMBER:
        case TYPE_FUNC:
        case TYPE_OTHER:
            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 < global()->structDefs[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;
    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 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 = newObject(TYPE_SYMBOL);
    o.string = calloc(sizeof(char), len + 1);
    strncpy(o.string, string, len);
    return o;
}

inline Object constructLambda(const Object* params, 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);
    }

    Object o = newObject(TYPE_LAMBDA);
    o.lambda = malloc(sizeof(struct Lambda));
    o.lambda->params = listObject();
    o.lambda->body = listObject();
    copyList(&o.lambda->params, params);
    copyList(&o.lambda->body, body);

    if (env) {
        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 eitherIs(const enum Type type, const Object* o1, const Object* o2)
{
    return (o1->type == type) || (o2->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;
#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)
{
    // printf("o: %p\n", o);
    // printf("o->error: %s\n", o->error);
    o->error->context = calloc(sizeof(char), RESULT_LENGTH);
    // printf("context: %p\n", context);
    sprintf(o->error->context, "%s %s:%d", context, 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;
}

inline Object toBool(const Object test)
{
    if (test.number == 0) {
        return boolObject(0);
    }
    return boolObject(1);
}