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

Moved type info into a flags field in the lisp objects

Browse Source
This commit is contained in:
Felix Brendel
2019-04-20 17:26:18 +02:00
parent 09582f9669
commit 3277e50164
9 changed files with 139 additions and 131 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/built_ins.cpp
+43 -41
View File
@@ -1,10 +1,10 @@
proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
if (n1 == n2)
return true;
if (n1->type != n2->type)
if (Memory::get_type(n1) != Memory::get_type(n2))
return false;
switch (n1->type) {
switch (Memory::get_type(n1)) {
case Lisp_Object_Type::CFunction: // if they have the same
// pointer, true is returned a
@@ -72,7 +72,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
proc parse_lambda_starting_from_args = [&](Lisp_Object* arguments, Environment* env, bool is_special = false) -> Lisp_Object* {
// Function* function = new(Function);
Lisp_Object* ret = Memory::create_lisp_object();
ret->type = Lisp_Object_Type::Function;
Memory::set_type(ret, Lisp_Object_Type::Function);
ret->value.function.parent_environment = env;
@@ -82,7 +82,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
ret->value.function.type = Function_Type::Lambda;
// if parameters were specified
if (arguments->value.pair.first->type != Lisp_Object_Type::Nil) {
if (arguments->value.pair.first != Memory::nil) {
try {
assert_type(arguments->value.pair.first, Lisp_Object_Type::Pair);
}
@@ -97,7 +97,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
arguments = arguments->value.pair.rest;
// if there is a docstring, use it
if (arguments->value.pair.first->type == Lisp_Object_Type::String) {
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::String) {
ret->value.function.docstring = arguments->value.pair.first->value.string;
arguments = arguments->value.pair.rest;
} else {
@@ -121,12 +121,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {
arguments = eval_arguments(arguments, env, &arguments_length);
}
if (arguments->type == Lisp_Object_Type::Nil)
if (arguments == Memory::nil)
return Memory::t;
Lisp_Object* first = arguments->value.pair.first;
while (arguments->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
if (!lisp_object_equal(arguments->value.pair.first, first))
return Memory::nil;
arguments = arguments->value.pair.rest;
@@ -142,7 +142,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
double last_number = strtod("Inf", NULL);
while (arguments->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
}
@@ -164,7 +164,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
double last_number = strtod("Inf", NULL);
while (arguments->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
}
@@ -186,7 +186,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
double last_number = strtod("-Inf", NULL);
while (arguments->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
}
@@ -208,7 +208,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
double last_number = strtod("-Inf", NULL);
while (arguments->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
}
@@ -229,7 +229,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
}
double sum = 0;
while (arguments->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
}
@@ -251,7 +251,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
double difference = arguments->value.pair.first->value.number;
arguments = arguments->value.pair.rest;
while (arguments->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
}
@@ -273,7 +273,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
double product = arguments->value.pair.first->value.number;
arguments = arguments->value.pair.rest;
while (arguments->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
}
@@ -295,7 +295,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
double quotient = arguments->value.pair.first->value.number;
arguments = arguments->value.pair.rest;
while (arguments->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
}
@@ -351,7 +351,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object* symbol = arguments->value.pair.first;
Lisp_Object* value;
if (symbol->type == Lisp_Object_Type::Pair) {
if (Memory::get_type(symbol) == Lisp_Object_Type::Pair) {
/*
1: arguments
2: symbol
@@ -433,9 +433,9 @@ proc load_built_ins_into_environment(Environment* env) -> void {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
try assert(arguments_length == 2);
if (evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Nil ||
evaluated_arguments->value.pair.first->type == Lisp_Object_Type::T ||
evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Keyword)
if (evaluated_arguments->value.pair.first == Memory::nil ||
evaluated_arguments->value.pair.first == Memory::t ||
Memory::get_type(evaluated_arguments->value.pair.first) == Lisp_Object_Type::Keyword)
{
create_generic_error("You cannot mutate nil, t or keywords");
}
@@ -486,12 +486,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {
std::function<Lisp_Object*(Lisp_Object*)> unquoteSomeExpressions; // = [] (Lisp_Object* expr) -> Lisp_Object* {return nullptr;};
unquoteSomeExpressions = [&unquoteSomeExpressions, &env] (Lisp_Object* expr) -> Lisp_Object* {
// if it is an atom, return it
if (expr->type != Lisp_Object_Type::Pair)
if (Memory::get_type(expr) != Lisp_Object_Type::Pair)
return Memory::copy_lisp_object(expr);
// it is a pair!
Lisp_Object* originalPair = expr->value.pair.first;
if (originalPair->type == Lisp_Object_Type::Symbol &&
if (Memory::get_type(originalPair) == Lisp_Object_Type::Symbol &&
string_equal(originalPair->value.identifier, "unquote"))
{
// eval replace the stuff
@@ -510,10 +510,10 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object* newPair = Memory::create_lisp_object_pair(nullptr, nullptr);
Lisp_Object* newPairHead = newPair;
Lisp_Object* head = expr;
while (head->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(head) == Lisp_Object_Type::Pair) {
newPairHead->value.pair.first = unquoteSomeExpressions(head->value.pair.first);
if (head->value.pair.rest->type != Lisp_Object_Type::Pair)
if (Memory::get_type(head->value.pair.rest) != Lisp_Object_Type::Pair)
break;
newPairHead->value.pair.rest = Memory::create_lisp_object_pair(nullptr, nullptr);
@@ -534,7 +534,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
});
defun("and", cLambda {
bool result = true;
while (arguments->type != Lisp_Object_Type::Nil) {
while (arguments != Memory::nil) {
try assert_type(arguments, Lisp_Object_Type::Pair);
try result &= is_truthy(arguments->value.pair.first, env);
@@ -545,7 +545,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
});
defun("or", cLambda {
bool result = false;
while (arguments->type != Lisp_Object_Type::Nil) {
while (arguments != Memory::nil) {
try assert_type(arguments, Lisp_Object_Type::Pair);
try result |= is_truthy(arguments->value.pair.first, env);
@@ -576,7 +576,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
while (true) {
try condition = eval_expr(condition_part, env);
if (condition->type == Lisp_Object_Type::Nil)
if (condition == Memory::nil)
break;
try result = eval_expr(then_part->value.pair.first, env);
@@ -592,7 +592,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Environment* let_env = Memory::create_child_environment(env);
Lisp_Object* bindings = arguments->value.pair.first;
while (true) {
if (bindings->type == Lisp_Object_Type::Nil) {
if (bindings == Memory::nil) {
break;
}
@@ -622,7 +622,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object* evaluated_arguments;
try evaluated_arguments = eval_arguments(arguments, let_env, &arguments_length);
if (evaluated_arguments->type == Lisp_Object_Type::Nil)
if (evaluated_arguments == Memory::nil)
return evaluated_arguments;
// skip to the last evaluated operand and return it,
@@ -630,7 +630,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
// manually, because we want to increase code reuse,
// but at the cost that we have to find the end of the
// list again
while (evaluated_arguments->value.pair.rest->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(evaluated_arguments->value.pair.rest) == Lisp_Object_Type::Pair) {
evaluated_arguments = evaluated_arguments->value.pair.rest;
}
return evaluated_arguments->value.pair.first;
@@ -670,7 +670,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
defun("prog", cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
if (evaluated_arguments->type == Lisp_Object_Type::Nil)
if (evaluated_arguments == Memory::nil)
return evaluated_arguments;
// skip to the last evaluated operand and return it,
@@ -678,7 +678,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
// manually, because we want to increase code reuse,
// but at the cost that we have to find the end of the
// list again
while (evaluated_arguments->value.pair.rest->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(evaluated_arguments->value.pair.rest) == Lisp_Object_Type::Pair) {
evaluated_arguments = evaluated_arguments->value.pair.rest;
}
return evaluated_arguments->value.pair.first;
@@ -698,7 +698,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
try assert(arguments_length == 1);
if (evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Nil)
if (evaluated_arguments->value.pair.first == Memory::nil)
return Memory::nil;
try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::Pair);
@@ -709,7 +709,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
try assert(arguments_length == 1);
if (evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Nil)
if (evaluated_arguments->value.pair.first == Memory::nil)
return Memory::nil;
try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::Pair);
@@ -743,7 +743,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return evaluated_arguments->value.pair.first->userType;
}
Lisp_Object_Type type = evaluated_arguments->value.pair.first->type;
Lisp_Object_Type type = Memory::get_type(evaluated_arguments->value.pair.first);
switch (type) {
case Lisp_Object_Type::CFunction: return Memory::get_or_create_lisp_object_keyword("cfunction");
case Lisp_Object_Type::Function: {
@@ -784,7 +784,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
printf("\n\n");
// TODO(Felix): Maybe don't compare strings here?? Wtf
if (type->type == Lisp_Object_Type::Keyword &&
if (Memory::get_type(type) == Lisp_Object_Type::Keyword &&
(string_equal(type->value.identifier, "lambda") ||
string_equal(type->value.identifier, "special-lambda") ||
string_equal(type->value.identifier, "macro")))
@@ -937,11 +937,13 @@ proc load_built_ins_into_environment(Environment* env) -> void {
try assert(arguments_length == 1);
if (evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Nil ||
evaluated_arguments->value.pair.first->type == Lisp_Object_Type::T ||
evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Keyword)
if (evaluated_arguments->value.pair.first == Memory::nil ||
evaluated_arguments->value.pair.first == Memory::t ||
Memory::get_type(evaluated_arguments->value.pair.first) == Lisp_Object_Type::Symbol ||
Memory::get_type(evaluated_arguments->value.pair.first) == Lisp_Object_Type::Keyword)
{
create_generic_error("The values of 'nil', 't', and keywords can't be copied.");
// we don't copy singleton objects
return evaluated_arguments->value.pair.first;
}
Lisp_Object* target = Memory::create_lisp_object();
@@ -995,7 +997,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object* head = evaluated_arguments;
while (head->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(head) == Lisp_Object_Type::Pair) {
try assert_type(head->value.pair.first, Lisp_Object_Type::String);
resulting_string_len += head->value.pair.first->value.string->length;
@@ -1007,7 +1009,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
String* resulting_string = Memory::create_string("", resulting_string_len);
int index_in_string = 0;
while (head->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(head) == Lisp_Object_Type::Pair) {
strcpy((&resulting_string->data)+index_in_string,
Memory::get_c_str(head->value.pair.first->value.string));
index_in_string += head->value.pair.first->value.string->length;
src/defines.cpp
+2 -2
View File
@@ -151,8 +151,8 @@ struct {
#define assert_type(_node, _type) \
do { \
if (_node->type != _type) { \
create_type_missmatch_error("symbol", Lisp_Object_Type_to_string(_node->type)); \
if (Memory::get_type(_node) != _type) { \
create_type_missmatch_error("symbol", Lisp_Object_Type_to_string(Memory::get_type(_node))); \
} \
} while(0)
src/eval.cpp
+42 -41
View File
@@ -3,7 +3,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
// positional arguments
for (int i = 0; i < function->positional_arguments->next_index; ++i) {
if (arguments->type != Lisp_Object_Type::Pair) {
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
create_wrong_number_of_arguments_error(function->positional_arguments->next_index, i);
return nullptr;
}
@@ -19,14 +19,14 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
String_Array_List* read_in_keywords = create_String_array_list();
if (arguments->type == Lisp_Object_Type::Nil)
if (Memory::get_type(arguments) == 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
// something that is not a keyword is encountered or a keyword
// that is not recognized is encoutered, jump out of the loop.
while (arguments->value.pair.first->type == Lisp_Object_Type::Keyword) {
while (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
// check if this one is even an accepted keyword
bool accepted = false;
for (int i = 0; i < function->keyword_arguments->next_index; ++i) {
@@ -69,7 +69,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
// okay so we found a keyword that has to be read in and was
// not already read in, is there a next element to actually
// set it to?
if (arguments->value.pair.rest->type != Lisp_Object_Type::Pair) {
if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) {
create_generic_error(
"Attempting to set the keyword argument ':%s', but no value was supplied.",
&(arguments->value.pair.first->value.identifier));
@@ -87,7 +87,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
// overstep both for next one
arguments = arguments->value.pair.rest->value.pair.rest;
if (arguments->type == Lisp_Object_Type::Nil) {
if (arguments == Memory::nil) {
break;
}
}
@@ -127,7 +127,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
}
if (arguments->type == Lisp_Object_Type::Nil) {
if (arguments == Memory::nil) {
if (function->rest_argument) {
define_symbol(
Memory::get_or_create_lisp_object_symbol(function->rest_argument),
@@ -181,8 +181,8 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
function->rest_argument = nullptr;
// okay let's try to read some positional arguments
while (arguments->type == Lisp_Object_Type::Pair) {
if (arguments->value.pair.first->type == Lisp_Object_Type::Keyword) {
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
if (string_equal(arguments->value.pair.first->value.identifier, "keys") ||
string_equal(arguments->value.pair.first->value.identifier, "rest"))
break;
@@ -194,10 +194,10 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
}
}
if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) {
if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol) {
create_parsing_error("Only symbols and keywords can be "
"parsed here, but found '%s'",
Lisp_Object_Type_to_string(arguments->value.pair.first->type));
Lisp_Object_Type_to_string(Memory::get_type(arguments->value.pair.first)));
return;
}
@@ -211,17 +211,17 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
// okay we are done with positional arguments, lets check for
// keywords,
if (arguments->type != Lisp_Object_Type::Pair) {
if (arguments->type != Lisp_Object_Type::Nil)
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
if (arguments != Memory::nil)
create_parsing_error("The lambda list must be nil terminated.");
return;
}
if (arguments->value.pair.first->type == Lisp_Object_Type::Keyword &&
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword &&
string_equal(arguments->value.pair.first->value.identifier, "keys"))
{
arguments = arguments->value.pair.rest;
if (arguments->type != Lisp_Object_Type::Pair) {
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
create_parsing_error("Actual keys have to follow the :keys indicator.");
}
// if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) {
@@ -231,8 +231,8 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
// return;
// }
while (arguments->type == Lisp_Object_Type::Pair) {
if (arguments->value.pair.first->type == Lisp_Object_Type::Keyword) {
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
if (string_equal(arguments->value.pair.first->value.identifier, "rest"))
break;
else {
@@ -243,10 +243,10 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
}
}
if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) {
if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol) {
create_parsing_error(
"Only symbols can be parsed here, but found '%s'.",
Lisp_Object_Type_to_string(arguments->value.pair.first->type));
Lisp_Object_Type_to_string(Memory::get_type(arguments->value.pair.first)));
return;
}
@@ -254,15 +254,15 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
// the keyword args! Let's check if the next arguement is
// :defaults-to
Lisp_Object* next = arguments->value.pair.rest;
if (next->type == Lisp_Object_Type::Pair &&
next->value.pair.first->type == Lisp_Object_Type::Keyword &&
if (Memory::get_type(next) == Lisp_Object_Type::Pair &&
Memory::get_type(next->value.pair.first) == Lisp_Object_Type::Keyword &&
string_equal(next->value.pair.first->value.identifier,
"defaults-to"))
{
// check if there is a next argument too, otherwise it
// would be an error
next = next->value.pair.rest;
if (next->type == Lisp_Object_Type::Pair) {
if (Memory::get_type(next) == Lisp_Object_Type::Pair) {
append_to_keyword_argument_list(function->keyword_arguments,
arguments->value.pair.first->value.identifier,
next->value.pair.first);
@@ -284,24 +284,24 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
// Now we are also done with keyword arguments, lets check for
// if there is a rest argument
if (arguments->type != Lisp_Object_Type::Pair) {
if (arguments->type != Lisp_Object_Type::Nil)
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
if (arguments != Memory::nil)
create_parsing_error("The lambda list must be nil terminated.");
return;
}
if (arguments->value.pair.first->type == Lisp_Object_Type::Keyword &&
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword &&
string_equal(arguments->value.pair.first->value.identifier, "rest"))
{
arguments = arguments->value.pair.rest;
if (// arguments->type != Lisp_Object_Type::Pair ||
arguments->value.pair.first->type != Lisp_Object_Type::Symbol)
Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol)
{
create_parsing_error("After the 'rest' marker there must follow a symbol.");
return;
}
function->rest_argument = arguments->value.pair.first->value.identifier;
if (arguments->value.pair.rest->type != Lisp_Object_Type::Nil) {
if (arguments->value.pair.rest != Memory::nil) {
create_parsing_error("The lambda list must end after the rest symbol");
}
} else {
@@ -312,16 +312,16 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
proc list_length(Lisp_Object* node) -> int {
if (node->type == Lisp_Object_Type::Nil)
if (node == Memory::nil)
return 0;
assert_type(node, Lisp_Object_Type::Pair);
int len = 0;
while (node->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(node) == Lisp_Object_Type::Pair) {
++len;
node = node->value.pair.rest;
if (node->type == Lisp_Object_Type::Nil)
if (node == Memory::nil)
return len;
}
@@ -340,7 +340,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) {
if (arguments == Memory::nil) {
*(out_arguments_length) = 0;
return arguments;
}
@@ -348,7 +348,7 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments
Lisp_Object* evaluated_arguments = Memory::create_lisp_object_pair(nullptr, nullptr);
Lisp_Object* evaluated_arguments_head = evaluated_arguments;
Lisp_Object* current_head = arguments;
while (current_head->type == Lisp_Object_Type::Pair) {
while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
try {
evaluated_arguments_head->value.pair.first =
eval_expr(current_head->value.pair.first, env);
@@ -356,10 +356,10 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments
evaluated_arguments_head->value.pair.first->sourceCodeLocation = current_head->value.pair.first->sourceCodeLocation;
current_head = current_head->value.pair.rest;
if (current_head->type == Lisp_Object_Type::Pair) {
if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(nullptr, nullptr);
evaluated_arguments_head = evaluated_arguments_head->value.pair.rest;
} else if (current_head->type == Lisp_Object_Type::Nil) {
} else if (current_head == Memory::nil) {
evaluated_arguments_head->value.pair.rest = current_head;
} else {
create_parsing_error("Attempting to evaluate ill formed argument list.");
@@ -372,7 +372,9 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments
}
proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
switch (node->type) {
Globals::current_source_code = node;
switch (Memory::get_type(node)) {
case Lisp_Object_Type::T:
case Lisp_Object_Type::Nil:
case Lisp_Object_Type::Number:
@@ -387,11 +389,10 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
return symbol;
}
case Lisp_Object_Type::Pair: {
Globals::current_source_code = node;
Lisp_Object* lispOperator;
if (node->value.pair.first->type != Lisp_Object_Type::CFunction &&
node->value.pair.first->type != Lisp_Object_Type::Function)
if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction &&
Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function)
{
try {
lispOperator = eval_expr(node->value.pair.first, env);
@@ -404,13 +405,13 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
int arguments_length;
// check for c function
if (lispOperator->type == Lisp_Object_Type::CFunction) {
if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) {
Lisp_Object* result = lispOperator->value.cFunction->function(arguments, env);
return result;
}
// check for lisp function
if (lispOperator->type == Lisp_Object_Type::Function) {
if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) {
// only for lambdas we evaluate the arguments before
// apllying
if (lispOperator->value.function.type == Function_Type::Lambda) {
@@ -427,7 +428,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
}
}
default: {
create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(node->type));
create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node)));
return nullptr;
}
}
@@ -438,7 +439,7 @@ proc is_truthy (Lisp_Object* expression, Environment* env) -> bool {
try {
result = eval_expr(expression, env);
}
if (result->type == Lisp_Object_Type::Nil)
if (result == Memory::nil)
return false;
return true;
}
src/forward_decls.cpp
+1
View File
@@ -15,6 +15,7 @@ proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*;
namespace Memory {
proc get_or_create_lisp_object_keyword(const char* identifier) -> Lisp_Object*;
inline proc get_type(Lisp_Object* node) -> Lisp_Object_Type;
}
namespace Globals {
src/io.cpp
+4 -4
View File
@@ -230,12 +230,12 @@ proc panic(char* message) -> void {
proc print(Lisp_Object* node, bool print_quotes = false, FILE* file = stdout) -> void {
switch (node->type) {
switch (Memory::get_type(node)) {
case (Lisp_Object_Type::Nil): fputs("()", file); break;
case (Lisp_Object_Type::T): fputs("t", file); break;
case (Lisp_Object_Type::Number): fprintf(file, "%f", node->value.number); break;
case (Lisp_Object_Type::Keyword): fputs(":", file); // NOTE(Felix): intentionall fallthough
case (Lisp_Object_Type::Symbol): fprintf(file, Memory::get_c_str(node->value.identifier)); break;
case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.identifier)); break;
case (Lisp_Object_Type::CFunction): fputs("[C-function]", file); break;
case (Lisp_Object_Type::String): {
if (print_quotes) {
@@ -268,12 +268,12 @@ proc print(Lisp_Object* node, bool print_quotes = false, FILE* file = stdout) ->
head = head->value.pair.rest;
if (!head)
return;
if (head->type != Lisp_Object_Type::Pair)
if (Memory::get_type(head) != Lisp_Object_Type::Pair)
break;
putc(' ', file);
}
if (head->type != Lisp_Object_Type::Nil) {
if (Memory::get_type(head) != Lisp_Object_Type::Nil) {
fputs(" . ", file);
print(head);
}
src/memory.cpp
+24 -9
View File
@@ -51,6 +51,21 @@ namespace Memory {
return get_c_str(str->value.string);
}
inline proc get_type(Lisp_Object* node) -> Lisp_Object_Type {
// the type is in the bits 0 to 5 (including)
return (Lisp_Object_Type) ((u64)node->flags & (u64)0xffffff);
}
inline proc set_type(Lisp_Object* node, Lisp_Object_Type type) {
// the type is in the bits 0 to 5 (including)
u64 bitmask = (u64)-1;
bitmask -= 0xffffff;
bitmask += (u64) type;
node->flags = (u64)(node->flags) | bitmask;
}
proc create_string(const char* str, int len) -> String* {
// TODO(Felix): check the holes first, not just always append
// at the end
@@ -136,11 +151,11 @@ namespace Memory {
// init nil
nil = create_lisp_object();
nil->type = Lisp_Object_Type::Nil;
set_type(nil, Lisp_Object_Type::Nil);
// init t
t = create_lisp_object();
t->type = Lisp_Object_Type::T;
set_type(t, Lisp_Object_Type::T);
}
proc reset() -> void {
@@ -152,21 +167,21 @@ namespace Memory {
proc create_lisp_object_number(double number) -> Lisp_Object* {
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::Number;
set_type(node, Lisp_Object_Type::Number);
node->value.number = number;
return node;
}
proc create_lisp_object_string(String* str) -> Lisp_Object* {
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::String;
set_type(node, Lisp_Object_Type::String);
node->value.string = str;
return node;
}
proc create_lisp_object_string(char* str) -> Lisp_Object* {
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::String;
set_type(node, Lisp_Object_Type::String);
node->value.string = create_string(str);
return node;
}
@@ -175,7 +190,7 @@ namespace Memory {
// TODO(Felix): if we already have it stored somewhere then
// reuse it and dont create new one
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::Symbol;
set_type(node, Lisp_Object_Type::Symbol);
// node->value.symbol = new(Symbol);
node->value.identifier = identifier;
return node;
@@ -193,7 +208,7 @@ namespace Memory {
// TODO(Felix): if we already have it stored somewhere then
// reuse it and dont create new one
Lisp_Object* node = create_lisp_object();
node->type = Lisp_Object_Type::Keyword;
set_type(node, Lisp_Object_Type::Keyword);
// node->value.keyword = new(Keyword);
node->value.identifier = keyword;
return node;
@@ -209,7 +224,7 @@ namespace Memory {
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;
set_type(node, Lisp_Object_Type::CFunction);
// node->value.lambdaWrapper = new Lambda_Wrapper(function);
node->value.cFunction = new(cFunction);
node->value.cFunction->function = function;
@@ -218,7 +233,7 @@ namespace Memory {
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;
set_type(node, Lisp_Object_Type::Pair);
// node->value.pair = new(Pair);
node->value.pair.first = first;
node->value.pair.rest = rest;
src/parse.cpp
+7 -7
View File
@@ -292,7 +292,7 @@ namespace Parser {
// okay there is something
Lisp_Object* head = Memory::create_lisp_object();
head->type = Lisp_Object_Type::Pair;
Memory::set_type(head, Lisp_Object_Type::Pair);
// head->value.pair = new(Pair);
Lisp_Object* expression = head;
@@ -352,7 +352,7 @@ namespace Parser {
}
// check if we have to create or delete or run macros
if (expression->value.pair.first->type == Lisp_Object_Type::Symbol) {
if (Memory::get_type(expression->value.pair.first) == Lisp_Object_Type::Symbol) {
if (string_equal("define-syntax", expression->value.pair.first->value.identifier)) {
// create a new macro
Lisp_Object* arguments = expression->value.pair.rest;
@@ -378,12 +378,12 @@ namespace Parser {
// Function* function = new(Function);
Lisp_Object* macro = Memory::create_lisp_object();
macro->type = Lisp_Object_Type::Function;
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->value.pair.first->type != Lisp_Object_Type::Nil) {
if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Nil) {
try {
assert_type(arguments->value.pair.first, Lisp_Object_Type::Pair);
}
@@ -398,7 +398,7 @@ namespace Parser {
arguments = arguments->value.pair.rest;
// if there is a docstring, use it
if (arguments->value.pair.first->type == Lisp_Object_Type::String) {
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::String) {
macro->value.function.docstring = arguments->value.pair.first->value.string;
arguments = arguments->value.pair.rest;
} else {
@@ -439,7 +439,7 @@ namespace Parser {
for (int i = 0; i < environment_for_macros->next_index; ++i) {
if (string_equal(expression->value.pair.first->value.identifier, environment_for_macros->keys[i]) &&
environment_for_macros->values[i]->type == Lisp_Object_Type::Function &&
Memory::get_type(environment_for_macros->values[i]) == Lisp_Object_Type::Function &&
environment_for_macros->values[i]->value.function.type == Function_Type::Macro)
{
try {
@@ -543,7 +543,7 @@ namespace Parser {
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]->type == Lisp_Object_Type::Nil)
if (program->data[i] == Memory::nil)
continue;
print(program->data[i], true, f);
fprintf(f, "\n\n");
src/structs.cpp
+10 -21
View File
@@ -16,36 +16,25 @@ enum struct Lisp_Object_Type {
String,
Pair,
// Pointer,
// OwningPointer,
Function,
CFunction,
};
typedef uint64_t u64;
enum class Lisp_Object_Flags : u64
{
// bits 0 to 5 will be reserved for the type
aliveness = 1 << 6,
};
enum struct Function_Type {
Lambda,
Special_Lambda,
Macro
};
// enum struct Error_Type {
// Assertion_Error,
// File_Not_Found,
// Ill_Formed_Arguments,
// Ill_Formed_Lambda_List,
// Ill_Formed_List,
// Not_A_Function,
// Not_Yet_Implemented,
// Out_Of_Memory,
// Symbol_Not_Defined,
// Syntax_Error,
// Trailing_Garbage,
// Type_Missmatch,
// Unbalanced_Parenthesis,
// Unexpected_Eof,
// Unknown_Error,
// Unknown_Keyword_Argument,
// Wrong_Number_Of_Arguments,
// };
enum struct Log_Level {
None,
Critical,
@@ -116,7 +105,7 @@ struct cFunction {
struct Lisp_Object {
Source_Code_Location* sourceCodeLocation;
Lisp_Object_Type type;
u64 flags;
Lisp_Object* userType;
union {
String* identifier; // used for symbols and keywords
src/testing.cpp
+6 -6
View File
@@ -63,13 +63,13 @@
return fail; \
}
#define assert_equal_type(node, _type) \
if (node->type != _type) { \
print_assert_equal_fail( \
Lisp_Object_Type_to_string(node->type), \
#define assert_equal_type(node, _type) \
if (Memory::get_type(node) != _type) { \
print_assert_equal_fail( \
Lisp_Object_Type_to_string(Memory::get_type(node)), \
Lisp_Object_Type_to_string(_type), char*, "%s"); \
return fail; \
} \
return fail; \
} \
#define assert_null(variable) \
assert_equal_int(variable, nullptr)