namespace Parser { String* standard_in; String* parser_file; int parser_line; int parser_col; proc maybe_expand_reader_macro() -> Lisp_Object* { // static Lisp_Object* quote_sym = Memory::get_or_create_lisp_object_symbol("quote"); // static Lisp_Object* qquote_sym = Memory::get_or_create_lisp_object_symbol("quasiquote"); // static Lisp_Object* unquote_sym = Memory::get_or_create_lisp_object_symbol("unquote"); // static Lisp_Object* us_sym = Memory::get_or_create_lisp_object_symbol("unquote-splicing"); // if (text[*index_in_text] == '\'') { // *index_in_text++; // return quote_sym; // } // if (text[*index_in_text] == '`') { // *index_in_text++; // return qquote_sym; // } // if (text[*index_in_text] == ',') { // *index_in_text++; // return unquote_sym; // } // if (text[*index_in_text] == ',' && text[*index_in_text] == '@') { // *index_in_text += 2; // return us_sym; // } return nullptr; } proc inject_scl(Lisp_Object* lo) -> void { lo->sourceCodeLocation = new(Source_Code_Location); lo->sourceCodeLocation->file = parser_file; lo->sourceCodeLocation->line = parser_line; lo->sourceCodeLocation->column = parser_col; } proc eat_comment_line(char* text, int* index_in_text) -> void { // safety check if we are actually starting a comment here if (text[*index_in_text] != ';') return; // eat the comment line do { ++(*index_in_text); ++parser_col; } while (text[(*index_in_text)] != '\n' && text[(*index_in_text)] != '\r' && text[(*index_in_text)] != '\0'); } proc eat_whitespace(char* text, int* index_in_text) -> void { // skip whitespaces while (text[(*index_in_text)] == ' ' || text[(*index_in_text)] == '\t' || text[(*index_in_text)] == '\n' || text[(*index_in_text)] == '\r') { if (text[(*index_in_text)] == '\n') { ++parser_line; parser_col = 0; } ++parser_col; ++(*index_in_text); } } proc eat_until_code(char* text, int* index_in_text) -> void { int position_before; do { position_before = *index_in_text; eat_comment_line(text, index_in_text); eat_whitespace(text, index_in_text); } while (position_before != *index_in_text); } proc read_atom(char* text, int* index_in_text) -> String* { int atom_length = 0; while (text[*index_in_text+atom_length] != ' ' && text[*index_in_text+atom_length] != ')' && text[*index_in_text+atom_length] != '(' && text[*index_in_text+atom_length] != '\0' && text[*index_in_text+atom_length] != '\n' && text[*index_in_text+atom_length] != '\r' && text[*index_in_text+atom_length] != '\t') { ++atom_length; } // let's mark the end of the atom there quickly, so the string can // be copied from there easily and then put the char that was // before there back char before = text[*index_in_text+atom_length]; text[*index_in_text+atom_length] = '\0'; // get the atom String* ret = Memory::create_string("", atom_length); // char* atom = (char*)malloc(atom_length*sizeof(char)+1); // plus null char strcpy(&ret->data, text+(*index_in_text)); // restore the original string text[*index_in_text+atom_length] = before; // update the index to point to the character after the atom // ended *index_in_text += atom_length; parser_col += atom_length; return ret; } proc parse_number(char* text, int* index_in_text) -> Lisp_Object* { double number; // TODO(Felix): parse the number direcrly from the string and // dont create a String first String* str_number = read_atom(text, index_in_text); sscanf(Memory::get_c_str(str_number), "%lf", &number); Lisp_Object* ret; try ret = Memory::create_lisp_object_number(number); inject_scl(ret); return ret; } proc parse_keyword(char* text, int* index_in_text) -> Lisp_Object* { // we are now on the colon ++(*index_in_text); ++parser_col; String* str_keyword = read_atom(text, index_in_text); Lisp_Object* ret; try ret = Memory::get_or_create_lisp_object_keyword(str_keyword); inject_scl(ret); return ret; } proc parse_symbol(char* text, int* index_in_text) -> Lisp_Object* { // we are now at the first char of the symbol String* str_symbol = read_atom(text, index_in_text); Lisp_Object* ret; try ret = Memory::get_or_create_lisp_object_symbol(str_symbol); inject_scl(ret); return ret; } proc parse_string(char* text, int* index_in_text) -> Lisp_Object*{ // the first character is the '"' ++(*index_in_text); ++parser_col; // now we are at the first letter, if this is the closing '"' then // it's easy if (text[*index_in_text] == '"') { Lisp_Object* ret; try ret = Memory::create_lisp_object_string( Memory::create_string("", 0)); inject_scl(ret); // plus one because we want to go after the quotes *index_in_text += 1; ++parser_col; return ret; } // okay so the first letter was not actually closing the string... int string_length = 0; bool escaping = false; while (!(text[*index_in_text+string_length] == '"' && !escaping)) { if (escaping) escaping = false; else if (text[*index_in_text+string_length] == '\\') escaping = true; ++string_length; } // we found the end of the string text[*index_in_text+string_length] = '\0'; // NOTE(Felix): Tactic: Through unescaping the string will // only get shorter, so we replace it inplace and later jump // to the original end of the string. try unescape_string(text+(*index_in_text)); String* string = Memory::create_string("", string_length); // TODO(Felix): manually copy to parse control sequences // correctly without the need to unescape the string, also // better for keeping track of the encountered new lines and // characters since last new line so we can update the parser // location more easily strcpy(&string->data, text+(*index_in_text)); text[*index_in_text+string_length] = '"'; // plus one because we want to go after the quotes *index_in_text += string_length +1; // NOTE(Felix): this only has to be done until we manually // copy the string and we can do some bookeeping: /* recalculate the parser cursors position: */ /* new col = (count chars since last \n) + 1 */ for (int i = 0; i < string->length; ++i) { if (*((&string->data)+i) == '\n') { ++parser_line; parser_col = 0; } else { ++parser_col; } } Lisp_Object* ret; try ret = Memory::create_lisp_object_string(string); inject_scl(ret); return ret; } proc parse_atom(char* text, int* index_in_text) -> Lisp_Object* { // numbers if ((text[*index_in_text] <= 57 && // if number text[*index_in_text] >= 48) || ((text[*index_in_text] == '+' || // or if sign and then number text[*index_in_text] == '-') && (text[*index_in_text +1] <= 57 && text[*index_in_text +1] >= 48)) || ((text[*index_in_text] == '.') // or if . and then number && (text[*index_in_text +1] <= 57 && text[*index_in_text +1] >= 48))) return parse_number(text, index_in_text); // keywords if (text[*index_in_text] == ':') return parse_keyword(text, index_in_text); // strings if (text[*index_in_text] == '"') return parse_string(text, index_in_text); return parse_symbol(text, index_in_text); } proc parse_expression(char* text, int* index_in_text) -> Lisp_Object* { // if it is quoted // TODO(Felix): This looks totally broken.. if (text[*index_in_text] == '\'' || text[*index_in_text] == '`' || text[*index_in_text] == '@' || text[*index_in_text] == ',') { char quoteType = text[*index_in_text]; ++(*index_in_text); ++parser_col; Lisp_Object* result; if (text[*index_in_text] == '(' || text[*index_in_text] == '\'' || text[*index_in_text] == '`' || text[*index_in_text] == '@' || text[*index_in_text] == ',') { try result = parse_expression(text, index_in_text); } else { try result = parse_atom(text, index_in_text); } Lisp_Object* ret = nullptr; if (quoteType == '\'') try ret = Memory::create_list(Memory::get_or_create_lisp_object_symbol("quote"), result); else if (quoteType == '`') try ret = Memory::create_list(Memory::get_or_create_lisp_object_symbol("quasiquote"), result); else if (quoteType == ',') try ret = Memory::create_list(Memory::get_or_create_lisp_object_symbol("unquote"), result); else if (quoteType == '@') { try ret = Memory::create_list(Memory::get_or_create_lisp_object_symbol("unquote-splicing"), result); } if (ret) inject_scl(ret); return ret; } // if it is not quoted ++(*index_in_text); ++parser_col; eat_whitespace(text, index_in_text); // if there was actually nothing in the list, we define here, // that that means nil if (text[(*index_in_text)] == ')') { ++(*index_in_text); ++parser_col; return Memory::nil; } // okay there is something Lisp_Object* head; try head = Memory::create_lisp_object(); Memory::set_type(head, Lisp_Object_Type::Pair); // head->value.pair = new(Pair); Lisp_Object* expression = head; while (true) { inject_scl(head); if (text[*index_in_text] == '(' || text[*index_in_text] == '\''|| text[*index_in_text] == '`' || text[*index_in_text] == '@' || text[*index_in_text] == ',') { try head->value.pair.first = parse_expression(text, index_in_text); } else { try head->value.pair.first = parse_atom(text, index_in_text); } eat_until_code(text, index_in_text); if (text[(*index_in_text)] == '\0') { create_parsing_error( "Unexpected EOF in %s:%d:%d", parser_file, parser_line, parser_col); return nullptr; } if (text[(*index_in_text)] == ')') { head->value.pair.rest = Memory::nil; ++parser_col; ++(*index_in_text); break; } else if (text[(*index_in_text)] == '.') { ++parser_col; ++(*index_in_text); eat_until_code(text, index_in_text); if (text[(*index_in_text)] == '(') head->value.pair.rest = parse_expression(text, index_in_text); else head->value.pair.rest = parse_atom(text, index_in_text); eat_until_code(text, index_in_text); if (text[(*index_in_text)] != ')') create_parsing_error( "Expected ')' after the element after the '.' in %s:%d:%d", create_source_code_location(parser_file, parser_line, parser_col)); ++parser_col; ++(*index_in_text); break; } else { try head->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); head = head->value.pair.rest; } } // check if we have to create or delete or run macros // while (Memory::get_type(expression->value.pair.first) == Lisp_Object_Type::Symbol) { // Lisp_Object* parsed_symbol = expression->value.pair.first; // if (string_equal("define-syntax", parsed_symbol->value.symbol.identifier)) { // // create a new macro // Lisp_Object* arguments = expression->value.pair.rest; // Lisp_Object* body; // int arguments_length; // // HACK(Felix): almost code duplicate from // // `built_ins.cpp`: special-lambda // try arguments_length = list_length(arguments); // // (define-syntax (defun name args :rest body) (...)) // if (arguments_length < 2) { // create_wrong_number_of_arguments_error(3, arguments_length); // return nullptr; // } // assert_type(arguments->value.pair.first, Lisp_Object_Type::Pair); // // extract the name // Lisp_Object* symbol_for_macro = arguments->value.pair.first->value.pair.first; // body = arguments->value.pair.rest; // arguments = arguments->value.pair.first->value.pair.rest; // // Function* function = new(Function); // Lisp_Object* macro; // try macro = Memory::create_lisp_object(); // Memory::set_type(macro, Lisp_Object_Type::Function); // macro->value.function.parent_environment = get_current_environment(); // macro->value.function.type = Function_Type::Macro; // // if parameters were specified // if (arguments != Memory::nil) { // try assert_type(arguments, Lisp_Object_Type::Pair); // try create_arguments_from_lambda_list_and_inject(arguments, macro); // } else { // macro->value.function.args.positional = create_positional_argument_list(1); // macro->value.function.args.keyword = create_keyword_argument_list(1); // macro->value.function.args.rest = nullptr; // } // // arguments = arguments->value.pair.rest; // // if there is a docstring, use it // if (Memory::get_type(body->value.pair.first) == Lisp_Object_Type::String) { // macro->docstring = body->value.pair.first->value.string; // body = body->value.pair.rest; // } else { // macro->docstring = nullptr; // } // // we are now in the function body, just wrap it in an // // implicit begin // try macro->value.function.body = Memory::create_lisp_object_pair( // Memory::get_or_create_lisp_object_symbol("begin"), // body); // inject_scl(macro); // // macro->value.function = function; // define_symbol(symbol_for_macro, macro); // // print_environment(environment_for_macros); // return Memory::nil; // } else if (string_equal("delete-syntax", parsed_symbol->value.symbol.identifier)) { // /* --- deleting an existing macro --- */ // // TODO(Felix): this is a hard one because when // // environments will be made from hashmaps, how can we // // delete stuff from hashmaps? If we do probing on // // collision and then delte the first colliding entry, // // how can we find the second one? How many probes do // // we have to do to know for sure that an elemenet is // // not in the hashmap? It would be much easier if we // // never deleted any elements from the hashmap, so // // that, when an entry is not found immidiately, we // // know for sure that it does not exist in the table. // create_generic_error("deleting macros has not yet be implemented," // "and I don't know if it is a good idea to do so."); // return nullptr; // } else { // // if threre is a macro named like this, then macroexpand // // if not it is regular code, dont touch. // break; // Lisp_Object* macro = try_lookup_symbol(parsed_symbol, get_current_environment()); // if (macro && // Memory::get_type(macro) == Lisp_Object_Type::Function && // macro->value.function.type == Function_Type::Macro) // { // // printf("pretending to expand macro at %s %d %d: ", // // Memory::get_c_str(parser_file), // // parser_line, parser_col); // // print(parsed_symbol); // // printf("\n"); // // NOTE(Felix): Execute it as a special lambda, // // because if we keep it as a macro, the evaluator // // will think it is a stray macro that was not yet // // expanded, and attempt to evaluate it twice (1. // // for expanding, and 2. for evaluating) // macro->value.function.type = Function_Type::Special_Lambda; // // NOTE(Felix): deferred so even if eval expr // // fails, and returns, the type will be be // // resetted to macro. // defer { // macro->value.function.type = Function_Type::Macro; // }; // try expression = eval_expr(expression); // break; // } else break; // } // } return expression; } proc parse_single_expression(char* text) -> Lisp_Object* { parser_file = standard_in; parser_line = 1; parser_col = 1; int index_in_text = 0; Lisp_Object* result; eat_until_code(text, &index_in_text); if (text[(index_in_text)] == '\0') return Memory::nil; if (text[index_in_text] == '(' || text[index_in_text] == '\'' || text[index_in_text] == '@' || text[index_in_text] == '`' || text[index_in_text] == ',') { try { result = parse_expression(text, &index_in_text); } } else try { result = parse_atom(text, &index_in_text); } eat_until_code(text, &index_in_text); if (text[(index_in_text)] == '\0') return result; create_parsing_error("Trainling garbage after expression at %s:%d:%d", parser_file, parser_line, parser_col); return nullptr; } proc parse_single_expression_or_bare_words(char* text, char* bare) -> Lisp_Object* { parser_file = standard_in; parser_line = 1; parser_col = 1; int index_in_text = 0; Lisp_Object* result; eat_until_code(text, &index_in_text); if (text[(index_in_text)] == '\0') return Memory::nil; if (text[index_in_text] == '(' || text[index_in_text] == '\'' || text[index_in_text] == '@' || text[index_in_text] == '`' || text[index_in_text] == ',') { try { result = parse_expression(text, &index_in_text); } return result; } else { // TODO(Felix): What is going on, why do we not have to // increase the index_in_text int end_pos = index_in_text; while (text[end_pos] != '\n') ++end_pos; text[end_pos] = '\0'; Lisp_Object* str; try str = Memory::create_lisp_object_string( Memory::create_string(text+index_in_text)); text[end_pos] = '\n'; return Memory::create_list(Memory::get_or_create_lisp_object_symbol(bare), str); } } proc write_expanded_file(String* file_name, Lisp_Object_Array_List program) -> void { const char* ext = ".expanded"; char* newName = (char*)calloc(10 + file_name->length, sizeof(char)); strcpy(newName, Memory::get_c_str(file_name)); strcat(newName, ext); FILE *f = fopen(newName, "w"); defer { fclose(f); free(newName); }; if (f == NULL) { printf("Error opening .expanded file for writing!\n"); exit(1); } for (int i = 0; i < program.next_index; ++i) { // a macro will parse as nil for now, so we skip those if (program.data[i] == Memory::nil) continue; print(program.data[i], true, f); fprintf(f, "\n\n"); } } proc parse_program(String* file_name, char* text) -> Lisp_Object_Array_List { parser_file = file_name; parser_line = 1; parser_col = 0; Lisp_Object_Array_List program = create_Lisp_Object_array_list(); int index_in_text = 0; while (text[index_in_text] != '\0') { switch (text[index_in_text]) { case '(': { Lisp_Object* parsed; try_struct { parsed = parse_expression(text, &index_in_text); } append_to_array_list(&program, parsed); } break; case ';': case ' ': case '\t': case '\n': case '\r': { eat_until_code(text, &index_in_text); } break; default: /* syntax error */ create_parsing_error("Garbage in file scope at %s:%d:%d", parser_file, parser_line, parser_col); return {}; } } write_expanded_file(file_name, program); return program; } }