diff --git a/bin/tests/sicp.slime b/bin/tests/sicp.slime
index 8b393f7..7a469a3 100644
--- a/bin/tests/sicp.slime
+++ b/bin/tests/sicp.slime
@@ -338,3 +338,4 @@
(define (close-enough? x y) (< (abs (- x y)) 0.001))
(assert (close-enough? (search (lambda (x) (- 1 (square x))) -3 3) -1))
+
diff --git a/bin/visualization.svg b/bin/visualization.svg
index 87bb694..66b1de7 100644
--- a/bin/visualization.svg
+++ b/bin/visualization.svg
@@ -16,7 +16,7 @@
Time:
- 11:40:20
+ 16:44:55
|
diff --git a/src/built_ins.cpp b/src/built_ins.cpp
index 7fecaf2..be69c0c 100644
--- a/src/built_ins.cpp
+++ b/src/built_ins.cpp
@@ -17,7 +17,7 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
// unnecessary once symbols and
// keywords are memory unique
case Lisp_Object_Type::Keyword:
- return string_equal(n1->value.identifier, n2->value.identifier);
+ return string_equal(n1->value.symbol.identifier, n2->value.symbol.identifier);
case Lisp_Object_Type::Number: return n1->value.number == n2->value.number;
case Lisp_Object_Type::String: return string_equal(n1->value.string, n2->value.string);
case Lisp_Object_Type::Pair:
@@ -440,7 +440,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
// it is a pair!
Lisp_Object* originalPair = expr->value.pair.first;
if (Memory::get_type(originalPair) == Lisp_Object_Type::Symbol &&
- string_equal(originalPair->value.identifier, "unquote"))
+ string_equal(originalPair->value.symbol.identifier, "unquote"))
{
// eval replace the stuff
return eval_expr(expr->value.pair.rest->value.pair.first, env);
@@ -740,9 +740,9 @@ proc load_built_ins_into_environment(Environment* env) -> void {
// TODO(Felix): Maybe don't compare strings here?? Wtf
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")))
+ (string_equal(type->value.symbol.identifier, "lambda") ||
+ string_equal(type->value.symbol.identifier, "special-lambda") ||
+ string_equal(type->value.symbol.identifier, "macro")))
{
Lisp_Object* fun = eval_expr(arguments->value.pair.first, env);
@@ -926,7 +926,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object* source = evaluated_arguments->value.pair.first;
- return Memory::get_or_create_lisp_object_keyword(source->value.identifier);
+ return Memory::get_or_create_lisp_object_keyword(source->value.symbol.identifier);
});
defun("string->symbol", cLambda {
// TODO(Felix): do some sanity checks on the string. For
@@ -947,7 +947,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object* source = evaluated_arguments->value.pair.first;
- return Memory::create_lisp_object_string(Memory::duplicate_string(source->value.identifier));
+ return Memory::create_lisp_object_string(Memory::duplicate_string(source->value.symbol.identifier));
});
defun("concat-strings", cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
diff --git a/src/env.cpp b/src/env.cpp
index e927f1c..68bcbbc 100644
--- a/src/env.cpp
+++ b/src/env.cpp
@@ -10,7 +10,7 @@ proc define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) ->
env->values = (Lisp_Object**)realloc(env->values, env->capacity * sizeof(Lisp_Object*));
}
- env->keys [env->next_index] = Memory::get_c_str(symbol->value.identifier);
+ env->keys [env->next_index] = Memory::get_c_str(symbol->value.symbol.identifier);
env->values[env->next_index] = value;
++env->next_index;
}
@@ -24,7 +24,7 @@ proc lookup_symbol_in_this_envt(String* identifier, Environment* env) -> Lisp_Ob
proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
// first check current environment
- String* identifier = node->value.identifier;
+ String* identifier = node->value.symbol.identifier;
Lisp_Object* result;
result = lookup_symbol_in_this_envt(identifier, env);
if (result)
@@ -53,7 +53,7 @@ proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
if (result)
return result;
- String* identifier = node->value.identifier;
+ String* identifier = node->value.symbol.identifier;
create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data);
print_environment(env);
return nullptr;
diff --git a/src/error.cpp b/src/error.cpp
index df7155c..2fef0ba 100644
--- a/src/error.cpp
+++ b/src/error.cpp
@@ -14,7 +14,7 @@ proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, S
delete_error();
debug_break();
- // visualize_lisp_machine();
+ visualize_lisp_machine();
using Globals::error;
error = new(Error);
diff --git a/src/eval.cpp b/src/eval.cpp
index 26bcb86..fcbfdac 100644
--- a/src/eval.cpp
+++ b/src/eval.cpp
@@ -34,7 +34,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
bool accepted = false;
for (int i = 0; i < function->keyword_arguments->next_index; ++i) {
if (string_equal(
- arguments->value.pair.first->value.identifier,
+ arguments->value.pair.first->value.symbol.identifier,
function->keyword_arguments->identifiers[i]))
{
accepted = true;
@@ -48,14 +48,14 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
// (special case with default variables)
create_generic_error(
"The function does not take the keyword argument ':%s'",
- &(arguments->value.pair.first->value.identifier));
+ &(arguments->value.pair.first->value.symbol.identifier));
return nullptr;
}
// check if it was already read in
for (int i = 0; i < read_in_keywords->next_index; ++i) {
if (string_equal(
- arguments->value.pair.first->value.identifier,
+ arguments->value.pair.first->value.symbol.identifier,
read_in_keywords->data[i]))
{
// TODO(Felix): if we are actually done with all the
@@ -64,7 +64,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
// (special case with default variables)
create_generic_error(
"The function already read the keyword argument ':%s'",
- &(arguments->value.pair.first->value.identifier));
+ &(arguments->value.pair.first->value.symbol.identifier));
return nullptr;
}
}
@@ -75,15 +75,15 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
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));
+ &(arguments->value.pair.first->value.symbol.identifier));
return nullptr;
}
// if not set it and then add it to the array list
- try sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.identifier),
+ try sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.symbol.identifier),
define_symbol(sym, arguments->value.pair.rest->value.pair.first, new_env);
- append_to_array_list(read_in_keywords, arguments->value.pair.first->value.identifier);
+ append_to_array_list(read_in_keywords, arguments->value.pair.first->value.symbol.identifier);
// overstep both for next one
arguments = arguments->value.pair.rest->value.pair.rest;
@@ -177,13 +177,13 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
// okay let's try to read some positional arguments
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"))
+ if (string_equal(arguments->value.pair.first->value.symbol.identifier, "keys") ||
+ string_equal(arguments->value.pair.first->value.symbol.identifier, "rest"))
break;
else {
create_parsing_error("A non recognized marker was found "
"in the lambda list: ':%s'",
- &arguments->value.pair.first->value.identifier);
+ &arguments->value.pair.first->value.symbol.identifier);
return;
}
}
@@ -198,7 +198,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
// okay wow we found an actual symbol
append_to_positional_argument_list(
function->positional_arguments,
- arguments->value.pair.first->value.identifier);
+ arguments->value.pair.first->value.symbol.identifier);
arguments = arguments->value.pair.rest;
}
@@ -212,7 +212,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
}
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword &&
- string_equal(arguments->value.pair.first->value.identifier, "keys"))
+ string_equal(arguments->value.pair.first->value.symbol.identifier, "keys"))
{
arguments = arguments->value.pair.rest;
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
@@ -227,12 +227,12 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
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"))
+ if (string_equal(arguments->value.pair.first->value.symbol.identifier, "rest"))
break;
else {
create_parsing_error(
"Only the :rest keyword can be parsed here, but got ':%s'.",
- &arguments->value.pair.first->value.identifier->data);
+ &arguments->value.pair.first->value.symbol.identifier->data);
return;
}
}
@@ -250,7 +250,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
Lisp_Object* next = arguments->value.pair.rest;
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,
+ string_equal(next->value.pair.first->value.symbol.identifier,
"defaults-to"))
{
// check if there is a next argument too, otherwise it
@@ -258,7 +258,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
next = next->value.pair.rest;
if (Memory::get_type(next) == Lisp_Object_Type::Pair) {
append_to_keyword_argument_list(function->keyword_arguments,
- arguments->value.pair.first->value.identifier,
+ arguments->value.pair.first->value.symbol.identifier,
next->value.pair.first);
arguments = next->value.pair.rest;
} else {
@@ -268,7 +268,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
} else {
// No :defaults-to, so just add it to the list
append_to_keyword_argument_list(function->keyword_arguments,
- arguments->value.pair.first->value.identifier,
+ arguments->value.pair.first->value.symbol.identifier,
nullptr);
arguments = next;
}
@@ -285,7 +285,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
}
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword &&
- string_equal(arguments->value.pair.first->value.identifier, "rest"))
+ string_equal(arguments->value.pair.first->value.symbol.identifier, "rest"))
{
arguments = arguments->value.pair.rest;
if (// arguments->type != Lisp_Object_Type::Pair ||
@@ -294,7 +294,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
create_parsing_error("After the 'rest' marker there must follow a symbol.");
return;
}
- function->rest_argument = arguments->value.pair.first->value.identifier;
+ function->rest_argument = arguments->value.pair.first->value.symbol.identifier;
if (arguments->value.pair.rest != Memory::nil) {
create_parsing_error("The lambda list must end after the rest symbol");
}
@@ -326,7 +326,7 @@ proc list_length(Lisp_Object* node) -> int {
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.identifier, keyword))
+ if (string_equal(args->keyword_keys->data[i]->value.symbol.identifier, keyword))
return args->keyword_values->data[i];
}
return nullptr;
diff --git a/src/io.cpp b/src/io.cpp
index 37270f8..0a90320 100644
--- a/src/io.cpp
+++ b/src/io.cpp
@@ -211,7 +211,7 @@ proc read_line() -> char* {
return linep;
}
-proc log_message(Log_Level type, char* message) -> void {
+proc log_message(Log_Level type, const char* message) -> void {
if (type > Globals::log_level)
return;
@@ -238,7 +238,7 @@ proc print(Lisp_Object* node, bool print_quotes = false, FILE* file = stdout) ->
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, "%s", Memory::get_c_str(node->value.identifier)); break;
+ case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.symbol.identifier)); break;
case (Lisp_Object_Type::CFunction): fputs("[C-function]", file); break;
case (Lisp_Object_Type::String): {
if (print_quotes) {
diff --git a/src/memory.cpp b/src/memory.cpp
index f3e6c33..cd4dbfd 100644
--- a/src/memory.cpp
+++ b/src/memory.cpp
@@ -72,6 +72,19 @@ namespace Memory {
node->flags = (u64)(node->flags) | bitmask;
}
+ proc hash(String* str) -> u64 {
+ // TODO(Felix): When parsing symbols or keywords, compute the
+ // hash while reading them in.
+ u64 value = str->data << 7;
+ for (int i = 1; i < str->length; ++i) {
+ char c = ((char*)&str->data)[i];
+ value = (1000003 * value) ^ c;
+ }
+ value ^= str->length;
+
+ return value;
+
+ }
proc create_string(const char* str, int len) -> String* {
// TODO(Felix): check the holes first, not just always append
@@ -216,7 +229,8 @@ namespace Memory {
try node = create_lisp_object();
set_type(node, Lisp_Object_Type::Symbol);
// node->value.symbol = new(Symbol);
- node->value.identifier = identifier;
+ node->value.symbol.identifier = identifier;
+ node->value.symbol.hash = hash(identifier);
return node;
}
@@ -235,7 +249,8 @@ namespace Memory {
try node = create_lisp_object();
set_type(node, Lisp_Object_Type::Keyword);
// node->value.keyword = new(Keyword);
- node->value.identifier = keyword;
+ node->value.symbol.identifier = keyword;
+ node->value.symbol.hash = hash(keyword);
return node;
}
diff --git a/src/parse.cpp b/src/parse.cpp
index fc801f8..f43ad4c 100644
--- a/src/parse.cpp
+++ b/src/parse.cpp
@@ -365,7 +365,7 @@ namespace Parser {
// check if we have to create or delete or run macros
while (Memory::get_type(expression->value.pair.first) == Lisp_Object_Type::Symbol) {
Lisp_Object* parsed_symbol = expression->value.pair.first;
- if (string_equal("define-syntax", parsed_symbol->value.identifier)) {
+ if (string_equal("define-syntax", parsed_symbol->value.symbol.identifier)) {
// create a new macro
Lisp_Object* arguments = expression->value.pair.rest;
Lisp_Object* body;
@@ -426,7 +426,7 @@ namespace Parser {
// print_environment(environment_for_macros);
return Memory::nil;
- } else if (string_equal("delete-syntax", parsed_symbol->value.identifier)) {
+ } else if (string_equal("delete-syntax", parsed_symbol->value.symbol.identifier)) {
/* --- deleting an existing macro --- */
// TODO(Felix): this is a hard one because when
// environments will be made from hashmaps, how can we
diff --git a/src/structs.cpp b/src/structs.cpp
index 93a93ed..4c63548 100644
--- a/src/structs.cpp
+++ b/src/structs.cpp
@@ -57,10 +57,12 @@ struct Source_Code_Location {
struct Symbol {
String* identifier;
+ u64 hash;
};
struct Keyword {
String* identifier;
+ u64 hash;
};
// struct Number {
@@ -109,7 +111,7 @@ struct Lisp_Object {
u64 flags;
Lisp_Object* userType;
union {
- String* identifier; // used for symbols and keywords
+ Symbol symbol; // used for symbols and keywords
double number;
String* string;
Pair pair;
diff --git a/src/testing.cpp b/src/testing.cpp
index 8c9c176..768304d 100644
--- a/src/testing.cpp
+++ b/src/testing.cpp
@@ -222,7 +222,7 @@ proc test_eval_operands() -> testresult {
assert_equal_type(operands, Lisp_Object_Type::Pair);
assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Keyword);
- assert_equal_string(operands->value.pair.first->value.identifier, "haha");
+ assert_equal_string(operands->value.pair.first->value.symbol.identifier, "haha");
return pass;
}
@@ -259,26 +259,26 @@ proc test_parse_atom() -> testresult {
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Keyword);
- assert_equal_string(result->value.identifier, "key1");
+ assert_equal_string(result->value.symbol.identifier, "key1");
++index_in_text;
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Keyword);
- assert_equal_string(result->value.identifier, "key:2");
+ assert_equal_string(result->value.symbol.identifier, "key:2");
// test symbols
++index_in_text;
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Symbol);
- assert_equal_string(result->value.identifier, "sym");
+ assert_equal_string(result->value.symbol.identifier, "sym");
++index_in_text;
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Symbol);
- assert_equal_string(result->value.identifier, "+");
+ assert_equal_string(result->value.symbol.identifier, "+");
return pass;
}
@@ -292,13 +292,13 @@ proc test_parse_expression() -> testresult {
assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
- assert_equal_string(result->value.pair.first->value.identifier, "fun");
+ assert_equal_string(result->value.pair.first->value.symbol.identifier, "fun");
result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
- assert_equal_string(result->value.pair.first->value.identifier, "+");
+ assert_equal_string(result->value.pair.first->value.symbol.identifier, "+");
result = result->value.pair.rest;
@@ -318,20 +318,20 @@ proc test_parse_expression() -> testresult {
assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
- assert_equal_string(result->value.pair.first->value.identifier, "define");
+ assert_equal_string(result->value.pair.first->value.symbol.identifier, "define");
result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
- assert_equal_string(result->value.pair.first->value.identifier, "fun");
+ assert_equal_string(result->value.pair.first->value.symbol.identifier, "fun");
result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first->value.pair.first, Lisp_Object_Type::Symbol);
- assert_equal_string(result->value.pair.first->value.pair.first->value.identifier, "lambda");
+ assert_equal_string(result->value.pair.first->value.pair.first->value.symbol.identifier, "lambda");
result = result->value.pair.rest;
@@ -500,7 +500,7 @@ proc test_built_in_type() -> testresult {
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword);
- assert_equal_string(result->value.identifier, "number");
+ assert_equal_string(result->value.symbol.identifier, "number");
// setting user type
char exp_string2[] = "(prog (set-type a :my-type)(type a))";
@@ -510,7 +510,7 @@ proc test_built_in_type() -> testresult {
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword);
- assert_equal_string(result->value.identifier, "my-type");
+ assert_equal_string(result->value.symbol.identifier, "my-type");
// trying to set invalid user type
char exp_string3[] = "(prog (set-type a \"wrong tpye\")(type a))";
@@ -531,7 +531,7 @@ proc test_built_in_type() -> testresult {
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword);
- assert_equal_string(result->value.identifier, "number");
+ assert_equal_string(result->value.symbol.identifier, "number");
return pass;
}
diff --git a/src/visualization.cpp b/src/visualization.cpp
index ec57b31..28a411f 100644
--- a/src/visualization.cpp
+++ b/src/visualization.cpp
@@ -6,9 +6,10 @@ proc visualize_lisp_machine() -> void {
int height;
};
- fprintf(stderr, "Drawing visualization...");
+ log_message(Log_Level::Info, "Drawing visualization...");
+
defer {
- fprintf(stderr, "Done!\n");
+ log_message(Log_Level::Info, "Done drawing visualization!");
};
const int padding = 40;
@@ -20,15 +21,14 @@ proc visualize_lisp_machine() -> void {
FILE *f = fopen("visualization.svg", "w");
- defer {
- fclose(f);
- };
-
- if (f == NULL) {
- create_generic_error("The file for writing the visualization"
+ if (!f) {
+ create_generic_error("The file for writing the visualization "
"could not be opened for writing");
return;
}
+ defer {
+ fclose(f);
+ };
int max_x = 0,
max_y = 0,
@@ -170,7 +170,7 @@ proc visualize_lisp_machine() -> void {
case Lisp_Object_Type::Keyword: {
Drawn_Area colon = draw_text(":", "#c61b6e");
write_x += colon.width;
- Drawn_Area text = draw_text(&obj->value.identifier->data, "#c61b6e");
+ Drawn_Area text = draw_text(&obj->value.symbol.identifier->data, "#c61b6e");
write_x -= colon.width;
return {
colon.x,
@@ -179,8 +179,12 @@ proc visualize_lisp_machine() -> void {
colon.height
};
}
- case Lisp_Object_Type::String: return draw_text(&obj->value.string->data, "#2aa198", true, 20);
- default: return {0};
+ case Lisp_Object_Type::String: return draw_text(&obj->value.string->data, "#2aa198", true, 20);
+ case Lisp_Object_Type::Function: return draw_text("Function", "#aa1100");
+ case Lisp_Object_Type::CFunction: return draw_text("CFunction", "#11aa00");
+ default:
+ fprintf(stderr, "Do not know hot to visualize type %d\n", Memory::get_type(obj));
+ return {0};
}
};
draw_pair = [&](Lisp_Object* pair) -> Drawn_Area {
@@ -439,7 +443,7 @@ proc visualize_lisp_machine() -> void {
draw_new_line();
write_x = start_x;
- draw_text(&symbols->data[i]->value.identifier->data);
+ draw_text(&symbols->data[i]->value.symbol.identifier->data);
}