hashmaps are now first class objects in the language

.gitignore

@@ -18,3 +18,5 @@ todo.html
 /manual/manual.tex
 *.out
 /bin/slime
+*.report
+*.svg

bin/pre.slime

@@ -1,3 +1,6 @@
+(define hm/set!   hash-map-set!)
+(define hm/get    hash-map-get)
+
 (define-syntax (pe expr)
   `(print ',expr "evaluates to" ,expr))
 

bin/pre.slime.expanded

@@ -1,3 +1,7 @@
+(define hm/set! hash-map-set!)
+
+(define hm/get hash-map-get)
+
 (define-syntax (pe expr) `(print ',expr "evaluates to" ,expr))
 
 (define-syntax (when condition . body) :doc "Special form for when multiple actions should be done if a\ncondition is true.\n\n{{{example_start}}}\n(when (not ())\n  (print "Hello ")\n  (print "from ")\n  (print "when!"))\n\n(when ()\n  (print "Goodbye ")\n  (print "World!"))\n{{{example_end}}}\n" (if (= (rest body) ()) `(if ,condition (unquote-splicing body) nil) `(if ,condition (begin (unquote-splicing body)) nil)))

bin/tests/hashmaps.slime

@@ -0,0 +1,25 @@
+
+(define hm1 (create-hash-map))
+
+(hm/set! hm1 1 "a")
+(hm/set! hm1 "a" (lambda (x) (+ x 1)))
+
+(assert (= ((hm/get hm1 (hm/get hm1 1)) 2) 3))
+
+(define hm2 (create-hash-map))
+(hm/set! hm2 'yes :yes)
+(hm/set! hm2 :yes 'yes)
+
+(assert (= (hm/get hm2 'yes) :yes))
+(assert (= (hm/get hm2 :yes) 'yes))
+(assert (= (hm/get hm2 (hm/get hm2 'yes)) 'yes))
+(assert (= (hm/get hm2 (hm/get hm2 :yes)) :yes))
+(assert (= (hm/get hm2 (hm/get hm2 (hm/get hm2 'yes))) :yes))
+(assert (= (hm/get hm2 (hm/get hm2 (hm/get hm2 :yes))) 'yes))
+
+(define hm3 (create-hash-map))
+(hm/set! hm3 + 'plus)
+(hm/set! hm3 - 'minus)
+
+(assert (= (hm/get hm3 +) 'plus))
+(assert (= (hm/get hm3 -) 'minus))

build.sh

@@ -4,7 +4,7 @@ pushd $SCRIPTPATH > /dev/null
 
 #  _DEBUG
 # time g++ -fpermissive src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1
-time clang++ -D_DEBUG -D_PROFILING src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1
+time clang++ -D_DEBUG -D_PROFILING -D_DONT_BREAK_ON_ERRORS src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1
 
 echo ""
 pushd ./bin > /dev/null

profiler_vis/test.py

@@ -17,10 +17,9 @@ def append_to_datas(thread, data):
     ensure_big_enough(datas, thread, [])
     datas[thread].append(data)
 
-with open("../bin/profiler.report", "r") as file:
+with open("../src/profiler_reports/04.10.2019-13.29.21-140737348403048-profiler.report", "r") as file:
     for line in file:
         infos = line.split()
-        thread = int(infos[0])
         if infos[1] == "->":
             incr_call_depth(thread)
             append_to_datas(thread, {

src/built_ins.cpp

@@ -26,9 +26,12 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
     case Lisp_Object_Type::Nil:    return true;
     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::HashMap:
     case Lisp_Object_Type::Pair:
     case Lisp_Object_Type::Vector:
         create_not_yet_implemented_error();
+    case Lisp_Object_Type::Symbol:
+    case Lisp_Object_Type::Keyword:
         return false;
     }
 
@@ -794,6 +797,27 @@ proc load_built_ins_into_environment() -> void {
         fetch(args);
         return args;
     };
+    define((create-hash-map), "TODO") {
+        Lisp_Object* ret;
+        try ret = Memory::create_lisp_object_hash_map();
+        return ret;
+    };
+    define((hash-map-get hm key), "TODO") {
+        fetch(hm, key);
+        try assert_type(hm,  Lisp_Object_Type::HashMap);
+
+        Lisp_Object* ret = (Lisp_Object*)hm_get_object(hm->value.hashMap, key);
+        if (!ret)
+            create_symbol_undefined_error("The key was not set in the hashmap");
+
+        return ret;
+    };
+    define((hash-map-set! hm key value), "TODO") {
+        fetch(hm, key, value);
+        try assert_type(hm,  Lisp_Object_Type::HashMap);
+        hm_set(hm->value.hashMap, key, value);
+        return Memory::nil;
+    };
     define((vector . args), "TODO") {
         fetch(args);
         Lisp_Object* ret;
@@ -855,15 +879,16 @@ proc load_built_ins_into_environment() -> void {
                 return Memory::get_or_create_lisp_object_keyword("macro");
             else return Memory::get_or_create_lisp_object_keyword("unknown");
         }
+        case Lisp_Object_Type::HashMap: return Memory::get_or_create_lisp_object_keyword("hashmap");
         case Lisp_Object_Type::Keyword: return Memory::get_or_create_lisp_object_keyword("keyword");
         case Lisp_Object_Type::Nil:     return Memory::get_or_create_lisp_object_keyword("nil");
-        case Lisp_Object_Type::T:       return Memory::get_or_create_lisp_object_keyword("t");
-        case Lisp_Object_Type::Pointer: return Memory::get_or_create_lisp_object_keyword("pointer");
         case Lisp_Object_Type::Number:  return Memory::get_or_create_lisp_object_keyword("number");
         case Lisp_Object_Type::Pair:    return Memory::get_or_create_lisp_object_keyword("pair");
-        case Lisp_Object_Type::Vector:  return Memory::get_or_create_lisp_object_keyword("vector");
+        case Lisp_Object_Type::Pointer: return Memory::get_or_create_lisp_object_keyword("pointer");
         case Lisp_Object_Type::String:  return Memory::get_or_create_lisp_object_keyword("string");
         case Lisp_Object_Type::Symbol:  return Memory::get_or_create_lisp_object_keyword("symbol");
+        case Lisp_Object_Type::T:       return Memory::get_or_create_lisp_object_keyword("t");
+        case Lisp_Object_Type::Vector:  return Memory::get_or_create_lisp_object_keyword("vector");
         }
         return Memory::get_or_create_lisp_object_keyword("unknown");
     };

src/error.cpp

@@ -21,6 +21,7 @@ proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, S
     // visualize_lisp_machine();
 
     using Globals::error;
+
     error = new(Error);
     error->type = type;
     error->message = message;
@@ -29,10 +30,14 @@ proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, S
 
 proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void {
     // HACK(Felix): the length of all error strings is 200!!!!!!!!!!
+    using Globals::error;
     
     int length = 200;
     String* formatted_string = Memory::create_string("", length);
-
+    if (error) {
+        error = new(Error);
+        error->type = type;
+    }
     int written_length;
     va_list args;
     va_start(args, format);

src/forward_decls.cpp

@@ -1,4 +1,5 @@
 // proc assert_type(Lisp_Object*, Lisp_Object_Type) -> void;
+proc lisp_object_equal(Lisp_Object*,Lisp_Object*) -> bool;
 proc built_in_load(String*) -> Lisp_Object*;
 proc built_in_import(String*) -> Lisp_Object*;
 proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void;
@@ -56,3 +57,54 @@ namespace Globals {
 #endif
     Error* error = nullptr;
 }
+
+
+inline bool hm_objects_match(char* a, char* b) {
+    return strcmp(a, b) == 0;
+}
+
+inline bool hm_objects_match(void* a, void* b) {
+    return a == b;
+}
+
+u32 hm_hash(void* ptr) {
+    return ((unsigned long long)ptr * 2654435761) % 4294967296;
+}
+
+u32 hm_hash(char* str) {
+    u32 value = str[0] << 7;
+    int i = 0;
+    while (str[i]) {
+        value = (10000003 * value) ^ str[i++];
+    }
+    return value ^ i;
+}
+
+inline bool hm_objects_match(Lisp_Object* a, Lisp_Object* b) {
+    return lisp_object_equal(a, b);
+}
+
+u32 hm_hash(Lisp_Object* obj) {
+    switch (Memory::get_type(obj)) {
+        // hash from adress: if two objects of these types have
+        // different addresses, they are different
+    case Lisp_Object_Type::CFunction:
+    case Lisp_Object_Type::Function:
+    case Lisp_Object_Type::Symbol:
+    case Lisp_Object_Type::Keyword:
+    case Lisp_Object_Type::Continuation:
+    case Lisp_Object_Type::Nil:
+    case Lisp_Object_Type::T:
+        return hm_hash((void*) obj);
+        // hash from contents: even if objects are themselved
+        // different, they cauld be equivalent:
+    case Lisp_Object_Type::Pointer: return hm_hash((void*) obj->value.pointer);
+    case Lisp_Object_Type::Number:  return hm_hash((void*) (unsigned long long)obj->value.number); // HACK(Felix): yes
+    case Lisp_Object_Type::String:  return hm_hash((char*) &obj->value.string->data);
+    case Lisp_Object_Type::Vector:
+    case Lisp_Object_Type::Pair:
+    case Lisp_Object_Type::HashMap:
+        create_not_yet_implemented_error();
+        return 0;
+    }
+}

src/io.cpp

@@ -284,6 +284,7 @@ proc print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout) -> v
     case (Lisp_Object_Type::Continuation): fputs("[continuation]", file);                               break;
     case (Lisp_Object_Type::CFunction):    fputs("[C-function]", file);                                 break;
     case (Lisp_Object_Type::Pointer):      fputs("[pointer]", file);                                    break;
+    case (Lisp_Object_Type::HashMap):      fputs("[hashmap]", file);                                    break;
     case (Lisp_Object_Type::String): {
         if (print_repr) {
             putc('\"', file);

src/lisp_object.cpp

@@ -23,6 +23,7 @@ proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* {
     case(Lisp_Object_Type::Pair):         return "pair";
     case(Lisp_Object_Type::Vector):       return "vector";
     case(Lisp_Object_Type::Pointer):      return "pointer";
+    case(Lisp_Object_Type::HashMap):      return "hashmap";
     }
     return "unknown";
 }

src/memory.cpp

@@ -227,6 +227,14 @@ namespace Memory {
         return node;
     }
 
+    proc create_lisp_object_hash_map() -> Lisp_Object* {
+        Lisp_Object* node;
+        try node = create_lisp_object();
+        set_type(node, Lisp_Object_Type::HashMap);
+        node->value.hashMap = create_Lisp_Obj_hashmap();
+        return node;
+    }
+
     proc create_lisp_object_number(double number) -> Lisp_Object* {
         Lisp_Object* node;
         try node = create_lisp_object();
@@ -321,8 +329,11 @@ namespace Memory {
     proc get_or_create_lisp_object_symbol(const char* identifier) -> Lisp_Object* {
         if (auto ret = hm_get_object(global_symbol_table, (char*)identifier))
             return (Lisp_Object*)ret;
-        else
-            return create_new_lisp_object_symbol(Memory::create_string(identifier));
+        else {
+            String* str;
+            try str = Memory::create_string(identifier);
+            return create_new_lisp_object_symbol(str);
+        }
     }
 
     proc get_or_create_lisp_object_keyword(String* keyword) -> Lisp_Object* {
@@ -335,8 +346,11 @@ namespace Memory {
     proc get_or_create_lisp_object_keyword(const char* keyword) -> Lisp_Object* {
         if (auto ret = hm_get_object(global_keyword_table, (char*)keyword))
             return (Lisp_Object*)ret;
-        else
-            return create_new_lisp_object_keyword(Memory::create_string(keyword));
+        else {
+            String* str;
+            try str = Memory::create_string(keyword);
+            return create_new_lisp_object_keyword(str);
+        }
     }
 
     proc create_lisp_object_cfunction(bool is_special) -> Lisp_Object* {

src/structs.cpp

@@ -10,31 +10,12 @@ define_array_list(int, Int);
 define_array_list(void*, Void_Ptr);
 
 // HASH MAPS
-inline bool hm_objects_match(char* a, char* b) {
-    return strcmp(a, b) == 0;
-}
-
-inline bool hm_objects_match(void* a, void* b) {
-    return a == b;
-}
-
-u32 hm_hash(void* ptr) {
-    return ((unsigned long long)ptr * 2654435761) % 4294967296;
-}
-
-u32 hm_hash(char* str) {
-    u32 value = str[0] << 7;
-    int i = 0;
-    while (str[i]) {
-        value = (10000003 * value) ^ str[i++];
-    }
-    return value ^ i;
-}
-
 define_hash_map(char*,        String);
+define_hash_map(Lisp_Object*, Lisp_Obj);
 define_hash_map(void*,        Void_Ptr);
 #define for_str_hash_map(hm)      __for_hm_generator(char*, hm)
 #define for_ptr_hash_map(hm)      __for_hm_generator(void*, hm)
+#define for_lisp_obj_hash_map(hm) __for_hm_generator(Lisp_Object*, hm)
 
 // STRUCTS
 enum struct Thread_Type {
@@ -54,6 +35,7 @@ enum struct Lisp_Object_Type {
     Vector,
     Continuation,
     Pointer,
+    HashMap,
     // OwningPointer,
     Function,
     CFunction,
@@ -171,6 +153,7 @@ struct Lisp_Object {
         cFunction*          cFunction;
         void*               pointer;
         Continuation        continuation;
+        Lisp_Obj_Hash_Map*  hashMap;
     } value;
 };
 

src/testing.cpp

@@ -607,7 +607,7 @@ proc run_all_tests() -> bool {
 
     bool result = true;
 
-    Memory::init(4096 * 4096, 1024 * 512, 4096 * 16 * 100);
+    Memory::init(200000, 10240, 409600);
     Environment* root_env = get_root_environment();
     Environment* user_env = Memory::create_child_environment(root_env);
     push_environment(user_env);
@@ -654,8 +654,9 @@ proc run_all_tests() -> bool {
     invoke_test_script("macro_expand");
     invoke_test_script("automata");
     invoke_test_script("sicp");
+    invoke_test_script("hashmaps");
 
-    // visualize_lisp_machine();
+    // Memory::print_status();
 
     return result;
 }