slime/src/io.cpp

proc string_equal(const char input[], const char check[]) -> bool {
    if (input == check) return true;

    for(int i = 0; input[i] == check[i]; i++) {
        if (input[i] == '\0')
            return true;
    }

    return false;
}

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 {
    if (str1 == str2)
        return true;

    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 '0': *out++ = '\a'; ++p; break;
            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) + 1;
            if (bufsize == 0) {
                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);
    } else {
        create_generic_error("The file '%s' could not be read.", filename);
    }

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

proc read_expression() -> char* {
    char* line = (char*)malloc(100);

    if(line == nullptr)
        return nullptr;

    char* linep = line;
    size_t lenmax = 100, len = lenmax;
    int c;

    int nesting = 0;

    while (true) {
        c = fgetc(stdin);
        if(c == EOF)
            break;

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

            if(linen == nullptr) {
                free(linep);
                return nullptr;
            }
            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 == nullptr)
        return nullptr;

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

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

            if(linen == nullptr) {
                free(linep);
                return nullptr;
            }
            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 log_message(Log_Level type, const char* message) -> void {
    if (type > Globals::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, bool print_quotes = false, FILE* file = stdout) -> void {

    switch (Memory::get_type(node)) {
    case (Lisp_Object_Type::Nil):       fputs("()", file);                                         break;
    case (Lisp_Object_Type::T):         fputs("t",  file);                                         break;
    case (Lisp_Object_Type::Number):    fprintf(file, "%f", node->value.number);                   break;
    case (Lisp_Object_Type::Keyword):   fputs(":", file); // NOTE(Felix): intentionall fallthough
    case (Lisp_Object_Type::Symbol):    fprintf(file, "%s", Memory::get_c_str(node->value.symbol.identifier)); break;
    case (Lisp_Object_Type::CFunction): fputs("[C-function]", file);                               break;
    case (Lisp_Object_Type::String): {
        if (print_quotes) {
            putc('\"', file);
            fputs(Memory::get_c_str(node->value.string), file);
            putc('\"', file);
        }
        else
            fputs(Memory::get_c_str(node->value.string), file);
    } break;
    case (Lisp_Object_Type::Function): {
        if (node->value.function.type == Function_Type::Lambda)
            fputs("[lambda]", file);
        else if (node->value.function.type == Function_Type::Special_Lambda)
            fputs("[special-lambda]", file);
        else if (node->value.function.type == Function_Type::Macro)
            fputs("[macro]", file);
        else
            assert(false);
    } break;
    case (Lisp_Object_Type::Pair): {
        Lisp_Object* head = node;
        putc('(', file);

        // 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, print_quotes, file);
            head = head->value.pair.rest;
            if (!head)
                return;
            if (Memory::get_type(head) != Lisp_Object_Type::Pair)
                break;
            putc(' ', file);
        }

        if (Memory::get_type(head) != Lisp_Object_Type::Nil) {
            fputs(" . ", file);
            print(head);
        }

        putc(')', file);
    } break;
    }
}


proc print_error_location() -> void {
    if (Globals::current_source_code) {
        printf("%s (line %d, position %d) code:" console_red "\n    ",
               Memory::get_c_str(
                   Globals::current_source_code->sourceCodeLocation->file),
               Globals::current_source_code->sourceCodeLocation->line,
               Globals::current_source_code->sourceCodeLocation->column);
        print(Globals::current_source_code);
    } else {
        fputs("no source code location avaliable", stdout);
    }
}

proc log_error() -> void {
    fputs(console_red,    stdout);
    fputs(Memory::get_c_str(Globals::error->message), stdout);
    puts(console_normal);

    fputs("  in: " console_cyan, stdout);
    print_error_location();
    puts(console_normal);
}