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

Fixed Memory Leaks. :)

Browse Source
This commit is contained in:
Felix Brendel
2019-11-10 00:50:09 +01:00
parent a790a38655
commit bb1cfcd3c3
19 changed files with 199 additions and 173 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/built_ins.cpp
+29 -49
View File
@@ -83,6 +83,7 @@ proc built_in_load(String* file_name) -> Lisp_Object* {
try result = eval_expr(program->data[i]);
}
delete program;
free(file_content);
return result;
}
@@ -315,18 +316,6 @@ proc load_built_ins_into_environment() -> void {
define_special((define-syntax form (:doc "") . body), "TODO") {
fetch(form, doc, body);
// static Lisp_Object *form_symbol = Memory::get_or_create_lisp_object_symbol("form");
// static Lisp_Object *doc_symbol = Memory::get_or_create_lisp_object_symbol("doc");
// static Lisp_Object *body_symbol = Memory::get_or_create_lisp_object_symbol("body");
// printf("\n\nin define-syntax:: envi stack depth: %d\n",
// Globals::Current_Execution::envi_stack.next_index);
// print_environment(get_current_environment());
// Lisp_Object *form = lookup_symbol(form_symbol, get_current_environment());
// Lisp_Object *doc = lookup_symbol(doc_symbol, get_current_environment());
// Lisp_Object *body = lookup_symbol(body_symbol, get_current_environment());
try assert_type(doc, Lisp_Object_Type::String);
// if no doc string, we dont have to store it
if (Memory::get_c_str(doc)[0] == '\0') {
@@ -343,20 +332,19 @@ proc load_built_ins_into_environment() -> void {
// creating new lisp object and setting type
Lisp_Object* func;
try func = Memory::create_lisp_object();
Memory::set_type(func, Lisp_Object_Type::Function);
func->value.function.type = Function_Type::Macro;
new((&func->value.function.args.positional.symbols)) Array_List<Environment*>(16);
new((&func->value.function.args.keyword.keywords)) Array_List<Environment*>(16);
new((&func->value.function.args.keyword.values)) Array_List<Environment*>(16);
try func = Memory::create_lisp_object_function(Function_Type::Macro);
// Lisp_Object* func;
// try func = Memory::create_lisp_object();
// Memory::set_type(func, Lisp_Object_Type::Function);
// func->value.function->type = Function_Type::Macro;
if (doc) func->docstring = doc->value.string;
in_caller_env {
// setting parent env
func->value.function.parent_environment = get_current_environment();
func->value.function->parent_environment = get_current_environment();
create_arguments_from_lambda_list_and_inject(lambdalist, func);
func->value.function.body = maybe_wrap_body_in_begin(body);
func->value.function->body = maybe_wrap_body_in_begin(body);
define_symbol(symbol, func);
}
return Memory::nil;
@@ -394,21 +382,16 @@ proc load_built_ins_into_environment() -> void {
// creating new lisp object and setting type
Lisp_Object* func;
try func = Memory::create_lisp_object();
Memory::set_type(func, Lisp_Object_Type::Function);
func->value.function.type = Function_Type::Lambda;
new((&func->value.function.args.positional.symbols)) Array_List<Environment*>(16);
new((&func->value.function.args.keyword.keywords)) Array_List<Environment*>(16);
new((&func->value.function.args.keyword.values)) Array_List<Environment*>(16);
try func = Memory::create_lisp_object_function(Function_Type::Lambda);
if (doc)
func->docstring = doc->value.string;
in_caller_env {
// setting parent env
func->value.function.parent_environment = get_current_environment();
func->value.function->parent_environment = get_current_environment();
create_arguments_from_lambda_list_and_inject(lambdalist, func);
func->value.function.body = maybe_wrap_body_in_begin(body);
func->value.function->body = maybe_wrap_body_in_begin(body);
define_symbol(symbol, func);
}
@@ -536,12 +519,10 @@ proc load_built_ins_into_environment() -> void {
Lisp_Object* quasiquote_sym = Memory::get_or_create_lisp_object_symbol("quasiquote");
Lisp_Object* unquote_sym = Memory::get_or_create_lisp_object_symbol("unquote");
Lisp_Object* unquote_splicing_sym = Memory::get_or_create_lisp_object_symbol("unquote-splicing");
/* recursive lambdas in lambdas yay!! */
// NOTE(Felix): first we have to initialize the variable
// with a garbage lambda, so that we can then overwrite it
// a recursive lambda
std::function<Lisp_Object*(Lisp_Object*)> unquoteSomeExpressions; // = [] (Lisp_Object* expr) -> Lisp_Object* {return nullptr;};
unquoteSomeExpressions = [&] (Lisp_Object* expr) -> Lisp_Object* {
const auto unquoteSomeExpressions = [&] (const auto & self, Lisp_Object* expr) -> Lisp_Object* {
// if it is an atom, return it
if (Memory::get_type(expr) != Lisp_Object_Type::Pair)
return Memory::copy_lisp_object(expr);
@@ -584,7 +565,7 @@ proc load_built_ins_into_environment() -> void {
if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Pair &&
head->value.pair.first->value.pair.first == unquote_splicing_sym)
{
Lisp_Object* spliced = unquoteSomeExpressions(head->value.pair.first);
Lisp_Object* spliced = self(self, head->value.pair.first);
if (spliced == Memory::nil) {
head = head->value.pair.rest;
@@ -615,7 +596,7 @@ proc load_built_ins_into_environment() -> void {
try newPairHead->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
newPairHead = newPairHead->value.pair.rest;
}
newPairHead->value.pair.first = unquoteSomeExpressions(head->value.pair.first);
newPairHead->value.pair.first = self(self, head->value.pair.first);
}
// if (Memory::get_type(head->value.pair.rest) != Lisp_Object_Type::Pair) {
@@ -630,7 +611,7 @@ proc load_built_ins_into_environment() -> void {
return newPair;
};
expr = unquoteSomeExpressions(expr);
expr = unquoteSomeExpressions(unquoteSomeExpressions, expr);
return expr;
};
define_special((and . args), "TODO") {
@@ -694,18 +675,17 @@ proc load_built_ins_into_environment() -> void {
define_special((lambda args . body), "TODO") {
fetch(args, body);
Lisp_Object* fun;
try fun = Memory::create_lisp_object();
Memory::set_type(fun, Lisp_Object_Type::Function);
fun->value.function.type = Function_Type::Lambda;
// creating new lisp object and setting type
Lisp_Object* func;
try func = Memory::create_lisp_object_function(Function_Type::Lambda);
in_caller_env {
fun->value.function.parent_environment = get_current_environment();
func->value.function->parent_environment = get_current_environment();
}
try create_arguments_from_lambda_list_and_inject(args, fun);
fun->value.function.body = maybe_wrap_body_in_begin(body);
return fun;
try create_arguments_from_lambda_list_and_inject(args, func);
func->value.function->body = maybe_wrap_body_in_begin(body);
return func;
};
// define_special((special-lambda args . body), "TODO") {
// fetch(args, body);
@@ -713,14 +693,14 @@ proc load_built_ins_into_environment() -> void {
// Lisp_Object* fun;
// try fun = Memory::create_lisp_object();
// Memory::set_type(fun, Lisp_Object_Type::Function);
// fun->value.function.type = Function_Type::Special_Lambda;
// fun->value.function->type = Function_Type::Special_Lambda;
// in_caller_env {
// fun->value.function.parent_environment = get_current_environment();
// fun->value.function->parent_environment = get_current_environment();
// }
// try create_arguments_from_lambda_list_and_inject(args, fun);
// fun->value.function.body = maybe_wrap_body_in_begin(body);
// fun->value.function->body = maybe_wrap_body_in_begin(body);
// return fun;
// };
define((apply fun args), "TODO") {
@@ -834,7 +814,7 @@ proc load_built_ins_into_environment() -> void {
case Lisp_Object_Type::Continuation: return Memory::get_or_create_lisp_object_keyword("continuation");
case Lisp_Object_Type::CFunction: return Memory::get_or_create_lisp_object_keyword("cfunction");
case Lisp_Object_Type::Function: {
Function* fun = &n->value.function;
Function* fun = n->value.function;
if (fun->type == Function_Type::Lambda)
return Memory::get_or_create_lisp_object_keyword("lambda");
// else if (fun->type == Function_Type::Special_Lambda)
@@ -892,7 +872,7 @@ proc load_built_ins_into_environment() -> void {
{
Arguments* args;
if (Memory::get_type(val) == Lisp_Object_Type::Function)
args = &val->value.function.args;
args = &val->value.function->args;
else
args = &val->value.cFunction->args;
@@ -941,10 +921,10 @@ proc load_built_ins_into_environment() -> void {
try assert_type(n, Lisp_Object_Type::Function);
puts("body:\n");
print(n->value.function.body);
print(n->value.function->body);
puts("\n");
printf("parent_env: %lld\n",
(long long)n->value.function.parent_environment);
(long long)n->value.function->parent_environment);
return Memory::nil;
};
src/define_macros.hpp
+8 -9
View File
@@ -101,11 +101,14 @@
)(__VA_ARGS__)
#endif
// NOTE(Felix): we have to copy the string because we need
// it to be mutable for the parser to work, because the
// parser relys on being able to temporaily put in markers
// in the code
// NOTE(Felix): we have to copy the string because we need it to be
// mutable for the parser to work, because the parser relys on being
// able to temporaily put in markers in the code and also it will fill
// out the source code location
#define _define_helper(def, docs, special) \
Parser::parser_file = file_name_built_ins; \
Parser::parser_line = __LINE__; \
Parser::parser_col = 0; \
auto label(params,__LINE__) = Parser::parse_single_expression( \
Memory::get_c_str(Memory::create_string(#def))); \
if_error_log_location_and_return(); \
@@ -115,13 +118,9 @@
auto label(sfun,__LINE__) = Memory::create_lisp_object_cfunction(special); \
create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \
if_error_log_location_and_return(); \
label(sfun,__LINE__)->sourceCodeLocation = new(Source_Code_Location); \
label(sfun,__LINE__)->sourceCodeLocation->file = file_name_built_ins; \
label(sfun,__LINE__)->sourceCodeLocation->line = __LINE__; \
label(sfun,__LINE__)->sourceCodeLocation->column = 0; \
label(sfun,__LINE__)->docstring = Memory::create_string(docs); \
define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \
label(sfun,__LINE__)->value.cFunction->body = (std::function<Lisp_Object* ()>)[&]() -> Lisp_Object*
label(sfun,__LINE__)->value.cFunction->body = []() -> Lisp_Object*
#define define(def, docs) _define_helper(def, docs, false)
#define define_special(def, docs) _define_helper(def, docs, true)
src/error.cpp
+1 -1
View File
@@ -30,7 +30,7 @@ proc create_error(const char* c_func_name,const char* c_file_name, int c_file_li
}
// visualize_lisp_machine();
using Globals::error;
error = new(Error);
error = (Error*)malloc(sizeof(Error)) ;
error->type = type;
error->message = message;
src/eval.cpp
+23 -14
View File
@@ -17,8 +17,8 @@ proc create_extended_environment_for_function_application(
new_env = Memory::create_child_environment(get_root_environment());
arg_spec = &function->value.cFunction->args;
} else {
new_env = Memory::create_child_environment(function->value.function.parent_environment);
arg_spec = &function->value.function.args;
new_env = Memory::create_child_environment(function->value.function->parent_environment);
arg_spec = &function->value.function->args;
}
if (should_evaluate) {
try arguments = eval_arguments(arguments);
@@ -51,7 +51,7 @@ proc create_extended_environment_for_function_application(
// NOTE(Felix): We have to copy all the arguments,
// otherwise we change the program code. XXX(Felix): T C
// functions we pass by reference...
try_void sym = arg_spec->positional.symbols.data[i];
sym = arg_spec->positional.symbols.data[i];
if (is_c_function) {
define_symbol(sym, arguments->value.pair.first);
} else {
@@ -240,7 +240,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function,
if (Memory::get_type(function) == Lisp_Object_Type::CFunction)
try result = function->value.cFunction->body();
else // if lisp function
try result = eval_expr(function->value.function.body);
try result = eval_expr(function->value.function->body);
return result;
}
@@ -256,16 +256,14 @@ proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_O
if (Memory::get_type(function) == Lisp_Object_Type::CFunction) {
result = &function->value.cFunction->args;
} else {
result = &function->value.function.args;
result = &function->value.function->args;
}
::new (&result->positional.symbols) Array_List<Lisp_Object*>;
::new (&result->keyword.keywords) Array_List<Lisp_Object*>;
::new (&result->keyword.values) Array_List<Lisp_Object*>;
// ::new (&result->positional.symbols) Array_List<Lisp_Object*>;
// ::new (&result->keyword.keywords) Array_List<Lisp_Object*>;
// ::new (&result->keyword.values) Array_List<Lisp_Object*>;
// first init the fields
// result->positional = create_positional_argument_list(16);
// result->keyword = create_keyword_argument_list(16);
result->rest = nullptr;
// okay let's try to read some positional arguments
@@ -357,6 +355,11 @@ proc list_length(Lisp_Object* node) -> int {
return 0;
}
proc copy_scl(Source_Code_Location*) -> Source_Code_Location* {
// TODO(Felix):
return nullptr;
}
proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* {
profile_this;
// int my_out_arguments_length = 0;
@@ -374,7 +377,8 @@ proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* {
while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first);
evaluated_arguments_head->value.pair.first->sourceCodeLocation = current_head->value.pair.first->sourceCodeLocation;
evaluated_arguments_head->value.pair.first->sourceCodeLocation =
copy_scl(current_head->value.pair.first->sourceCodeLocation);
current_head = current_head->value.pair.rest;
if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
@@ -451,7 +455,7 @@ proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
try result = apply_arguments_to_function(
arguments,
lispOperator,
lispOperator->value.function.type == Function_Type::Lambda);
lispOperator->value.function->type == Function_Type::Lambda);
// NOTE(Felix): The parser does not understnad (import ..)
// so it cannot expand imported macros at read time
@@ -460,15 +464,20 @@ proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
// stray macros fying around, in that case, we expand them
// and bake them in, so they do not have to be expanded
// later again. We will call this "lazy macro expansion"
if (lispOperator->value.function.type == Function_Type::Macro) {
if (lispOperator->value.function->type == Function_Type::Macro) {
// bake in the macro expansion:
*node = *result;
*node = *Memory::copy_lisp_object(result);
result->sourceCodeLocation = copy_scl(result->sourceCodeLocation);
// eval again because macro
try result = eval_expr(result);
}
return result;
}
create_generic_error("The first element of the pair was not a function but: %s",
Lisp_Object_Type_to_string(Memory::get_type(lispOperator)));
return nullptr;
}
default: {
create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node)));
src/gc.cpp
+3 -3
View File
@@ -46,10 +46,10 @@ namespace GC {
// NOTE(Felix): We dont have to mark the symbols, keywords
// for parameter names, as symbols and keywords are never
// garbage collected
maybe_mark(node->value.function.parent_environment);
maybe_mark(node->value.function.body);
maybe_mark(node->value.function->parent_environment);
maybe_mark(node->value.function->body);
// mark the default arguemnt values:
for (auto it : node->value.function.args.keyword.values) {
for (auto it : node->value.function->args.keyword.values) {
if (it)
maybe_mark(it);
}
src/io.cpp
+29 -32
View File
@@ -64,9 +64,8 @@ proc escape_string(char* in) -> char* {
return ret;
}
proc unescape_string(char* in) -> bool {
if (!in)
return true;
proc unescape_string(char* in) -> int {
if (!in) return 0;
char *out = in, *p = in;
const char *int_err = nullptr;
@@ -117,9 +116,7 @@ proc unescape_string(char* in) -> bool {
/* Set the end of string. */
*out = '\0';
if (int_err)
return false;
return true;
return out - in;
}
proc read_entire_file(char* filename) -> char* {
@@ -358,11 +355,11 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol.identifier));
break;
}
if (node->value.function.type == Function_Type::Lambda)
if (node->value.function->type == Function_Type::Lambda)
fputs("[lambda]", file);
// else if (node->value.function.type == Function_Type::Special_Lambda)
// else if (node->value.function->type == Function_Type::Special_Lambda)
// fputs("[special-lambda]", file);
else if (node->value.function.type == Function_Type::Macro)
else if (node->value.function->type == Function_Type::Macro)
fputs("[macro]", file);
else
assert(false);
@@ -372,33 +369,33 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
// first check if it is a quotation form, in that case we want
// to print it prettier
if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) {
String* identifier = head->value.pair.first->value.symbol.identifier;
// if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) {
// String* identifier = head->value.pair.first->value.symbol.identifier;
auto symbol = head->value.pair.first;
auto quote_sym = Memory::get_or_create_lisp_object_symbol("quote");
auto unquote_sym = Memory::get_or_create_lisp_object_symbol("unquote");
auto quasiquote_sym = Memory::get_or_create_lisp_object_symbol("quasiquote");
if (symbol == quote_sym || symbol == unquote_sym)
{
putc(symbol == quote_sym
? '\''
: ',', file);
// auto symbol = head->value.pair.first;
// auto quote_sym = Memory::get_or_create_lisp_object_symbol("quote");
// auto unquote_sym = Memory::get_or_create_lisp_object_symbol("unquote");
// auto quasiquote_sym = Memory::get_or_create_lisp_object_symbol("quasiquote");
// if (symbol == quote_sym || symbol == unquote_sym)
// {
// putc(symbol == quote_sym
// ? '\''
// : ',', file);
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
assert(head->value.pair.rest->value.pair.rest == Memory::nil);
// assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
// assert(head->value.pair.rest->value.pair.rest == Memory::nil);
print(head->value.pair.rest->value.pair.first, print_repr, file);
break;
}
else if (symbol == quasiquote_sym) {
putc('`', file);
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
print(head->value.pair.rest->value.pair.first, print_repr, file);
break;
}
}
// print(head->value.pair.rest->value.pair.first, print_repr, file);
// break;
// }
// else if (symbol == quasiquote_sym) {
// putc('`', file);
// assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
// print(head->value.pair.rest->value.pair.first, print_repr, file);
// break;
// }
// }
putc('(', file);
src/libslime.cpp
+4 -3
View File
@@ -3,7 +3,6 @@
#define _CRTDBG_MAP_ALLOC
#include <stdlib.h>
#include <crtdbg.h>
#include <stdio.h>
#include <time.h>
@@ -11,12 +10,14 @@
#include <cmath>
#include <ctype.h>
#include <stdarg.h>
#include <functional>
#include <errno.h>
#include <new>
// #include <functional>
#ifdef _MSC_VER
# include <crtdbg.h>
# include <direct.h>
# include <windows.h>
#else
# include <unistd.h>
# include <signal.h>
src/lisp_object.cpp
+19 -1
View File
@@ -41,7 +41,25 @@ proc append_to_keyword_argument_list(Keyword_Arguments* args,
}
Lisp_Object::~Lisp_Object() {
if (Memory::get_type(this) == Lisp_Object_Type::HashMap) {
free(sourceCodeLocation);
sourceCodeLocation = 0;
switch (Memory::get_type(this)) {
case Lisp_Object_Type::HashMap: {
this->value.hashMap.~Hash_Map();
} break;
case Lisp_Object_Type::CFunction: {
this->value.cFunction->args.positional.symbols.~Array_List();
this->value.cFunction->args.keyword.keywords.~Array_List();
this->value.cFunction->args.keyword.values.~Array_List();
delete this->value.cFunction;
} break;
case Lisp_Object_Type::Function:{
this->value.function->args.positional.symbols.~Array_List();
this->value.function->args.keyword.keywords.~Array_List();
this->value.function->args.keyword.values.~Array_List();
delete this->value.function;
} break;
default: break;
}
}
src/main.cpp
+3 -2
View File
@@ -1,13 +1,14 @@
#include "libslime.cpp"
int main(int argc, char* argv[]) {
if (argc > 1) {
if (Slime::string_equal(argv[1], "--run-tests")) {
int res = Slime::run_all_tests();
Slime::Memory::free_everything();
// Slime::interprete_file((char*)"generate-docs.slime");
#ifdef _MSC_VER
_CrtDumpMemoryLeaks();
#endif
return res ? 0 : 1;
}
src/memory.cpp
+34 -15
View File
@@ -11,12 +11,12 @@ namespace Memory {
// ------------------
// lisp_objects
// ------------------
Bucket_Allocator<Lisp_Object, 1024> object_memory;
Bucket_Allocator<Lisp_Object> object_memory(1024, 8);
// ------------------
// environments
// ------------------
Bucket_Allocator<Environment, 1024> environment_memory;
Bucket_Allocator<Environment> environment_memory(1024, 8);
// ------------------
// strings
@@ -146,6 +146,12 @@ namespace Memory {
proc free_everything() -> void {
free(string_memory);
object_memory.for_each([](Lisp_Object* lo){
lo->~Lisp_Object();
});
environment_memory.for_each([](Environment* env){
env->~Environment();
});
}
proc init(int sms) -> void {
@@ -183,18 +189,24 @@ namespace Memory {
global_keyword_table.~Hash_Map();
file_to_env_map.~Hash_Map();
::new(&global_symbol_table) Hash_Map<char*, Lisp_Object*>;
::new(&global_keyword_table) Hash_Map<char*, Lisp_Object*>;
::new(&file_to_env_map) Hash_Map<char*, Lisp_Object*>;
new(&global_symbol_table) Hash_Map<char*, Lisp_Object*>;
new(&global_keyword_table) Hash_Map<char*, Lisp_Object*>;
new(&file_to_env_map) Hash_Map<char*, Lisp_Object*>;
try_void Parser::standard_in = create_string("stdin");
object_memory.for_each([](Lisp_Object* lo){
lo->~Lisp_Object();
});
environment_memory.for_each([](Environment* env){
env->~Environment();
});
object_memory.~Bucket_Allocator();
// environment_memory.~Bucket_Allocator();
environment_memory.~Bucket_Allocator();
::new(&object_memory) Bucket_Allocator<Lisp_Object, 1024>;
::new(&environment_memory) Bucket_Allocator<Environment, 1024>;
::new(&object_memory) Bucket_Allocator<Lisp_Object>(1024, 8);
::new(&environment_memory) Bucket_Allocator<Environment>(1024, 8);
next_free_spot_in_string_memory = string_memory;
@@ -342,16 +354,20 @@ namespace Memory {
Lisp_Object* node;
try node = create_lisp_object();
set_type(node, Lisp_Object_Type::CFunction);
// node->value.lambdaWrapper = new Lambda_Wrapper(function);
node->value.cFunction = new(cFunction);
node->value.cFunction->args = {};
new((&node->value.cFunction->args.positional.symbols)) Array_List<Environment*>(16);
new((&node->value.cFunction->args.keyword.keywords)) Array_List<Environment*>(16);
new((&node->value.cFunction->args.keyword.values)) Array_List<Environment*>(16);
node->value.cFunction = new cFunction;
node->value.cFunction->is_special_form = is_special;
return node;
}
proc create_lisp_object_function(Function_Type ft) -> Lisp_Object* {
Lisp_Object* func;
try func = Memory::create_lisp_object();
Memory::set_type(func, Lisp_Object_Type::Function);
func->value.function = new Function;
func->value.function->type = ft;
return func;
}
proc create_lisp_object_pair(Lisp_Object* first, Lisp_Object* rest) -> Lisp_Object* {
Lisp_Object* node;
try node = create_lisp_object();
@@ -368,7 +384,9 @@ namespace Memory {
// we don't copy singleton objects
if (n == Memory::nil || n == Memory::t ||
Memory::get_type(n) == Lisp_Object_Type::Symbol ||
Memory::get_type(n) == Lisp_Object_Type::Keyword)
Memory::get_type(n) == Lisp_Object_Type::Keyword ||
Memory::get_type(n) == Lisp_Object_Type::Function ||
Memory::get_type(n) == Lisp_Object_Type::CFunction)
{
return n;
}
@@ -376,6 +394,7 @@ namespace Memory {
Lisp_Object* target;
try target = create_lisp_object();
*target = *n;
return target;
}
src/parse.cpp
+17 -14
View File
@@ -31,7 +31,7 @@ namespace Parser {
}
proc inject_scl(Lisp_Object* lo) -> void {
lo->sourceCodeLocation = new(Source_Code_Location);
lo->sourceCodeLocation = (Source_Code_Location*)malloc(sizeof(Source_Code_Location));
lo->sourceCodeLocation->file = parser_file;
lo->sourceCodeLocation->line = parser_line;
lo->sourceCodeLocation->column = parser_col;
@@ -65,7 +65,6 @@ namespace Parser {
++parser_col;
++(*index_in_text);
}
}
proc eat_until_code(char* text, int* index_in_text) -> void {
@@ -120,7 +119,7 @@ namespace Parser {
Lisp_Object* ret;
try ret = Memory::create_lisp_object_number(number);
inject_scl(ret);
// inject_scl(ret);
return ret;
}
@@ -132,7 +131,7 @@ namespace Parser {
Lisp_Object* ret;
try ret = Memory::get_or_create_lisp_object_keyword(str_keyword);
inject_scl(ret);
// inject_scl(ret);
return ret;
}
@@ -142,7 +141,7 @@ namespace Parser {
Lisp_Object* ret;
try ret = Memory::get_or_create_lisp_object_symbol(str_symbol);
inject_scl(ret);
// inject_scl(ret);
return ret;
}
@@ -157,7 +156,7 @@ namespace Parser {
Lisp_Object* ret;
try ret = Memory::create_lisp_object_string(
Memory::create_string("", 0));
inject_scl(ret);
// inject_scl(ret);
// plus one because we want to go after the quotes
*index_in_text += 1;
@@ -169,10 +168,10 @@ namespace Parser {
// 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)
while (escaping || text[*index_in_text+string_length] != '"') {
if (escaping) {
escaping = false;
}
else
if (text[*index_in_text+string_length] == '\\')
escaping = true;
@@ -186,9 +185,10 @@ namespace Parser {
// 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));
int new_len;
try new_len = unescape_string(text+(*index_in_text));
String* string = Memory::create_string("", string_length);
String* string = Memory::create_string("", new_len);
// TODO(Felix): manually copy to parse control sequences
// correctly without the need to unescape the string, also
@@ -196,6 +196,7 @@ namespace Parser {
// characters since last new line so we can update the parser
// location more easily
strcpy(&string->data, text+(*index_in_text));
// printf("------ %s\n", &string->data);
text[*index_in_text+string_length] = '"';
@@ -218,7 +219,7 @@ namespace Parser {
Lisp_Object* ret;
try ret = Memory::create_lisp_object_string(string);
inject_scl(ret);
// inject_scl(ret);
return ret;
}
@@ -285,7 +286,8 @@ namespace Parser {
try ret = Memory::create_list(Memory::get_or_create_lisp_object_symbol("unquote-splicing"), result);
}
if (ret) inject_scl(ret);
// if (ret && ret != Memory::nil && ret != Memory::t)
// inject_scl(ret);
return ret;
}
@@ -313,7 +315,7 @@ namespace Parser {
Lisp_Object* expression = head;
while (true) {
inject_scl(head);
// inject_scl(head);
if (text[*index_in_text] == '(' ||
text[*index_in_text] == '\''||
text[*index_in_text] == '`' ||
@@ -363,6 +365,7 @@ namespace Parser {
} else {
try head->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
head = head->value.pair.rest;
// inject_scl(head);
}
}
return expression;
src/structs.cpp
+2 -2
View File
@@ -118,7 +118,7 @@ struct Function {
};
struct cFunction {
std::function<Lisp_Object* ()> body;
Lisp_Object* (*body)();
Arguments args;
bool is_special_form;
};
@@ -134,7 +134,7 @@ struct Lisp_Object {
String* string;
Pair pair;
Vector vector;
Function function;
Function* function;
cFunction* cFunction;
void* pointer;
Continuation continuation;
src/testing.cpp
+1 -1
View File
@@ -656,7 +656,7 @@ proc run_all_tests() -> bool {
invoke_test_script("hashmaps");
invoke_test_script("singular_imports");
// Memory::print_status();
// // Memory::print_status();
return result;
}