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