slime/src/parse.cpp

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