slime/src/io.cpp

proc string_equal(const char input[], const char check[]) -> bool {
    int i;
    for(i = 0; input[i] != '\0' || check[i] != '\0'; i++) {
        if(input[i] != check[i]) {
            return false;
        }
    }
    return true;
}

proc string_equal(String* str, const char check[]) -> bool {
    return string_equal(Memory::get_c_str(str), check);
}

proc string_equal(const char check[], String* str) -> bool {
    return string_equal(Memory::get_c_str(str), check);
}

proc string_equal(String* str1, String* str2) -> bool {
    return string_equal(Memory::get_c_str(str1), Memory::get_c_str(str2));
}

proc get_nibble(char c) -> char {
    if (c >= 'A' && c <= 'F')
        return (c - 'a') + 10;
    else if (c >= 'a' && c <= 'f')
        return (c - 'A') + 10;
    return (c - '0');
}

proc unescape_string(char* in) -> bool {
    if (!in)
        return true;

    char *out = in, *p = in;
    const char *int_err = nullptr;

    while (*p && !int_err) {
        if (*p != '\\') {
            /* normal case */
            *out++ = *p++;
        } else {
            /* escape sequence */
            switch (*++p) {
            case 'a': *out++ = '\a'; ++p; break;
            case 'b': *out++ = '\b'; ++p; break;
            case 'f': *out++ = '\f'; ++p; break;
            case 'n': *out++ = '\n'; ++p; break;
            case 'r': *out++ = '\r'; ++p; break;
            case 't': *out++ = '\t'; ++p; break;
            case 'v': *out++ = '\v'; ++p; break;

            case '"':
            case '\'':
            case '\\':
                *out++ = *p++;
            case '?':
                break;
            // case 'x':
            // case 'X':
            //     if (!isxdigit(p[1]) || !isxdigit(p[2])) {
            //         int_err = "Invalid character on hexadecimal escape.";
            //     } else {
            //         *out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2]));
            //         p += 3;
            //     }
            //     break;
            default:
                int_err = "Unexpected '\\' with no escape sequence.";
                break;
            }
        }
    }

    /* Set the end of string. */
    *out = '\0';
    if (int_err)
        return false;
    return true;
}

proc read_entire_file(char* filename) -> char* {
    char *fileContent = nullptr;
    FILE *fp = fopen(filename, "r");
    if (fp) {
        /* Go to the end of the file. */
        if (fseek(fp, 0L, SEEK_END) == 0) {
            /* Get the size of the file. */
            long bufsize = ftell(fp);
            if (bufsize == -1) {
                fputs("Empty file", stderr);
                goto closeFile;
            }

            /* Go back to the start of the file. */
            if (fseek(fp, 0L, SEEK_SET) != 0) {
                fputs("Error reading file", stderr);
                goto closeFile;
            }

            /* Allocate our buffer to that size. */
            fileContent = (char*)calloc(bufsize, sizeof(char));

            /* Read the entire file into memory. */
            size_t newLen = fread(fileContent, sizeof(char), bufsize, fp);

            fileContent[newLen] = '\0';
            if ( ferror( fp ) != 0 ) {
                fputs("Error reading file", stderr);
            }
        }
      closeFile:
        fclose(fp);
    }

    return fileContent;
    /* Don't forget to call free() later! */
}

proc read_expression() -> char* {
    char* line = (char*)malloc(100);
    char* linep = line;
    size_t lenmax = 100, len = lenmax;
    int c;

    int nesting = 0;

    if(line == NULL)
        return NULL;

    for(;;) {
        c = fgetc(stdin);
        if(c == EOF)
            break;

        if(--len == 0) {
            len = lenmax;
            char * linen = (char*)realloc(linep, lenmax *= 2);

            if(linen == NULL) {
                free(linep);
                return NULL;
            }
            line = linen + (line - linep);
            linep = linen;
        }

        *line = (char)c;
        if(*line == '(')
            ++nesting;
        else if(*line == ')')
            --nesting;
        else if(*line == '\n')
            if (nesting == 0)
                break;
        line++;
    }
    (*line)--; // we dont want the \n actually
    *line = '\0';

    return linep;
}

proc read_line() -> char* {
    char* line = (char*)malloc(100), * linep = line;
    size_t lenmax = 100, len = lenmax;
    int c;

    int nesting = 0;

    if(line == NULL)
        return NULL;

    for(;;) {
        c = fgetc(stdin);
        if(c == EOF)
            break;

        if(--len == 0) {
            len = lenmax;
            char* linen = (char*)realloc(linep, lenmax *= 2);

            if(linen == NULL) {
                free(linep);
                return NULL;
            }
            line = linen + (line - linep);
            linep = linen;
        }

        *line = (char)c;
        if(*line == '(')
            ++nesting;
        else if(*line == ')')
            --nesting;
        else if(*line == '\n')
            if (nesting == 0)
                break;
        line++;
    }
    (*line)--; // we dont want the \n actually
    *line = '\0';

    return linep;
}


