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

cleanup

Browse Source
This commit is contained in:
FelixBrendel
2019-01-28 14:57:40 +01:00
parent 29bd534525
commit 3453a525ef
19 changed files with 520 additions and 569 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/built_ins.cpp
+14 -14
View File
@@ -1,4 +1,4 @@
bool lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) {
proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
if (n1 == n2)
return true;
if (n1->type != n2->type)
@@ -42,7 +42,7 @@ bool lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) {
return false;
}
Lisp_Object* built_in_equals(Lisp_Object* arguments, Environment* env) {
proc built_in_equals(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
@@ -62,7 +62,7 @@ Lisp_Object* built_in_equals(Lisp_Object* arguments, Environment* env) {
return Memory::create_lisp_object_t();
}
Lisp_Object* built_in_greater(Lisp_Object* arguments, Environment* env) {
proc built_in_greater(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
@@ -85,7 +85,7 @@ Lisp_Object* built_in_greater(Lisp_Object* arguments, Environment* env) {
return Memory::create_lisp_object_t();
}
Lisp_Object* built_in_greater_equal(Lisp_Object* arguments, Environment* env) {
proc built_in_greater_equal(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
@@ -108,7 +108,7 @@ Lisp_Object* built_in_greater_equal(Lisp_Object* arguments, Environment* env) {
return Memory::create_lisp_object_t();
}
Lisp_Object* built_in_less(Lisp_Object* arguments, Environment* env) {
proc built_in_less(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
@@ -131,7 +131,7 @@ Lisp_Object* built_in_less(Lisp_Object* arguments, Environment* env) {
return Memory::create_lisp_object_t();
}
Lisp_Object* built_in_less_equal(Lisp_Object* arguments, Environment* env) {
proc built_in_less_equal(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
@@ -154,7 +154,7 @@ Lisp_Object* built_in_less_equal(Lisp_Object* arguments, Environment* env) {
return Memory::create_lisp_object_t();
}
Lisp_Object* built_in_add(Lisp_Object* arguments, Environment* env) {
proc built_in_add(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
@@ -172,7 +172,7 @@ Lisp_Object* built_in_add(Lisp_Object* arguments, Environment* env) {
return Memory::create_lisp_object_number(sum);
}
Lisp_Object* built_in_substract(Lisp_Object* arguments, Environment* env) {
proc built_in_substract(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
@@ -195,7 +195,7 @@ Lisp_Object* built_in_substract(Lisp_Object* arguments, Environment* env) {
return Memory::create_lisp_object_number(difference);
}
Lisp_Object* built_in_multiply(Lisp_Object* arguments, Environment* env) {
proc built_in_multiply(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
@@ -218,7 +218,7 @@ Lisp_Object* built_in_multiply(Lisp_Object* arguments, Environment* env) {
return Memory::create_lisp_object_number(product);
}
Lisp_Object* built_in_divide(Lisp_Object* arguments, Environment* env) {
proc built_in_divide(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
@@ -241,7 +241,7 @@ Lisp_Object* built_in_divide(Lisp_Object* arguments, Environment* env) {
return Memory::create_lisp_object_number(quotient);
}
Lisp_Object* built_in_exponentiate(Lisp_Object* arguments, Environment* env) {
proc built_in_exponentiate(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
@@ -270,7 +270,7 @@ Lisp_Object* built_in_exponentiate(Lisp_Object* arguments, Environment* env) {
}
Lisp_Object* built_in_load(char* file_name, Environment* env) {
proc built_in_load(char* file_name, Environment* env) -> Lisp_Object* {
char* file_content = read_entire_file(file_name);
if (file_content) {
Lisp_Object* result = Memory::create_lisp_object_nil();
@@ -290,7 +290,7 @@ Lisp_Object* built_in_load(char* file_name, Environment* env) {
}
}
void load_built_ins_into_environment(Environment* env) {
proc load_built_ins_into_environment(Environment* env) -> void {
int arguments_length;
Lisp_Object* evaluated_arguments;
@@ -300,7 +300,7 @@ void load_built_ins_into_environment(Environment* env) {
return nullptr; \
}
auto defun = [&](char* name, std::function<Lisp_Object*(Lisp_Object*, Environment*)> fun) {
proc defun = [&](char* name, std::function<Lisp_Object*(Lisp_Object*, Environment*)> fun) {
define_symbol(
Memory::create_lisp_object_symbol(name),
Memory::create_lisp_object_cfunction(fun),
src/defines.cpp
+79
View File
@@ -0,0 +1,79 @@
#define new(type) new type
#define proc auto
#ifdef _DEBUG
constexpr bool is_debug_build = true;
#else
constexpr bool is_debug_build = false;
#endif
#define if_debug if constexpr (is_debug_build)
#define assert(cond) \
if_debug { \
if (!cond) { \
printf("Assertion failed: %s %d", __FILE__, __LINE__); \
__debugbreak(); \
} \
} else {} \
#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; \
} \
else label(body,__LINE__):
#define try_void \
if (1) \
goto label(body,__LINE__); \
else \
while (1) \
if (1) { \
if(error) return; \
break; \
} \
else label(body,__LINE__):
#define define_array_list(type, name) \
struct name##_Array_List { \
type* data; \
int length; \
int next_index; \
}; \
\
\
proc append_to_##name##_array_list(name##_Array_List* arraylist, type element) -> void { \
if (arraylist->next_index == arraylist->length) { \
arraylist->length *= 2; \
arraylist->data = \
(type*)realloc(arraylist->data, arraylist->length * sizeof(type)); \
} \
arraylist->data[arraylist->next_index++] = element; \
} \
\
\
proc create_##name##_array_list(int initial_capacity = 16) -> name##_Array_List* { \
name##_Array_List* ret = new(name##_Array_List); \
ret->data = (type*)malloc(initial_capacity * sizeof(type)); \
ret->next_index = 0; \
ret->length = initial_capacity; \
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 ""
src/env.cpp
+7 -8
View File
@@ -1,5 +1,5 @@
void define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) {
proc define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) -> void {
// NOTE(Felix): right now we are simply adding the symol at the
// back of the list without checking if it already exists but are
// also searching for thesymbol from the back, so we will find the
@@ -16,16 +16,14 @@ void define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) {
++env->next_index;
}
void print_environment(Environment* env);
Lisp_Object* lookup_symbol_in_this_envt(Symbol* sym, Environment* env) {
proc lookup_symbol_in_this_envt(Symbol* sym, Environment* env) -> Lisp_Object* {
for (int i = env->next_index - 1; i >= 0; --i)
if (string_equal(env->keys[i], sym->identifier))
return env->values[i];
return nullptr;
}
Lisp_Object* lookup_symbol(Lisp_Object* node, Environment* env) {
proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
// first check current environment
Symbol* sym = node->value.symbol;
Lisp_Object* result;
@@ -51,13 +49,14 @@ Lisp_Object* lookup_symbol(Lisp_Object* node, Environment* env) {
printf("%s\n", sym->identifier);
return nullptr;
}
void print_indent(int indent) {
proc print_indent(int indent) -> void {
for (int i = 0; i < indent; ++i) {
printf(" ");
}
}
void print_environment_indent(Environment* env, int indent) {
proc print_environment_indent(Environment* env, int indent) -> void {
for (int i = 0; i < env->next_index; ++i) {
print_indent(indent);
print(env->values[i]);
@@ -72,7 +71,7 @@ void print_environment_indent(Environment* env, int indent) {
}
}
void print_environment(Environment* env) {
proc print_environment(Environment* env) -> void {
printf("\n=== Environment ===\n");
print_environment_indent(env, 0);
}
src/error.cpp
+7 -5
View File
@@ -1,21 +1,23 @@
Error* error;
void delete_error() {
proc delete_error() -> void {
if (error) {
free(error);
error = nullptr;
}
}
void create_error(Error_Type type, Source_Code_Location* location) {
proc create_error(Error_Type type, Source_Code_Location* location) -> void {
delete_error();
__debugbreak();
if_debug {
__debugbreak();
}
error = new(Error);
error->type = type;
error->location = location;
}
char* Error_Type_to_string(Error_Type type) {
proc Error_Type_to_string(Error_Type type) -> char* {
switch (type) {
case Error_Type::Ill_Formed_Arguments: return "Evaluation-error: Ill formed arguments";
case Error_Type::Ill_Formed_Lambda_List: return "Evaluation-error: Ill formed lambda list";
@@ -35,7 +37,7 @@ char* Error_Type_to_string(Error_Type type) {
}
}
void assert_type(Lisp_Object* node, Lisp_Object_Type type) {
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;
src/eval.cpp
+77 -13
View File
@@ -1,6 +1,4 @@
Lisp_Object* eval_expr(Lisp_Object*, Environment*);
Lisp_Object* apply_arguments_to_function(Lisp_Object* arguments, Function* function) {
proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> Lisp_Object* {
Environment* new_env = Memory::create_child_environment(function->parent_environment);
// positional arguments
@@ -22,7 +20,7 @@ Lisp_Object* apply_arguments_to_function(Lisp_Object* arguments, Function* funct
String_Array_List* read_in_keywords = create_String_array_list(16);
if (arguments->type == Lisp_Object_Type::Nil)
if (arguments->type == Lisp_Object_Type::Nil)
goto checks;
// keyword arguments: use all given ones and keep track of the
// added ones (array list), if end of parameters in encountered or
@@ -162,7 +160,7 @@ Lisp_Object* apply_arguments_to_function(Lisp_Object* arguments, Function* funct
positional_arguments, keyword_arguments and rest_argument and
filling it in
*/
void parse_argument_list(Lisp_Object* arguments, Function* function) {
proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
// first init the fields
function->positional_arguments = create_positional_argument_list(16);
function->keyword_arguments = create_keyword_argument_list(16);
@@ -288,7 +286,7 @@ void parse_argument_list(Lisp_Object* arguments, Function* function) {
}
int list_length(Lisp_Object* node) {
proc list_length(Lisp_Object* node) -> int {
if (node->type == Lisp_Object_Type::Nil)
return 0;
@@ -309,9 +307,7 @@ int list_length(Lisp_Object* node) {
return 0;
}
bool is_truthy (Lisp_Object* expression, Environment* env);
Lisp_Object* extract_keyword_value(char* keyword, Parsed_Arguments* args) {
proc extract_keyword_value(char* keyword, Parsed_Arguments* args) -> Lisp_Object* {
// NOTE(Felix): This will be a hashmap lookup later
for (int i = 0; i < args->keyword_keys->next_index; ++i) {
if (string_equal(args->keyword_keys->data[i]->value.keyword->identifier, keyword))
@@ -320,7 +316,7 @@ Lisp_Object* extract_keyword_value(char* keyword, Parsed_Arguments* args) {
return nullptr;
}
Lisp_Object* eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length) {
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) {
return arguments;
@@ -351,7 +347,7 @@ Lisp_Object* eval_arguments(Lisp_Object* arguments, Environment* env, int *out_a
return evaluated_arguments;
}
Lisp_Object* eval_expr(Lisp_Object* node, Environment* env) {
proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
#define report_error(_type) { \
create_error(_type, node->sourceCodeLocation); \
return nullptr; \
@@ -420,7 +416,7 @@ Lisp_Object* eval_expr(Lisp_Object* node, Environment* env) {
#undef report_error
}
bool is_truthy (Lisp_Object* expression, Environment* env) {
proc is_truthy (Lisp_Object* expression, Environment* env) -> bool {
Lisp_Object* result;
try {
result = eval_expr(expression, env);
@@ -428,5 +424,73 @@ bool is_truthy (Lisp_Object* expression, Environment* env) {
if (result->type == Lisp_Object_Type::Nil)
return false;
return true;
}
proc interprete_file (char* file_name) -> Lisp_Object* {
Memory::init();
Environment* env = Memory::create_empty_environment();
Parser::init(env);
char* file_content = read_entire_file(file_name);
if (!file_content) {
create_error(Error_Type::Unknown_Error, nullptr);
}
load_built_ins_into_environment(env);
try {
built_in_load("pre.slime", env);
}
Lisp_Object_Array_List* program;
try {
program = Parser::parse_program(file_name, file_content);
}
Lisp_Object* result = Memory::create_lisp_object_nil();
for (int i = 0; i < program->next_index; ++i) {
try {
result = eval_expr(program->data[i], env);
}
}
return result;
}
proc interprete_stdin() -> void {
Memory::init();
Environment* env = Memory::create_built_ins_environment();
Parser::init(env);
printf("Welcome to the lispy interpreter.\n");
char* line;
built_in_load("pre.slime", env);
built_in_load("test.slime", env);
if (error) {
log_error();
delete_error();
}
Lisp_Object* parsed, * evaluated;
while (true) {
printf(">");
line = read_expression();
parsed = Parser::parse_single_expression(line);
if (error) {
log_error();
delete_error();
continue;
}
evaluated = eval_expr(parsed, env);
if (error) {
log_error();
delete_error();
continue;
}
print(evaluated);
printf("\n");
}
}
src/forward_decls.cpp
+7 -6
View File
@@ -1,6 +1,7 @@
Lisp_Object* eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length);
Lisp_Object* eval_expr(Lisp_Object*, Environment*);
bool is_truthy (Lisp_Object* expression, Environment* env);
int list_length(Lisp_Object*);
void load_built_ins_into_environment(Environment*);
void parse_argument_list(Lisp_Object*, Function*);
proc print_environment(Environment* env) -> void;
proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length) -> Lisp_Object*;
proc eval_expr(Lisp_Object*, Environment*) -> Lisp_Object*;
proc is_truthy (Lisp_Object* expression, Environment* env) -> bool;
proc list_length(Lisp_Object*) -> int;
proc load_built_ins_into_environment(Environment*) -> void;
proc parse_argument_list(Lisp_Object*, Function*) -> void;
src/helpers.cpp
-313
View File
@@ -1,313 +0,0 @@
#define new(type) new type
#ifdef _DEBUG
constexpr bool is_debug_build = true;
#else
constexpr bool is_debug_build = false;
#endif
#define if_debug if constexpr (is_debug_build)
#define assert(cond) \
if_debug { \
if (!cond) { \
printf("Assertion failed: %s %d", __FILE__, __LINE__); \
__debugbreak(); \
} \
} else {} \
#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; \
} \
else label(body,__LINE__):
#define try_void \
if (1) \
goto label(body,__LINE__); \
else \
while (1) \
if (1) { \
if(error) return; \
break; \
} \
else label(body,__LINE__):
#define define_array_list(type, name) \
struct name##_Array_List { \
type* data; \
int length; \
int next_index; \
}; \
\
\
void append_to_##name##_array_list(name##_Array_List* arraylist, type element) { \
if (arraylist->next_index == arraylist->length) { \
arraylist->length *= 2; \
arraylist->data = \
(type*)realloc(arraylist->data, arraylist->length * sizeof(type)); \
} \
arraylist->data[arraylist->next_index++] = element; \
} \
\
\
name##_Array_List* create_##name##_array_list(int initial_capacity = 16) { \
name##_Array_List* ret = new(name##_Array_List); \
ret->data = (type*)malloc(initial_capacity * sizeof(type)); \
ret->next_index = 0; \
ret->length = initial_capacity; \
return ret; \
}
int string_equal(char input[],char check[])
{
int i,result=1;
for(i=0; input[i]!='\0' || check[i]!='\0'; i++) {
if(input[i] != check[i]) {
result=0;
break;
}
}
return result;
}
// asprintf implementation
int _vscprintf_so(const char * format, va_list pargs) {
int retval;
va_list argcopy;
va_copy(argcopy, pargs);
retval = vsnprintf(nullptr, 0, format, argcopy);
va_end(argcopy);
return retval;
}
int vasprintf(char **strp, const char *fmt, va_list ap) {
int len = _vscprintf_so(fmt, ap);
if (len == -1) return -1;
char *str = (char *)malloc((size_t) len + 1);
if (!str) return -1;
int r = vsnprintf(str, len + 1, fmt, ap); /* "secure" version of vsprintf */
if (r == -1) return free(str), -1;
*strp = str;
return r;
}
int asprintf(char *strp[], const char *fmt, ...) {
va_list ap;
va_start(ap, fmt);
int r = vasprintf(strp, fmt, ap);
va_end(ap);
return r;
}
// asprintf implementation end
static char get_nibble(char c) {
if (c >= 'A' && c <= 'F')
return (c - 'a') + 10;
else if (c >= 'a' && c <= 'f')
return (c - 'A') + 10;
return (c - '0');
}
bool unescape_string(char* in) {
if (!in)
return true;
char *out = in, *p = in;
const char *int_err = nullptr;
while (*p && !int_err) {
if (*p != '\\') {
/* normal case */
*out++ = *p++;
} else {
/* escape sequence */
switch (*++p) {
case 'a': *out++ = '\a'; ++p; break;
case 'b': *out++ = '\b'; ++p; break;
case 'f': *out++ = '\f'; ++p; break;
case 'n': *out++ = '\n'; ++p; break;
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;
default:
int_err = "Unexpected '\\' with no escape sequence.";
break;
}
}
}
/* Set the end of string. */
*out = '\0';
if (int_err)
return false;
return true;
}
char* read_entire_file (char* filename) {
char *fileContent = nullptr;
FILE *fp = fopen(filename, "r");
if (fp) {
/* Go to the end of the file. */
if (fseek(fp, 0L, SEEK_END) == 0) {
/* Get the size of the file. */
long bufsize = ftell(fp);
if (bufsize == -1) {
fputs("Empty file", stderr);
goto closeFile;
}
/* Go back to the start of the file. */
if (fseek(fp, 0L, SEEK_SET) != 0) {
fputs("Error reading file", stderr);
goto closeFile;
}
/* Allocate our buffer to that size. */
fileContent = (char*)calloc(bufsize, sizeof(char));
/* Read the entire file into memory. */
size_t newLen = fread(fileContent, sizeof(char), bufsize, fp);
fileContent[newLen] = '\0';
if ( ferror( fp ) != 0 ) {
fputs("Error reading file", stderr);
}
}
closeFile:
fclose(fp);
}
return fileContent;
/* Don't forget to call free() later! */
}
char* read_expression() {
char* line = (char*)malloc(100), * linep = line;
size_t lenmax = 100, len = lenmax;
int c;
int nesting = 0;
if(line == NULL)
return NULL;
for(;;) {
c = fgetc(stdin);
if(c == EOF)
break;
if(--len == 0) {
len = lenmax;
char * linen = (char*)realloc(linep, lenmax *= 2);
if(linen == NULL) {
free(linep);
return NULL;
}
line = linen + (line - linep);
linep = linen;
}
*line++;
if((*line = (char)c) == '(')
++nesting;
else if((*line = (char)c) == ')')
--nesting;
else if((*line = (char)c) == '\n')
if (nesting == 0)
break;
}
(*line)--; // we dont want the \n actually
*line = '\0';
// BUG(Felix): Why do we have to add 1 here?
return linep + 1;
}
char* read_line() {
char* line = (char*)malloc(100), * linep = line;
size_t lenmax = 100, len = lenmax;
int c;
int nesting = 0;
if(line == NULL)
return NULL;
for(;;) {
c = fgetc(stdin);
if(c == EOF)
break;
if(--len == 0) {
len = lenmax;
char* linen = (char*)realloc(linep, lenmax *= 2);
if(linen == NULL) {
free(linep);
return NULL;
}
line = linen + (line - linep);
linep = linen;
}
*line++;
if((*line = (char)c) == '(')
++nesting;
else if((*line = (char)c) == ')')
--nesting;
else if((*line = (char)c) == '\n')
if (nesting == 0)
break;
}
(*line)--; // we dont want the \n actually
*line = '\0';
// BUG(Felix): Why do we have to add 1 here?
return linep + 1;
}
struct Source_Code_Location {
char* file;
int line;
int column;
};
Source_Code_Location* create_source_code_location(char* file, int line, int col) {
if (!file)
return nullptr;
Source_Code_Location* ret = new(Source_Code_Location);
ret->file = file;
ret->line = line;
ret->column = col;
return ret;
}
src/io.cpp
+196 -14
View File
@@ -1,16 +1,198 @@
// #define console_normal "\x1B[0m"
// #define console_red "\x1B[31m"
// #define console_green "\x1B[32m"
// #define console_cyan "\x1B[36m"
proc string_equal(char input[],char check[]) -> bool {
int i;
for(i = 0; input[i] != '\0' || check[i] != '\0'; i++) {
if(input[i] != check[i]) {
return false;
}
}
return true;
}
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;
return (c - '0');
}
proc unescape_string(char* in) -> bool {
if (!in)
return true;
char *out = in, *p = in;
const char *int_err = nullptr;
while (*p && !int_err) {
if (*p != '\\') {
/* normal case */
*out++ = *p++;
} else {
/* escape sequence */
switch (*++p) {
case 'a': *out++ = '\a'; ++p; break;
case 'b': *out++ = '\b'; ++p; break;
case 'f': *out++ = '\f'; ++p; break;
case 'n': *out++ = '\n'; ++p; break;
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;
default:
int_err = "Unexpected '\\' with no escape sequence.";
break;
}
}
}
/* Set the end of string. */
*out = '\0';
if (int_err)
return false;
return true;
}
proc read_entire_file (char* filename) -> char* {
char *fileContent = nullptr;
FILE *fp = fopen(filename, "r");
if (fp) {
/* Go to the end of the file. */
if (fseek(fp, 0L, SEEK_END) == 0) {
/* Get the size of the file. */
long bufsize = ftell(fp);
if (bufsize == -1) {
fputs("Empty file", stderr);
goto closeFile;
}
/* Go back to the start of the file. */
if (fseek(fp, 0L, SEEK_SET) != 0) {
fputs("Error reading file", stderr);
goto closeFile;
}
/* Allocate our buffer to that size. */
fileContent = (char*)calloc(bufsize, sizeof(char));
/* Read the entire file into memory. */
size_t newLen = fread(fileContent, sizeof(char), bufsize, fp);
fileContent[newLen] = '\0';
if ( ferror( fp ) != 0 ) {
fputs("Error reading file", stderr);
}
}
closeFile:
fclose(fp);
}
return fileContent;
/* Don't forget to call free() later! */
}
proc read_expression() -> char* {
char* line = (char*)malloc(100), * linep = line;
size_t lenmax = 100, len = lenmax;
int c;
int nesting = 0;
if(line == NULL)
return NULL;
for(;;) {
c = fgetc(stdin);
if(c == EOF)
break;
if(--len == 0) {
len = lenmax;
char * linen = (char*)realloc(linep, lenmax *= 2);
if(linen == NULL) {
free(linep);
return NULL;
}
line = linen + (line - linep);
linep = linen;
}
*line++;
if((*line = (char)c) == '(')
++nesting;
else if((*line = (char)c) == ')')
--nesting;
else if((*line = (char)c) == '\n')
if (nesting == 0)
break;
}
(*line)--; // we dont want the \n actually
*line = '\0';
// BUG(Felix): Why do we have to add 1 here?
return linep + 1;
}
proc read_line() -> char* {
char* line = (char*)malloc(100), * linep = line;
size_t lenmax = 100, len = lenmax;
int c;
int nesting = 0;
if(line == NULL)
return NULL;
for(;;) {
c = fgetc(stdin);
if(c == EOF)
break;
if(--len == 0) {
len = lenmax;
char* linen = (char*)realloc(linep, lenmax *= 2);
if(linen == NULL) {
free(linep);
return NULL;
}
line = linen + (line - linep);
linep = linen;
}
*line++;
if((*line = (char)c) == '(')
++nesting;
else if((*line = (char)c) == ')')
--nesting;
else if((*line = (char)c) == '\n')
if (nesting == 0)
break;
}
(*line)--; // we dont want the \n actually
*line = '\0';
// BUG(Felix): Why do we have to add 1 here?
return linep + 1;
}
#define console_normal ""
#define console_red ""
#define console_green ""
#define console_cyan ""
Log_Level log_level = Log_Level::Debug;
void log_message(Log_Level type, char* message) {
proc log_message(Log_Level type, char* message) -> void {
if (type > log_level)
return;
@@ -25,12 +207,12 @@ void log_message(Log_Level type, char* message) {
printf("%s: %s\n",prefix, message);
}
void panic(char* message) {
proc panic(char* message) -> void {
log_message(Log_Level::Critical, message);
exit(1);
}
void print(Lisp_Object* node) {
proc print(Lisp_Object* node) -> void {
switch (node->type) {
case (Lisp_Object_Type::Nil): {
printf("nil");
@@ -91,7 +273,7 @@ void print(Lisp_Object* node) {
}
// XXX(Felix): obv code dublicate
void fprint(FILE* f, Lisp_Object* node) {
proc fprint(FILE* f, Lisp_Object* node) -> void {
switch (node->type) {
case (Lisp_Object_Type::Nil): {
fprintf(f, "nil");
@@ -151,7 +333,7 @@ void fprint(FILE* f, Lisp_Object* node) {
}
}
void print_error_location() {
proc print_error_location() -> void {
if (error->location) {
printf("%s (line %d, position %d)",
error->location->file,
@@ -162,7 +344,7 @@ void print_error_location() {
}
}
void log_error() {
proc log_error() -> void {
printf("%s%s%s\n", console_red,
Error_Type_to_string(error->type),
console_normal);
src/lisp_object.cpp
+17 -6
View File
@@ -1,4 +1,15 @@
char* Lisp_Object_Type_to_string(Lisp_Object_Type type) {
proc create_source_code_location(char* file, int line, int col) -> Source_Code_Location* {
if (!file)
return nullptr;
Source_Code_Location* ret = new(Source_Code_Location);
ret->file = file;
ret->line = line;
ret->column = col;
return ret;
}
proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> char* {
switch (type) {
case(Lisp_Object_Type::Nil): return "nil";
case(Lisp_Object_Type::T): return "t";
@@ -13,7 +24,7 @@ char* Lisp_Object_Type_to_string(Lisp_Object_Type type) {
return "unknown";
}
Positional_Arguments* create_positional_argument_list(int initial_capacity) {
proc create_positional_argument_list(int initial_capacity) -> Positional_Arguments* {
Positional_Arguments* ret = new(Positional_Arguments);
ret->identifiers = (char**)malloc(initial_capacity * sizeof(char*));
ret->next_index = 0;
@@ -21,7 +32,7 @@ Positional_Arguments* create_positional_argument_list(int initial_capacity) {
return ret;
}
void append_to_positional_argument_list(Positional_Arguments* args, char* identifier) {
proc append_to_positional_argument_list(Positional_Arguments* args, char* identifier) -> void {
if (args->next_index == args->length) {
args->length *= 2;
args->identifiers = (char**)realloc(args->identifiers, args->length * sizeof(char*));
@@ -29,7 +40,7 @@ void append_to_positional_argument_list(Positional_Arguments* args, char* identi
args->identifiers[args->next_index++] = identifier;
}
Keyword_Arguments* create_keyword_argument_list(int initial_capacity) {
proc create_keyword_argument_list(int initial_capacity) -> Keyword_Arguments* {
Keyword_Arguments* ret = new(Keyword_Arguments);
ret->identifiers = (char**)malloc(initial_capacity * sizeof(char*));
ret->values = create_Lisp_Object_array_list(initial_capacity);
@@ -38,9 +49,9 @@ Keyword_Arguments* create_keyword_argument_list(int initial_capacity) {
return ret;
}
void append_to_keyword_argument_list(Keyword_Arguments* args,
proc append_to_keyword_argument_list(Keyword_Arguments* args,
char* identifier,
struct Lisp_Object* default_value)
struct Lisp_Object* default_value) -> void
{
if (args->next_index == args->length) {
args->length *= 2;
src/main.cpp
+3 -94
View File
@@ -1,97 +1,6 @@
#pragma once
#define _CRT_SECURE_NO_DEPRECATE
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <stdarg.h> /* needed for va_list */
#include <ctype.h>
#include <math.h>
#include <functional>
#include "slime.h"
#include "./helpers.cpp"
#include "./structs.cpp"
#include "./forward_decls.cpp"
#include "./lisp_object.cpp"
#include "./error.cpp"
#include "./io.cpp"
#include "./memory.cpp"
#include "./env.cpp"
#include "./parse.cpp"
#include "./built_ins.cpp"
#include "./eval.cpp"
#include "./testing.cpp"
Lisp_Object* interprete_file (char* file_name) {
Memory::init();
Environment* env = Memory::create_empty_environment();
Parser::init(env);
char* file_content = read_entire_file(file_name);
if (!file_content) {
create_error(Error_Type::Unknown_Error, nullptr);
}
load_built_ins_into_environment(env);
try {
built_in_load("pre.slime", env);
}
Lisp_Object_Array_List* program;
try {
program = Parser::parse_program(file_name, file_content);
}
Lisp_Object* result = Memory::create_lisp_object_nil();
for (int i = 0; i < program->next_index; ++i) {
try {
result = eval_expr(program->data[i], env);
}
}
return result;
}
int interprete_stdin () {
Memory::init();
Environment* env = Memory::create_built_ins_environment();
Parser::init(env);
printf("Welcome to the lispy interpreter.\n");
char* line;
built_in_load("pre.slime", env);
built_in_load("test.slime", env);
if (error) {
log_error();
delete_error();
}
Lisp_Object* parsed, * evaluated;
while (true) {
printf(">");
line = read_expression();
parsed = Parser::parse_single_expression(line);
if (error) {
log_error();
delete_error();
continue;
}
evaluated = eval_expr(parsed, env);
if (error) {
log_error();
delete_error();
continue;
}
print(evaluated);
printf("\n");
}
return 0;
}
int main (int argc, char *argv[]) {
int main(int argc, char* argv[]) {
if (argc > 1) {
interprete_file(argv[1]);
if (error) {
@@ -99,7 +8,7 @@ int main (int argc, char *argv[]) {
return 1;
}
} else {
// run_all_tests();
run_all_tests();
return interprete_stdin();
}
}
src/memory.cpp
+16 -18
View File
@@ -5,13 +5,13 @@ namespace Memory {
Lisp_Object* memory;
int nextFreeSpot = 0;
void init() {
proc init() -> void {
memory = (Lisp_Object*)malloc(maxLispObjects * sizeof(Lisp_Object));
freeSpots = create_Int_array_list();
}
void print_status() {
printf("Memory Status:\n"
proc print_status() -> void {
printf("Memory Status:\n"
" - %f%% of the memory is used\n"
" - %d of %d total Lisp_Objects are in use\n"
" - %d holes in used memory (fragmentation)\n",
@@ -20,7 +20,7 @@ namespace Memory {
freeSpots->next_index);
}
Lisp_Object* create_lisp_object() {
proc create_lisp_object() -> Lisp_Object* {
int index;
// if we have no free spots then append at the end
if (freeSpots->next_index == 0) {
@@ -39,21 +39,21 @@ namespace Memory {
return object;
}
Lisp_Object* create_lisp_object_nil() {
proc create_lisp_object_nil() -> Lisp_Object* {
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::Nil;
node->value.pair = nullptr;
return node;
}
Lisp_Object* create_lisp_object_t() {
proc create_lisp_object_t() -> Lisp_Object* {
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::T;
node->value.pair = nullptr;
return node;
}
Lisp_Object* create_lisp_object_number(double number) {
proc create_lisp_object_number(double number) -> Lisp_Object* {
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::Number;
node->value.number = new(Number);
@@ -61,7 +61,7 @@ namespace Memory {
return node;
}
Lisp_Object* create_lisp_object_string(char* str, int length) {
proc create_lisp_object_string(char* str, int length) -> Lisp_Object* {
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::String;
node->value.string = new(String);
@@ -70,7 +70,7 @@ namespace Memory {
return node;
}
Lisp_Object* create_lisp_object_symbol(char* identifier) {
proc create_lisp_object_symbol(char* identifier) -> Lisp_Object* {
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::Symbol;
node->value.symbol = new(Symbol);
@@ -78,7 +78,7 @@ namespace Memory {
return node;
}
Lisp_Object* create_lisp_object_keyword(char* keyword) {
proc create_lisp_object_keyword(char* keyword) -> Lisp_Object* {
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::Keyword;
node->value.keyword = new(Keyword);
@@ -86,7 +86,7 @@ namespace Memory {
return node;
}
Lisp_Object* create_lisp_object_cfunction(std::function<Lisp_Object*(Lisp_Object*, Environment*)> function) {
proc create_lisp_object_cfunction(std::function<Lisp_Object*(Lisp_Object*, Environment*)> function) -> Lisp_Object* {
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::CFunction;
node->value.cfunction = new(CFunction);
@@ -94,7 +94,7 @@ namespace Memory {
return node;
}
Lisp_Object* create_lisp_object_pair(Lisp_Object* first, Lisp_Object* rest) {
proc create_lisp_object_pair(Lisp_Object* first, Lisp_Object* rest) -> Lisp_Object* {
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::Pair;
node->value.pair = new(Pair);
@@ -103,15 +103,13 @@ namespace Memory {
return node;
}
Lisp_Object* copy_lisp_object(Lisp_Object* n) {
proc copy_lisp_object(Lisp_Object* n) -> Lisp_Object* {
Lisp_Object* target = create_lisp_object();
*target = *n;
return target;
}
// environments
Environment* create_child_environment(Environment* parent) {
proc create_child_environment(Environment* parent) -> Environment* {
Environment* env = new(Environment);
int start_capacity = 16;
@@ -125,11 +123,11 @@ namespace Memory {
return env;
}
Environment* create_empty_environment() {
proc create_empty_environment() -> Environment* {
return create_child_environment(nullptr);
}
Environment* create_built_ins_environment() {
proc create_built_ins_environment() -> Environment* {
Environment* ret = create_child_environment(nullptr);
load_built_ins_into_environment(ret);
return ret;
src/slime.h
+20
View File
@@ -0,0 +1,20 @@
#pragma once
#define _CRT_SECURE_NO_DEPRECATE
#include <functional>
#include "./defines.cpp"
#include "./structs.cpp"
#include "./forward_decls.cpp"
#include "./lisp_object.cpp"
#include "./error.cpp"
#include "./io.cpp"
#include "./memory.cpp"
#include "./env.cpp"
#include "./parse.cpp"
#include "./built_ins.cpp"
#include "./eval.cpp"
#include "./testing.cpp"
#include "./undefines.cpp"
#undef _CRT_SECURE_NO_DEPRECATE
src/structs.cpp
+30 -24
View File
@@ -17,6 +17,30 @@ enum struct Lisp_Object_Type {
CFunction,
};
enum struct Function_Type {
Lambda,
Special_Lambda,
Macro
};
enum struct Error_Type {
Ill_Formed_Arguments,
Ill_Formed_Lambda_List,
Ill_Formed_List,
Not_A_Function,
Not_Yet_Implemented,
Symbol_Not_Defined,
Syntax_Error,
Trailing_Garbage,
Type_Missmatch,
Unbalanced_Parenthesis,
Unexpected_Eof,
Unknown_Error,
Unknown_Keyword_Argument,
Wrong_Number_Of_Arguments,
Out_Of_Memory,
};
enum struct Log_Level {
None,
Critical,
@@ -25,6 +49,12 @@ enum struct Log_Level {
Debug,
};
struct Source_Code_Location {
char* file;
int line;
int column;
};
struct Symbol {
char* identifier;
};
@@ -64,12 +94,6 @@ struct Keyword_Arguments {
int length;
};
enum struct Function_Type {
Lambda,
Special_Lambda,
Macro
};
struct Function {
Function_Type type;
char* docstring;
@@ -118,24 +142,6 @@ struct Environment {
Lisp_Object** values;
};
enum struct Error_Type {
Ill_Formed_Arguments,
Ill_Formed_Lambda_List,
Ill_Formed_List,
Not_A_Function,
Not_Yet_Implemented,
Symbol_Not_Defined,
Syntax_Error,
Trailing_Garbage,
Type_Missmatch,
Unbalanced_Parenthesis,
Unexpected_Eof,
Unknown_Error,
Unknown_Keyword_Argument,
Wrong_Number_Of_Arguments,
Out_Of_Memory,
};
struct Error {
Error_Type type;
Source_Code_Location* location;
src/testing.cpp
+30 -13
View File
@@ -85,7 +85,7 @@
} \
} \
testresult test_eval_operands() {
proc test_eval_operands() -> testresult {
char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))";
Lisp_Object* operands = Parser::parse_single_expression(operands_string);
int operands_length;
@@ -119,7 +119,7 @@ testresult test_eval_operands() {
return pass;
}
testresult test_parse_atom() {
proc test_parse_atom() -> testresult {
int index_in_text = 0;
char string[] =
"123 -1.23e-2 " // numbers
@@ -175,7 +175,7 @@ testresult test_parse_atom() {
return pass;
}
testresult test_parse_expression() {
proc test_parse_expression() -> testresult {
int index_in_text = 0;
char string[] = "(fun + 12)";
@@ -230,7 +230,7 @@ testresult test_parse_expression() {
return pass;
}
testresult test_built_in_add() {
proc test_built_in_add() -> testresult {
char exp_string[] = "(+ 10 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
@@ -243,7 +243,7 @@ testresult test_built_in_add() {
return pass;
}
testresult test_built_in_substract() {
proc test_built_in_substract() -> testresult {
char exp_string[] = "(- 10 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
@@ -257,7 +257,7 @@ testresult test_built_in_substract() {
}
testresult test_built_in_multiply() {
proc test_built_in_multiply() -> testresult {
char exp_string[] = "(* 10 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
@@ -271,7 +271,7 @@ testresult test_built_in_multiply() {
}
testresult test_built_in_divide() {
proc test_built_in_divide() -> testresult {
char exp_string[] = "(/ 20 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
@@ -285,7 +285,7 @@ testresult test_built_in_divide() {
}
testresult test_built_in_if() {
proc test_built_in_if() -> testresult {
char exp_string1[] = "(if 1 4 5)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
@@ -307,7 +307,7 @@ testresult test_built_in_if() {
return pass;
}
testresult test_built_in_and() {
proc test_built_in_and() -> testresult {
char exp_string1[] = "(and 1 \"asd\" 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
@@ -328,7 +328,7 @@ testresult test_built_in_and() {
return pass;
}
testresult test_built_in_or() {
proc test_built_in_or() -> testresult {
char exp_string1[] = "(or \"asd\" nil)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
@@ -350,7 +350,7 @@ testresult test_built_in_or() {
}
testresult test_built_in_not() {
proc test_built_in_not() -> testresult {
char exp_string1[] = "(not ())";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment());
@@ -372,7 +372,7 @@ testresult test_built_in_not() {
return pass;
}
void run_all_tests() {
proc run_all_tests() -> void {
log_level = Log_Level::None;
Memory::init();
Parser::init(Memory::create_built_ins_environment());
@@ -393,5 +393,22 @@ void run_all_tests() {
invoke_test(test_built_in_and);
invoke_test(test_built_in_or);
invoke_test(test_built_in_not);
}
#undef epsilon
#undef testresult
#undef pass
#undef fail
#undef print_assert_equal_fail
#undef print_assert_not_equal_fail
#undef assert_no_error
#undef assert_equal_int
#undef assert_not_equal_int
#undef assert_equal_double
#undef assert_not_equal_double
#undef assert_equal_string
#undef assert_equal_type
#undef assert_null
#undef assert_not_null
#undef invoke_test
src/undefines.cpp
+17
View File
@@ -0,0 +1,17 @@
#undef new
#undef proc
#undef if_debug
#undef assert
#undef concat_
#undef label
#undef try
#undef try_void
#undef define_array_list
#undef console_normal
#undef console_red
#undef console_green
#undef console_cyan