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