felix/slime
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

better errors and new define syntax

Browse Source
This commit is contained in:
FelixBrendel
2019-03-13 16:01:40 +01:00
parent 181ace1eed
commit edef0b017b
12 changed files with 276 additions and 426 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/built_ins.cpp
+106 -48
View File
@@ -65,9 +65,10 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object* evaluated_arguments;
#define cLambda [=](Lisp_Object* arguments, Environment* env) mutable -> Lisp_Object*
#define report_error(_type) { \
create_error(_type, current_source_code_location); \
return nullptr; \
#define report_error(_type) { \
printf("Error occurred\nin %s:%d\n", __FILE__, __LINE__); \
create_error(_type, current_source_code_location); \
return nullptr; \
}
proc defun = [&](const char* name, auto fun) {
@@ -77,6 +78,46 @@ proc load_built_ins_into_environment(Environment* env) -> void {
env);
};
proc parse_lambda_starting_from_args = [&](Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
Function* function = new(Function);
function->parent_environment = env;
function->type = Function_Type::Lambda;
// if parameters were specified
if (arguments->value.pair->first->type != Lisp_Object_Type::Nil) {
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Pair);
}
try {
parse_argument_list(arguments->value.pair->first, function);
}
} else {
function->positional_arguments = create_positional_argument_list(1);
function->keyword_arguments = create_keyword_argument_list(1);
function->rest_argument = nullptr;
}
arguments = arguments->value.pair->rest;
// if there is a docstring, use it
if (arguments->value.pair->first->type == Lisp_Object_Type::String) {
function->docstring = arguments->value.pair->first->value.string;
arguments = arguments->value.pair->rest;
} else {
function->docstring = nullptr;
}
// we are now in the function body, just wrap it in an
// implicit prog
function->body = Memory::create_lisp_object_pair(
Memory::get_or_create_lisp_object_symbol("prog"),
arguments);
Lisp_Object* ret = Memory::create_lisp_object();
ret->type = Lisp_Object_Type::Function;
ret->value.function = function;
return ret;
};
defun("=", cLambda {
int arguments_length;
try {
@@ -316,25 +357,57 @@ proc load_built_ins_into_environment(Environment* env) -> void {
arguments_length = list_length(arguments);
}
if (arguments_length != 2) {
if (arguments_length < 2) {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}
Lisp_Object* symbol = arguments->value.pair->first;
Lisp_Object* value;
if (symbol->type == Lisp_Object_Type::Pair) {
/*
1: arguments
2: symbol
3: real_symbol
(define (f x) "docs" (+ 1 x))
[ | ] -> [1| ] -> [ | ] -> [ |/]
| | | |
V | V V
define | "docs" [ | ] -> [ | ] -> [ |/]
| | | |
V V V V
[2| ] -> [ |/] + 1 x
| |
V V
f(3) x
*/
Lisp_Object* real_symbol = symbol->value.pair->first;
try {
symbol = eval_expr(symbol, env);
assert_type(real_symbol, Lisp_Object_Type::Symbol);
}
}
if (symbol->type != Lisp_Object_Type::Symbol) {
report_error(Error_Type::Type_Missmatch);
}
Lisp_Object* fake_lambda = Memory::create_lisp_object_pair(
symbol ->value.pair->rest,
arguments->value.pair->rest);
Lisp_Object* value = arguments->value.pair->rest->value.pair->first;
try {
value = eval_expr(value, env);
value = parse_lambda_starting_from_args(fake_lambda, env);
symbol = real_symbol;
} else {
if (arguments_length > 2) {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}
if (symbol->type != Lisp_Object_Type::Symbol) {
report_error(Error_Type::Type_Missmatch);
}
value = arguments->value.pair->rest->value.pair->first;
try {
value = eval_expr(value, env);
}
}
define_symbol(symbol, value, env);
@@ -635,7 +708,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return evaluated_arguments->value.pair->first;
});
defun("lambda", cLambda {
/*
/* TODO(Felix): first one crashes
* (lambda ())
* (lambda (x d) (+ 1 2) (- 1 2) (* 1 2))
*/
@@ -646,43 +719,11 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (arguments_length == 0)
report_error(Error_Type::Wrong_Number_Of_Arguments);
Function* function = new(Function);
function->parent_environment = env;
function->type = Function_Type::Lambda;
Lisp_Object* function = parse_lambda_starting_from_args(arguments, env);
// parse lambda starting from arguments
// if parameters were specified
if (arguments->value.pair->first->type != Lisp_Object_Type::Nil) {
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Pair);
}
try {
parse_argument_list(arguments->value.pair->first, function);
}
} else {
function->positional_arguments = create_positional_argument_list(1);
function->keyword_arguments = create_keyword_argument_list(1);
function->rest_argument = nullptr;
}
arguments = arguments->value.pair->rest;
// if there is a docstring, use it
if (arguments->value.pair->first->type == Lisp_Object_Type::String) {
function->docstring = arguments->value.pair->first->value.string;
arguments = arguments->value.pair->rest;
} else {
function->docstring = nullptr;
}
// we are now in the function body, just wrap it in an
// implicit prog
function->body = Memory::create_lisp_object_pair(
Memory::get_or_create_lisp_object_symbol("prog"),
arguments);
Lisp_Object* ret = Memory::create_lisp_object();
ret->type = Lisp_Object_Type::Function;
ret->value.function = function;
return ret;
return function;
});
defun("special-lambda", cLambda {
/*
@@ -953,6 +994,23 @@ proc load_built_ins_into_environment(Environment* env) -> void {
delete_error();
}
return Memory::nil;
});
defun("show", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}
if (arguments_length != 1) {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}
if (evaluated_arguments->value.pair->first->type != Lisp_Object_Type::Function) {
report_error(Error_Type::Type_Missmatch);
}
puts("body:\n");
print(evaluated_arguments->value.pair->first->value.function->body);
puts("\n");
return Memory::nil;
});
defun("print", cLambda {
src/defines.cpp
+36 -26
View File
@@ -10,10 +10,14 @@ constexpr bool is_debug_build = false;
#define if_debug if constexpr (is_debug_build)
#ifdef _MSC_VER
# define if_windows if constexpr (1)
# define if_linux if constexpr (0)
# define debug_break() if_debug __debugbreak()
#else
# include <signal.h>
# define debug_break() if_debug raise(SIGTRAP)
# define if_windows if (0)
# define if_linux if (1)
#endif
#define assert(cond) \
@@ -26,26 +30,32 @@ constexpr bool is_debug_build = false;
#define concat_( a, b) a##b
#define label(prefix, lnum) concat_(prefix,lnum)
#define try \
if (1) \
goto label(body,__LINE__); \
else \
while (1) \
if (1) { \
if(error) return 0; \
break; \
} \
#define try \
if (1) \
goto label(body,__LINE__); \
else \
while (1) \
if (1) { \
if(error) { \
printf("in %s:%d\n", __FILE__, __LINE__); \
return 0; \
} \
break; \
} \
else label(body,__LINE__):
#define try_void \
if (1) \
goto label(body,__LINE__); \
else \
while (1) \
if (1) { \
if(error) return; \
break; \
} \
#define try_void \
if (1) \
goto label(body,__LINE__); \
else \
while (1) \
if (1) { \
if(error) { \
printf("in %s:%d\n", __FILE__, __LINE__); \
return; \
} \
break; \
} \
else label(body,__LINE__):
@@ -75,11 +85,11 @@ constexpr bool is_debug_build = false;
return ret; \
}
// #define console_normal "\x1B[0m"
// #define console_red "\x1B[31m"
// #define console_green "\x1B[32m"
// #define console_cyan "\x1B[36m"
#define console_normal ""
#define console_red ""
#define console_green ""
#define console_cyan ""
#define console_normal "\x1B[0m"
#define console_red "\x1B[31m"
#define console_green "\x1B[32m"
#define console_cyan "\x1B[36m"
// #define console_normal ""
// #define console_red ""
// #define console_green ""
// #define console_cyan ""
src/error.cpp
+6 -4
View File
@@ -39,8 +39,10 @@ proc Error_Type_to_string(Error_Type type) -> const char* {
}
proc assert_type(Lisp_Object* node, Lisp_Object_Type type) -> void {
if (!node)
create_error(Error_Type::Unknown_Error, nullptr);
if (node->type == type) return;
create_error(Error_Type::Type_Missmatch, node->sourceCodeLocation);
if_debug {
if (!node)
create_error(Error_Type::Unknown_Error, nullptr);
if (node->type == type) return;
create_error(Error_Type::Type_Missmatch, node->sourceCodeLocation);
}
}
src/eval.cpp
+4 -8
View File
@@ -321,6 +321,7 @@ proc extract_keyword_value(char* keyword, Parsed_Arguments* args) -> Lisp_Object
proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length) -> Lisp_Object* {
int my_out_arguments_length = 0;
if (arguments->type == Lisp_Object_Type::Nil) {
*(out_arguments_length) = 0;
return arguments;
}
@@ -351,11 +352,6 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments
}
proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
#define report_error(_type) { \
create_error(_type, node->sourceCodeLocation); \
return nullptr; \
}
switch (node->type) {
case Lisp_Object_Type::T:
case Lisp_Object_Type::Nil:
@@ -372,7 +368,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
}
case Lisp_Object_Type::Pair: {
current_source_code_location = node->sourceCodeLocation;
Lisp_Object* lispOperator;
if (node->value.pair->first->type != Lisp_Object_Type::CFunction &&
node->value.pair->first->type != Lisp_Object_Type::Function)
@@ -411,10 +407,10 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
}
}
default: {
report_error(Error_Type::Not_A_Function);
create_error(Error_Type::Not_A_Function, node->sourceCodeLocation);
return nullptr;
}
}
#undef report_error
}
proc is_truthy (Lisp_Object* expression, Environment* env) -> bool {
src/forward_decls.cpp
+1
View File
@@ -7,3 +7,4 @@ proc list_length(Lisp_Object*) -> int;
proc load_built_ins_into_environment(Environment*) -> void;
proc parse_argument_list(Lisp_Object*, Function*) -> void;
proc create_error(Error_Type type, Source_Code_Location* location) -> void;
proc assert_type(Lisp_Object* node, Lisp_Object_Type type) -> void;
src/io.cpp
+18 -15
View File
@@ -22,9 +22,9 @@ proc string_equal(String* str1, String* str2) -> bool {
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;
else if (c >= 'a' && c <= 'f')
return (c - 'a') + 10;
return (c - '0');
}
@@ -42,6 +42,7 @@ proc unescape_string(char* in) -> bool {
} else {
/* escape sequence */
switch (*++p) {
case '0': *out++ = '\a'; ++p; break;
case 'a': *out++ = '\a'; ++p; break;
case 'b': *out++ = '\b'; ++p; break;
case 'f': *out++ = '\f'; ++p; break;
@@ -49,22 +50,21 @@ proc unescape_string(char* in) -> bool {
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;
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;
@@ -227,10 +227,10 @@ proc panic(char* message) -> void {
exit(1);
}
proc print(Lisp_Object* node) -> void {
proc print(Lisp_Object* node, bool print_quotes = false) -> void {
switch (node->type) {
case (Lisp_Object_Type::Nil): {
printf("nil");
printf("()");
} break;
case (Lisp_Object_Type::T): {
printf("t");
@@ -239,7 +239,10 @@ proc print(Lisp_Object* node) -> void {
printf("%f", node->value.number->value);
} break;
case (Lisp_Object_Type::String): {
printf("\"%s\"", Memory::get_c_str(node->value.string));
if (print_quotes)
printf("\"%s\"", Memory::get_c_str(node->value.string));
else
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));
src/memory.cpp
+37
View File
@@ -46,6 +46,11 @@ namespace Memory {
return &str->data;
}
inline proc get_c_str(Lisp_Object* str) -> char* {
assert_type(str, Lisp_Object_Type::String);
return get_c_str(str->value.string);
}
proc create_string(const char* str, int len) -> String* {
// TODO(Felix): check the holes first, not just always append
// at the end
@@ -146,6 +151,13 @@ namespace Memory {
return node;
}
proc create_lisp_object_string(char* str) -> Lisp_Object* {
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::String;
node->value.string = create_string(str);
return node;
}
proc get_or_create_lisp_object_symbol(String* identifier) -> Lisp_Object* {
// TODO(Felix): if we already have it stored somewhere then
// reuse it and dont create new one
@@ -223,4 +235,29 @@ namespace Memory {
load_built_ins_into_environment(ret);
return ret;
}
inline proc create_list(Lisp_Object* o1) -> Lisp_Object* {
return create_lisp_object_pair(o1, nil);
}
inline proc create_list(Lisp_Object* o1, Lisp_Object* o2) -> Lisp_Object* {
return create_lisp_object_pair(o1, create_list(o2));
}
inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3) -> Lisp_Object* {
return create_lisp_object_pair(o1, create_list(o2, o3));
}
inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3, Lisp_Object* o4) -> Lisp_Object* {
return create_lisp_object_pair(o1, create_list(o2, o3, o4));
}
inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3, Lisp_Object* o4, Lisp_Object* o5) -> Lisp_Object* {
return create_lisp_object_pair(o1, create_list(o2, o3, o4, o5));
}
inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3, Lisp_Object* o4, Lisp_Object* o5, Lisp_Object* o6) -> Lisp_Object* {
return create_lisp_object_pair(o1, create_list(o2, o3, o4, o5, o6));
}
}
src/parse.cpp
+65 -10
View File
@@ -1,8 +1,9 @@
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
@@ -19,6 +20,7 @@ namespace Parser {
// change that, we have to define some funcions in this
// environment.
environment_for_macros = env;
standard_in = Memory::create_string("stdin");
}
proc inject_scl(Lisp_Object* lo) -> void {
@@ -98,6 +100,7 @@ namespace Parser {
// update the index to point to the character after the atom
// ended
*index_in_text += atom_length;
parser_col += atom_length;
return ret;
}
@@ -147,6 +150,7 @@ namespace Parser {
// plus one because we want to go after the quotes
*index_in_text += 1;
++parser_col;
return ret;
}
@@ -170,18 +174,31 @@ namespace Parser {
create_source_code_location(parser_file, parser_line, parser_col));
return nullptr;
}
// 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));
/* manually copy to parse control sequences correctly */
/* int temp_index = 0; */
/* while (text+(temp_index+(*index_in_text)) != '\0') { */
/* string[temp_index++] = text[temp_index+(*index_in_text)]; */
/* } */
/* string[temp_index++] = '\0'; */
text[*index_in_text+string_length] = '"';
*index_in_text += string_length +1; // plus one because we want to
// go after the quotes
// 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 = Memory::create_lisp_object_string(string);
inject_scl(ret);
@@ -445,7 +462,7 @@ namespace Parser {
}
proc parse_single_expression(char* text) -> Lisp_Object* {
parser_file = Memory::create_string("stdin");
parser_file = standard_in;
parser_line = 1;
parser_col = 1;
@@ -474,6 +491,44 @@ namespace Parser {
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] == ',')
{
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 = 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));
src/slime.h
+3
View File
@@ -1,9 +1,11 @@
#pragma once
#define _CRT_SECURE_NO_WARNINGS
#define _CRT_SECURE_NO_DEPRECATE
#include <stdio.h>
#include <string.h>
#include <cmath>
#include <ctype.h>
// #include <type_traits>
#include <functional>
@@ -25,3 +27,4 @@ namespace Slime {
}
#undef _CRT_SECURE_NO_DEPRECATE
#undef _CRT_SECURE_NO_WARNINGS