Log_Level log_level = Log_Level::Debug;

proc log_message(Log_Level type, char* message) -> void {
    if (type > log_level)
        return;

    const char* prefix;
    switch (type) {
    case Log_Level::Critical: prefix = "CRITICAL"; break;
    case Log_Level::Warning:  prefix = "WARNING";  break;
    case Log_Level::Info:     prefix = "INFO";     break;
    case Log_Level::Debug:    prefix = "DEBUG";    break;
    default: return;
    }
    printf("%s: %s\n",prefix, message);
}

proc panic(char* message) -> void {
    log_message(Log_Level::Critical, message);
    exit(1);
}

proc print(Lisp_Object* node) -> void {
    switch (node->type) {
    case (Lisp_Object_Type::Nil): {
        printf("nil");
    } break;
    case (Lisp_Object_Type::T): {
        printf("t");
    } break;
    case (Lisp_Object_Type::Number): {
        printf("%f", node->value.number->value);
    } break;
    case (Lisp_Object_Type::String): {
        printf("\"%s\"", Memory::get_c_str(node->value.string));
    } break;
    case (Lisp_Object_Type::Symbol): {
        printf("%s", Memory::get_c_str(node->value.symbol->identifier));
    } break;
    case (Lisp_Object_Type::Keyword): {
        printf(":%s", Memory::get_c_str(node->value.keyword->identifier));
    } break;
    case (Lisp_Object_Type::Function): {
        if (node->value.function->type == Function_Type::Lambda)
            printf("[lambda]");
        else if (node->value.function->type == Function_Type::Special_Lambda)
            printf("[special-lambda]");
        else if (node->value.function->type == Function_Type::Macro)
            printf("[macro]");
        else
            assert(false);
    } break;
    case (Lisp_Object_Type::CFunction): {
        printf("[C-function]");
    } break;
    case (Lisp_Object_Type::Pair): {
        Lisp_Object* head = node;
        printf("(");

        // NOTE(Felix): We cold do a while true here, however in case
        // we want to print a broken list (for logging the error) we
        // should do mo checks.
        while (head) {
            print(head->value.pair->first);
            head = head->value.pair->rest;
            if (!head)
                return;
            if (head->type != Lisp_Object_Type::Pair)
                break;
            printf(" ");
        }

        if (head->type != Lisp_Object_Type::Nil) {
            printf(" . ");
            print(head);
        }

        printf(")");
    } break;
    }
}

// XXX(Felix): obv code dublicate
proc fprint(FILE* f, Lisp_Object* node) -> void {
    switch (node->type) {
    case (Lisp_Object_Type::Nil): {
        fprintf(f, "nil");
    } break;
    case (Lisp_Object_Type::T): {
        fprintf(f, "t");
    } break;
    case (Lisp_Object_Type::Number): {
        fprintf(f, "%f", node->value.number->value);
    } break;
    case (Lisp_Object_Type::String): {
        fprintf(f, "\"%s\"", Memory::get_c_str(node->value.string));
    } break;
    case (Lisp_Object_Type::Symbol): {
        fprintf(f, "%s", Memory::get_c_str(node->value.symbol->identifier));
    } break;
    case (Lisp_Object_Type::Keyword): {
        fprintf(f, ":%s", Memory::get_c_str(node->value.keyword->identifier));
    } break;
    case (Lisp_Object_Type::Function): {
        if (node->value.function->type == Function_Type::Lambda)
            fprintf(f, "[lambda]");
        else if (node->value.function->type == Function_Type::Special_Lambda)
            fprintf(f, "[special-lambda]");
        else if (node->value.function->type == Function_Type::Macro)
            fprintf(f, "[macro]");
        else
            assert(false);
    } break;
    case (Lisp_Object_Type::CFunction): {
        fprintf(f, "[C-function]");
    } break;
    case (Lisp_Object_Type::Pair): {
        Lisp_Object* head = node;
        fprintf(f, "(");

        // NOTE(Felix): We cold do a while true here, however in case
        // we want to print a broken list (for logging the error) we
        // should do mo checks.
        while (head) {
            fprint(f, head->value.pair->first);
            head = head->value.pair->rest;
            if (!head)
                return;
            if (head->type != Lisp_Object_Type::Pair)
                break;
            fprintf(f, " ");
        }

        if (head->type != Lisp_Object_Type::Nil) {
            fprintf(f, " . ");
            print(head);
        }

        fprintf(f, ")");
    } break;
    }
}

proc print_error_location() -> void {
    if (error->location) {
        printf("%s (line %d, position %d)",
               Memory::get_c_str(error->location->file),
               error->location->line,
               error->location->column);
    } else {
        printf("no source code location avaliable");
    }
}

proc log_error() -> void {
    printf("%s%s%s\n", console_red,
           Error_Type_to_string(error->type),
           console_normal);
    printf("  in: %s", console_cyan);
    print_error_location();
    printf("%s\n", console_normal);
}