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 '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); 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, bool print_quotes = false, FILE* file = stdout) -> void { switch (node->type) { case (Lisp_Object_Type::Nil): fprintf(file, "()"); break; case (Lisp_Object_Type::T): fprintf(file, "t"); break; case (Lisp_Object_Type::Number): fprintf(file, "%f", node->value.number); break; case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.identifier)); break; case (Lisp_Object_Type::Keyword): fprintf(file, ":%s", Memory::get_c_str(node->value.identifier)); break; case (Lisp_Object_Type::CFunction): fprintf(file, "[C-function]"); break; case (Lisp_Object_Type::String): { if (print_quotes) fprintf(file, "\"%s\"", Memory::get_c_str(node->value.string)); else fprintf(file, "%s", Memory::get_c_str(node->value.string)); } break; case (Lisp_Object_Type::Function): { if (node->value.function.type == Function_Type::Lambda) fprintf(file, "[lambda]"); else if (node->value.function.type == Function_Type::Special_Lambda) fprintf(file, "[special-lambda]"); else if (node->value.function.type == Function_Type::Macro) fprintf(file, "[macro]"); else assert(false); } break; case (Lisp_Object_Type::Pair): { Lisp_Object* head = node; fprintf(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 (head->type != Lisp_Object_Type::Pair) break; fprintf(file, " "); } if (head->type != Lisp_Object_Type::Nil) { fprintf(file, " . "); print(head); } fprintf(file, ")"); } 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); }