399 lines
13 KiB
C++
399 lines
13 KiB
C++
namespace Slime::Parser {
|
|
String* standard_in;
|
|
String* parser_file;
|
|
int parser_line;
|
|
int 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 step_char(char* text, int* index_in_text, int steps = 1) {
|
|
for (int i = 0; i < steps; ++i) {
|
|
if (text[(*index_in_text)] == '\n') {
|
|
++parser_line;
|
|
parser_col = 0;
|
|
}
|
|
++parser_col;
|
|
++(*index_in_text);
|
|
}
|
|
}
|
|
|
|
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')
|
|
{
|
|
step_char(text, index_in_text);
|
|
}
|
|
}
|
|
|
|
proc eat_until_code(char* text, int* index_in_text) -> void {
|
|
profile_this();
|
|
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 step_char_and_eat_until_code(char* text, int* index_in_text) {
|
|
step_char(text, index_in_text);
|
|
eat_until_code(text, index_in_text);
|
|
}
|
|
|
|
proc parse_fancy_delimiter(char* text, int* index_in_text, char l_delimiter, char r_delimiter, Lisp_Object* first_elem) -> Lisp_Object* {
|
|
profile_this();
|
|
if (text[*index_in_text] != l_delimiter) {
|
|
create_parsing_error("a fancy cannot be parsed here");
|
|
return nullptr;
|
|
}
|
|
|
|
Lisp_Object* ret;
|
|
Lisp_Object* head;
|
|
try ret = Memory::create_lisp_object_pair(first_elem, Memory::nil);
|
|
head = ret;
|
|
|
|
step_char(text, index_in_text);
|
|
|
|
eat_until_code(text, index_in_text);
|
|
while (text[*index_in_text] != r_delimiter) {
|
|
Lisp_Object* element;
|
|
try element = parse_expression(text, index_in_text);
|
|
try head->value.pair.rest = Memory::create_lisp_object_pair(element, Memory::nil);
|
|
head = head->value.pair.rest;
|
|
eat_until_code(text, index_in_text);
|
|
}
|
|
|
|
step_char(text, index_in_text);
|
|
|
|
return ret;
|
|
}
|
|
|
|
proc get_atom_text_length(char* text, int* index_in_text) -> int {
|
|
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] != '[' &&
|
|
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;
|
|
}
|
|
return atom_length;
|
|
}
|
|
|
|
proc parse_number(char* text, int* index_in_text) -> Lisp_Object* {
|
|
Lisp_Object* ret;
|
|
try ret = Memory::create_lisp_object(0.0);
|
|
|
|
sscanf(text+*index_in_text, "%lf", &ret->value.number);
|
|
|
|
int atom_length = get_atom_text_length(text, index_in_text);
|
|
step_char(text, index_in_text, atom_length);
|
|
|
|
return ret;
|
|
}
|
|
|
|
proc parse_symbol_or_keyword(char* text, int* index_in_text) -> Lisp_Object* {
|
|
bool keyword = false;
|
|
if (text[*index_in_text] == ':') {
|
|
keyword = true;
|
|
step_char(text, index_in_text);
|
|
}
|
|
|
|
int atom_length = get_atom_text_length(text, index_in_text);
|
|
char orig = text[*index_in_text+atom_length];
|
|
text[*index_in_text+atom_length] = '\0';
|
|
|
|
|
|
String* str_keyword;
|
|
Lisp_Object* ret;
|
|
try str_keyword = Memory::create_string("", atom_length);
|
|
strcpy(&str_keyword->data, text+*index_in_text);
|
|
|
|
if (keyword) {
|
|
try ret = Memory::get_keyword(str_keyword);
|
|
} else {
|
|
try ret = Memory::get_symbol(str_keyword);
|
|
}
|
|
|
|
|
|
text[*index_in_text+atom_length] = orig;
|
|
step_char(text, index_in_text, atom_length);
|
|
|
|
return ret;
|
|
}
|
|
|
|
proc parse_string(char* text, int* index_in_text) -> Lisp_Object* {
|
|
// the first character is the '"'
|
|
step_char(text, index_in_text);
|
|
|
|
// 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(Memory::create_string("", 0));
|
|
// inject_scl(ret);
|
|
|
|
// plus one because we want to go after the quotes
|
|
step_char(text, index_in_text);
|
|
|
|
return ret;
|
|
}
|
|
|
|
// okay so the first letter was not actually closing the string...
|
|
int string_length = 0;
|
|
bool escaping = false;
|
|
while (escaping || text[*index_in_text+string_length] != '"') {
|
|
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.
|
|
int new_len;
|
|
try new_len = unescape_string(text+(*index_in_text));
|
|
|
|
String* string = Memory::create_string("", new_len);
|
|
|
|
strcpy(&string->data, text+(*index_in_text));
|
|
// printf("------ %s\n", &string->data);
|
|
|
|
text[*index_in_text+string_length] = '"';
|
|
|
|
// plus one because we want to go after the quotes
|
|
step_char(text, index_in_text, string_length+1);
|
|
|
|
Lisp_Object* ret;
|
|
try ret = Memory::create_lisp_object(string);
|
|
|
|
// inject_scl(ret);
|
|
return ret;
|
|
}
|
|
|
|
proc parse_atom(char* text, int* index_in_text) -> Lisp_Object* {
|
|
profile_this();
|
|
Lisp_Object* ret;
|
|
// 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)))
|
|
{
|
|
try ret = parse_number(text, index_in_text);
|
|
}
|
|
|
|
else if (text[*index_in_text] == '"')
|
|
try ret = parse_string(text, index_in_text);
|
|
else
|
|
try ret = parse_symbol_or_keyword(text, index_in_text);
|
|
|
|
return ret;
|
|
}
|
|
|
|
|
|
|
|
proc parse_list(char* text, int* index_in_text) -> Lisp_Object* {
|
|
profile_this();
|
|
if (text[*index_in_text] != '(') {
|
|
create_parsing_error("a list cannot be parsed here");
|
|
return nullptr;
|
|
}
|
|
step_char_and_eat_until_code(text, index_in_text);
|
|
|
|
if (text[*index_in_text] == ')') {
|
|
step_char(text, index_in_text);
|
|
return Memory::nil;
|
|
}
|
|
|
|
Lisp_Object* first_elem;
|
|
Lisp_Object* ret;
|
|
Lisp_Object* head;
|
|
|
|
|
|
try first_elem = parse_expression(text, index_in_text);
|
|
try ret = Memory::create_lisp_object_pair(first_elem, Memory::nil);
|
|
head = ret;
|
|
|
|
eat_until_code(text, index_in_text);
|
|
while (text[*index_in_text] != ')') {
|
|
Lisp_Object* element;
|
|
|
|
if (text[*index_in_text+0] == '.' &&
|
|
text[*index_in_text+1] == ' ')
|
|
{
|
|
step_char(text, index_in_text, 2);
|
|
try element = parse_expression(text, index_in_text);
|
|
head->value.pair.rest = element;
|
|
|
|
eat_until_code(text, index_in_text);
|
|
if (text[*index_in_text] != ')') {
|
|
create_parsing_error("expected the list to end after the dotted end.");
|
|
return nullptr;
|
|
}
|
|
step_char(text, index_in_text);
|
|
return ret;
|
|
}
|
|
|
|
try element = parse_expression(text, index_in_text);
|
|
try head->value.pair.rest = Memory::create_lisp_object_pair(element, Memory::nil);
|
|
head = head->value.pair.rest;
|
|
eat_until_code(text, index_in_text);
|
|
}
|
|
step_char(text, index_in_text);
|
|
return ret;
|
|
}
|
|
|
|
proc maybe_expand_short_form(char* text, int* index_in_text) -> Lisp_Object* {
|
|
profile_this();
|
|
Lisp_Object* vector_sym = Memory::get_symbol("vector");
|
|
Lisp_Object* hash_map_sym = Memory::get_symbol("hash-map");
|
|
|
|
Lisp_Object* quote_sym = Memory::get_symbol("quote");
|
|
Lisp_Object* quasiquote_sym = Memory::get_symbol("quasiquote");
|
|
Lisp_Object* unquote_sym = Memory::get_symbol("unquote");
|
|
Lisp_Object* unquote_splicing_sym = Memory::get_symbol("unquote-splicing");
|
|
|
|
Lisp_Object* ret = nullptr;
|
|
Lisp_Object* expr;
|
|
|
|
switch (text[*index_in_text]) {
|
|
case '\'': {
|
|
// quote
|
|
step_char_and_eat_until_code(text, index_in_text);
|
|
try expr = parse_expression(text, index_in_text);
|
|
try ret = Memory::create_lisp_object_pair(expr, Memory::nil);
|
|
try ret = Memory::create_lisp_object_pair(quote_sym, ret);
|
|
} break;
|
|
case '`': {
|
|
// quasiquote
|
|
step_char_and_eat_until_code(text, index_in_text);
|
|
try expr = parse_expression(text, index_in_text);
|
|
try ret = Memory::create_lisp_object_pair(expr, Memory::nil);
|
|
try ret = Memory::create_lisp_object_pair(quasiquote_sym, ret);
|
|
} break;
|
|
case ',': {
|
|
step_char_and_eat_until_code(text, index_in_text);
|
|
if (text[*index_in_text] == '@') {
|
|
// unquote-splicing
|
|
step_char_and_eat_until_code(text, index_in_text);
|
|
try expr = parse_expression(text, index_in_text);
|
|
try ret = Memory::create_lisp_object_pair(expr, Memory::nil);
|
|
try ret = Memory::create_lisp_object_pair(unquote_splicing_sym, ret);
|
|
} else {
|
|
// unquote
|
|
try expr = parse_expression(text, index_in_text);
|
|
try ret = Memory::create_lisp_object_pair(expr, Memory::nil);
|
|
try ret = Memory::create_lisp_object_pair(unquote_sym, ret);
|
|
}
|
|
} break;
|
|
case '[': {
|
|
// vector
|
|
try ret = parse_fancy_delimiter(text, index_in_text, '[', ']', vector_sym);
|
|
} break;
|
|
case '{': {
|
|
// hashmap
|
|
try ret = parse_fancy_delimiter(text, index_in_text, '{', '}', hash_map_sym);
|
|
} break;
|
|
default: break;
|
|
}
|
|
|
|
return ret;
|
|
}
|
|
|
|
proc parse_expression(char* text, int* index_in_text) -> Lisp_Object* {
|
|
profile_this();
|
|
Lisp_Object* ret;
|
|
eat_until_code(text, index_in_text);
|
|
try ret = maybe_expand_short_form(text, index_in_text);
|
|
if (ret)
|
|
return ret;
|
|
|
|
if (text[*index_in_text] == '(') {
|
|
try ret = parse_list(text, index_in_text);
|
|
} else {
|
|
try ret = parse_atom(text, index_in_text);
|
|
}
|
|
|
|
return ret;
|
|
}
|
|
|
|
proc parse_single_expression(wchar_t* text) -> Lisp_Object* {
|
|
char* res = wchar_to_char(text);
|
|
defer {free(res);};
|
|
return parse_single_expression(res);
|
|
}
|
|
|
|
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* ret;
|
|
try ret = parse_expression(text, &index_in_text);
|
|
return ret;
|
|
}
|
|
|
|
|
|
proc parse_program(String* file_name, char* text) -> Array_List<Lisp_Object*>* {
|
|
profile_this();
|
|
parser_file = file_name;
|
|
parser_line = 1;
|
|
parser_col = 0;
|
|
|
|
Array_List<Lisp_Object*>* program = new Array_List<Lisp_Object*>;
|
|
|
|
int index_in_text = 0;
|
|
Lisp_Object* parsed;
|
|
|
|
eat_until_code(text, &index_in_text);
|
|
while (text[index_in_text] != '\0') {
|
|
try parsed = parse_expression(text, &index_in_text);
|
|
program->append(parsed);
|
|
eat_until_code(text, &index_in_text);
|
|
}
|
|
return program;
|
|
}
|
|
|
|
}
|