605 lines
22 KiB
C++
605 lines
22 KiB
C++
namespace Parser {
|
|
String* standard_in;
|
|
String* parser_file;
|
|
int parser_line;
|
|
int parser_col;
|
|
|
|
// NOTE(Felix): In this environment, the build in functions will
|
|
// be loaded, and the macros will be stored in form of
|
|
// special-lambdas, that get executed in this environment at
|
|
// read-time. This should always be the global environment.
|
|
Environment* environment_for_macros;
|
|
|
|
// proc set_environment_for_macros(Environment* env) -> void {
|
|
// // NOTE(Felix): it is important to keep the parser environment
|
|
// // up to date with the global environment. When doing tests,
|
|
// // or running a programm we have to reload it.
|
|
|
|
// // NOTE(Felix): For now we just allow executing built-ins at
|
|
// // read-time (while creating macros). If later we want to
|
|
// // change that, we have to define some funcions in this
|
|
// // environment.
|
|
// environment_for_macros = env;
|
|
// }
|
|
|
|
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;
|
|
// TODO(Felix): use Memory::create_list() here
|
|
if (quoteType == '\'')
|
|
try ret = Memory::create_lisp_object_pair(
|
|
Memory::get_or_create_lisp_object_symbol("quote"),
|
|
Memory::create_lisp_object_pair(result, Memory::nil));
|
|
else if (quoteType == '`')
|
|
try ret = Memory::create_lisp_object_pair(
|
|
Memory::get_or_create_lisp_object_symbol("quasiquote"),
|
|
Memory::create_lisp_object_pair(result, Memory::nil));
|
|
else if (quoteType == ',')
|
|
try ret = Memory::create_lisp_object_pair(
|
|
Memory::get_or_create_lisp_object_symbol("unquote"),
|
|
Memory::create_lisp_object_pair(result, Memory::nil));
|
|
else if (quoteType == '@') {
|
|
try ret = Memory::create_lisp_object_pair(
|
|
Memory::get_or_create_lisp_object_symbol("unquote-splicing"),
|
|
Memory::create_lisp_object_pair(result, Memory::nil));
|
|
}
|
|
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 = environment_for_macros;
|
|
macro->value.function.type = Function_Type::Macro;
|
|
|
|
// if parameters were specified
|
|
if (arguments != Memory::nil) {
|
|
try assert_type(arguments, Lisp_Object_Type::Pair);
|
|
try parse_argument_list(arguments, ¯o->value.function);
|
|
} else {
|
|
macro->value.function.positional_arguments = create_positional_argument_list(1);
|
|
macro->value.function.keyword_arguments = create_keyword_argument_list(1);
|
|
macro->value.function.rest_argument = 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->value.function.docstring = body->value.pair.first->value.string;
|
|
body = body->value.pair.rest;
|
|
} else {
|
|
macro->value.function.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);
|
|
|
|
// macro->value.function = function;
|
|
define_symbol(symbol_for_macro, macro, environment_for_macros);
|
|
|
|
// 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.
|
|
|
|
Lisp_Object* macro = try_lookup_symbol(parsed_symbol, environment_for_macros);
|
|
if (macro &&
|
|
Memory::get_type(macro) == Lisp_Object_Type::Function &&
|
|
macro->value.function.type == Function_Type::Macro)
|
|
{
|
|
// printf("Found macro: ") ;
|
|
// print(parsed_symbol);
|
|
// printf("\n");
|
|
try expression = eval_expr(expression, environment_for_macros);
|
|
} 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 {
|
|
int pos = 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 file!\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 {
|
|
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 nullptr;
|
|
}
|
|
}
|
|
|
|
write_expanded_file(file_name, program);
|
|
|
|
return program;
|
|
}
|
|
}
|