Work transfer

bin/pre.slime

@@ -5,7 +5,12 @@
   (mytry (hm/get hm key) ()))
 
 (define-syntax (pe expr)
-  `(print ',expr "evaluates to" ,expr))
+  `((begin
+      (print :end " " ',expr "evaluates to")
+      ((lambda (e)
+         (print e)
+         e) ,expr))
+    ))
 
 (define the-empty-stream ())
 
@@ -63,17 +68,15 @@ condition is false."
             (iter (rest lists)
                   (pair (first elem) l1)
                   (pair (first (rest elem)) l2))
-          (list l1 l2))))
+          (list l1 l2)))
-    (iter lists () ()))
+      (iter lists () ())))
-
   (define unzipped (unzip bindings))
-
   `((,lambda ,(first unzipped) ,@body) ,@(first (rest unzipped))))
 
 (define-syntax (cond . clauses)
   (define (rec clauses)
-    (if (= nil clauses)
+    (if (= () clauses)
-        nil
+        ()
       (if (= (first (first clauses)) 'else)
           (begin
            (if (not (= (rest clauses) ()))
@@ -84,7 +87,6 @@ condition is false."
            ,(rec (rest clauses))))))
   (rec clauses))
 
-
 (define-syntax (case var . clauses)
   (define (rec clauses)
     (if (= nil clauses)
@@ -163,14 +165,30 @@ condition is false."
     (eval `(begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body))
     (pair 'begin
           (map (lambda (orig-export-name)
-                 (let ((export-name (string->symbol
+                 ((lambda (export-name)
+                   `(define ,export-name
+                      ,(eval orig-export-name)))
+                  (string->symbol
                    (concat-strings module-prefix
                                    (symbol->string orig-export-name)))))
-                   `(define ,export-name
-                      ,(mytry (eval orig-export-name)
-                              (error :module-error "The module does not contain a key it tries to export")))))
                exports))))
 
+(define (tdefine-module module-name (:imports ()) (:exports ()) . body)
+  (let ((module-prefix (concat-strings (symbol->string module-name) "::"))
+        (exec          `(begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body)))
+    (eval exec)
+    (enable-debug-log)
+    (pair begin
+          (map (lambda (orig-export-name)
+                 ((lambda (export-name)
+                   `(define ,export-name
+                      ,(eval orig-export-name)))
+                  (string->symbol
+                   (concat-strings module-prefix
+                                   (symbol->string orig-export-name)))))
+               exports))
+    (disable-debug-log)
+    ))
 
 (define-syntax (generic-extend args . body)
   (let ((fun-name (first args))
@@ -455,25 +473,6 @@ added to a list, which in the end is returned."
             (enumerate-inner (rest seq) (+ 1 next-num)))))
   (enumerate-inner seq 0))
 
-;; (define (print (:sep " ") (:end "\n") . args)
-;;   "A  wrapper for  the built-in  function [[=print=]]  that accepts  a
-;; variable number of arguments and also provides keywords for specifying
-;; the printed separators  (=sep=) between the arguments  and what should
-;; be printed after the last argument (=end=)."
-;;   (define (print-inner args)
-;;     (if args
-;;         (begin
-;;          (print (first args))
-;;          (when (rest args)
-;;            (print sep))
-;;          (print-inner (rest args)))
-;;       ; else
-;;       (print end)))
-
-;;   (print-inner args)
-;;   ())
-
-
 
 ;; (generic-extend (+ v1 :vector v2 :vector)
 ;;    (assert (= (vector-length v1)

bin/tests/modules.slime

@@ -10,4 +10,13 @@
 ;; (assert (= math::pi 3.1415))
 ;; (assert (= math::tau (* 2 math::tau)))
 
-(1 2 3)
+
+(tdefine-module 'math
+  :exports
+  '(pi tau pow sqrt)
+
+  '(define pi 3.1415)
+  '(define tau (* 2 pi))
+  '(define (pow a b) (** a b))
+  '(define (sqrt a) (** a 0.5)))
+

bin/tests/sicp.slime

@@ -1,3 +1,4 @@
+
 ;; (define (abs x)
 ;;   (cond ((< x 0) (- x))
 ;;         (else x)))
@@ -6,10 +7,10 @@
 ;; (assert (= (abs (- 2)) 2))
 
 
-(define (abs x)
+;; (define (abs x)
-  (if (< x 0)
+  ;; (if (< x 0)
-      (- x)
+      ;; (- x)
-    x))
+    ;; x))
 
 ;; (assert (= (abs 12) 12))
 ;; (assert (= (abs (- 32)) 32))
@@ -40,8 +41,8 @@
 ;; (assert (= (a-plus-abs-b 1  2) 3))
 ;; (assert (= (a-plus-abs-b 1 -2) 3))
 
-(define (square x) (* x x))
+;; (define (square x) (* x x))
-(define (cube x) (* x x x))
+;; (define (cube x) (* x x x))
 
 ;; (assert (= ((lambda (x y z)
 ;;               (+ x y (square z)))
@@ -57,8 +58,8 @@
 ;; (define (square x)
 ;;   (* x x))
 
-(define (average x y)
+;; (define (average x y)
-  (/ (+ x y) 2))
+  ;; (/ (+ x y) 2))
 
 ;; (define (improve guess x)
 ;;   (average guess (/ x guess)))
@@ -119,30 +120,30 @@
 ;; ;;;     factorial
 ;; ;;; -----------------
 
-(define (factorial n)
+;; (define (factorial n)
-  (if (= n 1)
+;;   (if (= n 1)
-      1
+;;       1
-    (* n (factorial (- n 1)))))
+;;     (* n (factorial (- n 1)))))
 
-(define (factorial2 n)
+;; (define (factorial2 n)
-  (fact-iter 1 1 n))
+;;   (fact-iter 1 1 n))
 
-(define (fact-iter product counter max-count)
+;; (define (fact-iter product counter max-count)
-  (if (> counter max-count)
+;;   (if (> counter max-count)
-      product
+;;       product
-    (fact-iter (* counter product) (+ counter 1) max-count)))
+;;     (fact-iter (* counter product) (+ counter 1) max-count)))
 
-(define (factorial3 n)
+;; (define (factorial3 n)
-  (define (iter product counter)
+;;   (define (iter product counter)
-    (if (> counter n)
+;;     (if (> counter n)
-        product
+;;         product
-      (iter (* counter product) (+ counter 1))))
+;;       (iter (* counter product) (+ counter 1))))
 
-  (iter 1 1))
+;;   (iter 1 1))
 
-(assert (= (factorial  6) 720))
+;; (assert (= (factorial  6) 720))
-(assert (= (factorial2 6) 720))
+;; (assert (= (factorial2 6) 720))
-(assert (= (factorial3 6) 720))
+;; (assert (= (factorial3 6) 720))
 
 ;;; ----------------
 ;;;     ackermann
@@ -153,6 +154,13 @@
           ((= n 0) (A (- m 1) 1))
           (else (A (- m 1) (A m (- n 1))))))
 
+;; (define (A m n)
+  ;; (if (= m 0)
+      ;; (+ n 1)
+    ;; (if (= n 0)
+        ;; (A (- m 1) 1)
+      ;; (A (- m 1) (A m (- n 1))))))
+
 (assert (= (A 0 0) 1))
 (assert (= (A 1 2) 4))
 (assert (= (A 3 1) 13))

bin/tests/simple_built_ins.slime

@@ -0,0 +1,58 @@
+;;
+;; let testing
+;;
+(assert (not (bound? var1)))
+(assert (not (bound? var2)))
+(assert (not (bound? var3)))
+(let ((var1 1)
+      (var2 [1 2 3])
+      (var3 {1 2 3 4}))
+  (assert (bound? var1))
+  (assert (bound? var2))
+  (assert (bound? var3))
+  (assert (= var1 1))
+  (assert (= var2 [1 2 3]))
+  (assert (= var3 {1 2 3 4})))
+
+(assert (not (bound? var1)))
+(assert (not (bound? var2)))
+(assert (not (bound? var3)))
+
+(assert (= (let ((val 'sym))
+             val)
+           'sym))
+
+(assert (= (let ()
+             'sym)
+           'sym))
+;;
+;; Quasiquote testing
+;;
+(assert (= '() `()))
+
+(assert (= '(1 1 2)
+           `(1 1 2)))
+
+(assert (= '(1  1 2)
+           `(1 ,1 2)))
+
+(assert (= '(1  1        2)
+           `(1 ,(- 10 9) 2)))
+
+(assert (= '(1 1 2)
+           `(1 ,@(list 1 2))))
+
+(let ((body '(2 3)))
+  (assert (= '(1 2 3)
+             `(1 ,@body))))
+
+(let ((body    '((define a 1)
+                 (define b 2)))
+      (imports '()))
+  (let ((expr `(begin ,@(map (lambda (x) `(import ,x)) imports) ,@body)))
+    (assert (= '(begin
+                 (define a 1)
+                 (define b 2))))
+    (eval expr)
+    (assert (= a 1))
+    (assert (= b 2))))

build.sh

@@ -2,13 +2,13 @@ TIMEFORMAT=%3lU
 SCRIPTPATH="$( cd "$(dirname "$0")" ; pwd -P )"
 pushd $SCRIPTPATH > /dev/null
 
-echo ""
+# echo ""
-echo "----------------------"
+# echo "----------------------"
-echo "  compiling libslime  "
+# echo "  compiling libslime  "
-echo "----------------------"
+# echo "----------------------"
-time clang++ --std=c++17 \
+# time clang++ --std=c++17 \
-        src/libslime.cpp -c -o libslime.o \
+#         src/libslime.cpp -c -o libslime.o \
-        -I3rd/ || exit 1
+#         -I3rd/ || exit 1
 
 echo ""
 echo "------------------------------"
@@ -18,13 +18,13 @@ time clang++ -D_DEBUG -D_DONT_BREAK_ON_ERRORS \
      src/main.cpp -gfull -gdwarf -o ./bin/slime_d --std=c++17 \
      -I3rd/ || exit 1
 
-echo ""
+# echo ""
-echo "--------------------------------"
+# echo "--------------------------------"
-echo " compiling fullslime  (release) "
+# echo " compiling fullslime  (release) "
-echo "--------------------------------"
+# echo "--------------------------------"
-time clang++ -D_DONT_BREAK_ON_ERRORS -O3  \
+# time clang++ -D_DONT_BREAK_ON_ERRORS -O3  \
-     src/main.cpp -g -o ./bin/slime --std=c++17 \
+#      src/main.cpp -g -o ./bin/slime --std=c++17 \
-     -I3rd/ || exit 1
+#      -I3rd/ || exit 1
 
 pushd ./bin > /dev/null
 
@@ -40,11 +40,11 @@ echo "    running tests     "
 echo "----------------------"
 time valgrind -q --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime_d --run-tests || exit 1
 
-echo ""
+# echo ""
-echo "------------------------"
+# echo "------------------------"
-echo "    running benches     "
+# echo "    running benches     "
-echo "------------------------"
+# echo "------------------------"
-hyperfine -s color --warmup 5 "./slime --run-tests > /dev/null"
+# hyperfine -s color --warmup 5 "./slime --run-tests > /dev/null"
 
 popd > /dev/null
 # popd > /dev/null

src/assert.hpp

@@ -22,19 +22,22 @@
 #define create_symbol_undefined_error(...)              \
     __create_error("symbol-undefined", __VA_ARGS__)
 
-#define create_type_missmatch_error(expected, actual)           \
+#define create_type_missmatch_error(expected, actual, exp)            \
     __create_error("type-missmatch",                                  \
-                   "Type missmatch: expected %s, got %s",       \
+                   "Type missmatch: expected %s, got %s in %s",       \
-                   expected, actual)
+                   expected, actual, exp)
 
 #ifdef _DEBUG
 
 #define assert_type(_node, _type)                                       \
     do {                                                                \
         if (Memory::get_type(_node) != _type) {                         \
+            char* t = lisp_object_to_string(_node);                     \
+            defer { free(t); };                                         \
             create_type_missmatch_error(                                \
                 Lisp_Object_Type_to_string(_type),                      \
-                Lisp_Object_Type_to_string(Memory::get_type(_node)));   \
+                Lisp_Object_Type_to_string(Memory::get_type(_node)),    \
+                t);                                                     \
         }                                                               \
     } while(0)
 

src/built_ins.cpp

@@ -22,9 +22,40 @@ namespace Slime {
             return lisp_object_equal(n1->value.pair.first, n2->value.pair.first) &&
                 lisp_object_equal(n1->value.pair.rest, n2->value.pair.rest);
         } break;
-        case Lisp_Object_Type::HashMap:
+        case Lisp_Object_Type::HashMap: {
-        case Lisp_Object_Type::Vector:
+            auto n1_keys = n1->value.hashMap->get_all_keys();
-            create_not_yet_implemented_error();
+            auto n2_keys = n2->value.hashMap->get_all_keys();
+            defer {
+                n1_keys.dealloc();
+                n2_keys.dealloc();
+            };
+
+            if (n1_keys.next_index != n2_keys.next_index)
+                return false;
+
+            n1_keys.sort();
+            n2_keys.sort();
+
+            for (int i = 0; i < n1_keys.next_index; ++i) {
+                if (!lisp_object_equal(n1_keys[i], n2_keys[i]))
+                    return false;
+                if (!lisp_object_equal(n1->value.hashMap->get_object(n1_keys[i]),
+                                       n2->value.hashMap->get_object(n2_keys[i])))
+                    return false;
+            }
+            return true;
+
+        }
+        case Lisp_Object_Type::Vector: {
+            if (n1->value.vector.length != n2->value.vector.length )
+                return false;
+            for (int i = 0; i < n1->value.vector.length; ++i) {
+                if (!lisp_object_equal(n1->value.vector.data+i, n2->value.vector.data+i))
+                    return false;
+            }
+            return true;
+        } break;
+        default: create_not_yet_implemented_error();
         }
 
         // we should never reach here
@@ -234,6 +265,32 @@ namespace Slime {
             profile_with_name("(helper)");
             return Memory::create_lisp_object(101.0);
         };
+        define((enable-debug-log), "") {
+            profile_with_name("(enable-debug-log)");
+            Globals::debug_log = true;
+            return Memory::t;
+        };
+        define((disable-debug-log), "") {
+            profile_with_name("(disable-debug-log)");
+            Globals::debug_log = false;
+            return Memory::t;
+        };
+        define_special((with-debug-log . rest), "") {
+            profile_with_name("(enable-debug-log)");
+            fetch(rest);
+            Lisp_Object* result;
+            Globals::debug_log = true;
+            in_caller_env {
+                for_lisp_list(rest) {
+                    // TODO(Felix): hooky would be really nice to
+                    // have. Then this would be a macro and we would
+                    // reset the debug log
+                    try result = eval_expr(it);
+                }
+            }
+            Globals::debug_log = false;
+            return result;
+        };
         define((test (:k (helper))), "") {
             profile_with_name("(test)");
             fetch(k);
@@ -437,7 +494,9 @@ namespace Slime {
             fetch(test);
 
             in_caller_env {
-                if (is_truthy(nrc_eval(test)))
+                Lisp_Object* res;
+                try res = eval_expr(test);
+                if (is_truthy(res))
                     return Memory::t;
             }
 
@@ -970,7 +1029,7 @@ namespace Slime {
             profile_with_name("(show)");
             fetch(n);
             try assert_type(n, Lisp_Object_Type::Function);
-            try assert(n->value.function->is_c);
+            try assert(!n->value.function->is_c);
             puts("body:\n");
             print(n->value.function->body.lisp_body);
             puts("\n");

src/eval.cpp

@@ -6,10 +6,11 @@ namespace Slime {
         Array_List<Lisp_Object*>* cs,
         Lisp_Object* function,
         int arg_start,
-        int arg_count) -> Environment*
+        int arg_end) -> Environment*
     {
         profile_this();
 
+        int arg_pos = arg_start;
         bool is_c_function = function->value.function->is_c;
         Environment* new_env = Memory::create_child_environment(function->value.function->parent_environment);
         Arguments* arg_spec = &function->value.function->args;
@@ -40,19 +41,23 @@ namespace Slime {
         int obligatory_keywords_count = 0;
         int read_obligatory_keywords_count = 0;
 
-        Lisp_Object* next_arg = cs->data[arg_start];
+        Lisp_Object* next_arg = cs->data[arg_pos];
 
         proc read_positional_args = [&] {
             for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
-                if (arg_count == 0) {
+                sym = arg_spec->positional.symbols.data[i];
-                    create_parsing_error("Wrong number of arguments.");
+                if (arg_pos == arg_end) {
+                    create_parsing_error(
+                        "Not enough positional args supplied. Needed: %d suppied, %d.\n"
+                        "Next missing arg is '%s'",
+                        arg_spec->positional.symbols.next_index, arg_end-arg_pos,
+                        &sym->value.symbol->data);
                     return;
                 }
                 // NOTE(Felix): We have to copy all the arguments,
                 // otherwise we change the program code.
                 // XXX(Felix): T C functions we pass by reference.
                 // TODO(Felix): Why did we decide this??
-                sym = arg_spec->positional.symbols.data[i];
                 if (is_c_function) {
                     define_symbol(sym, next_arg);
                 } else {
@@ -60,8 +65,7 @@ namespace Slime {
                         sym,
                         Memory::copy_lisp_object_except_pairs(next_arg));
                 }
-                next_arg = cs->data[++arg_start];
+                next_arg = cs->data[++arg_pos];
-                --arg_count;
             }
         };
 
@@ -72,7 +76,7 @@ namespace Slime {
             // something that is not a keyword is encountered or a keyword
             // that is not recognized is encoutered, jump out of the loop.
 
-            if (arg_count == 0) {
+            if (arg_pos == arg_end) {
                 return;
             }
 
@@ -129,7 +133,7 @@ namespace Slime {
                 // 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 (arg_count == 0) {
+                if (arg_pos == arg_end) {
                     create_generic_error(
                         "Attempting to set the keyword argument ':%s', but no value was supplied.",
                         &(next_arg->value.symbol->data));
@@ -139,8 +143,7 @@ namespace Slime {
                 // if not set it and then add it to the array list
                 Lisp_Object* key = next_arg;
                 try_void sym = Memory::get_symbol(key->value.symbol);
-                next_arg = cs->data[++arg_start];
+                next_arg = cs->data[++arg_pos];
-                --arg_count;
 
                 // NOTE(Felix): It seems we do not need to evaluate the argument here...
                 if (is_c_function) {
@@ -154,10 +157,9 @@ namespace Slime {
                 ++read_obligatory_keywords_count;
 
                 // overstep both for next one
-                next_arg = cs->data[++arg_start];
+                next_arg = cs->data[++arg_pos];
-                --arg_count;
 
-                if (arg_count == 0) {
+                if (arg_pos == arg_end) {
                     break;
                 }
             }
@@ -200,7 +202,7 @@ namespace Slime {
         };
 
         proc read_rest_arg = [&]() -> void {
-            if (arg_count == 0) {
+            if (arg_pos == arg_end) {
                 if (arg_spec->rest) {
                     define_symbol(arg_spec->rest, Memory::nil);
                 }
@@ -210,13 +212,10 @@ namespace Slime {
                     Lisp_Object* list;
                     try_void list = Memory::create_list(next_arg);
                     Lisp_Object* head = list;
-                    next_arg = cs->data[++arg_start];
+                    for (++arg_pos;arg_pos < arg_end; ++arg_pos) {
-                    --arg_count;
+                        next_arg = cs->data[arg_pos];
-                    while (arg_count > 0) {
                         try_void head->value.pair.rest = Memory::create_list(next_arg);
                         head = head->value.pair.rest;
-                        next_arg = cs->data[++arg_start];
-                        --arg_count;
                     }
                     define_symbol(arg_spec->rest, list);
                 } else {
@@ -346,7 +345,7 @@ namespace Slime {
         if (node == Memory::nil)
             return 0;
 
-        assert_type(node, Lisp_Object_Type::Pair);
+        try assert_type(node, Lisp_Object_Type::Pair);
 
         int len = 0;
 
@@ -380,7 +379,7 @@ namespace Slime {
             return Memory::create_lisp_object_pair(begin_symbol, body);
     }
 
-    proc nrc_eval(Lisp_Object* expr) -> Lisp_Object* {
+    proc eval_expr(Lisp_Object* expr) -> Lisp_Object* {
         using namespace Globals::Current_Execution;
 
         nass.reserve(1);
@@ -392,12 +391,13 @@ namespace Slime {
         };
 
         proc debug_step = [&] {
+            if (!Globals::debug_log)
                 return;
-            // printf("%d\n", cs.next_index);
+            printf("\n-------------------\ncs:\n ");
-            printf("cs:\n ");
+            for (int i = 0; i < cs.next_index; ++i)  {
-            for (auto lo : cs)  {
+                char* t = lisp_object_to_string(cs.data[i], true);
-                print(lo, true);
+                printf(" %d: %s\n ", i, t);
-                printf("\n ");
+                defer { free(t); };
             }
             printf("\npcs:\n ");
             for (auto lo : pcs)  {
@@ -506,8 +506,12 @@ namespace Slime {
                     }
                 } break;
                 default: {
-                    create_generic_error("The first element of the pair was not a function but: %s",
+                    char* t = lisp_object_to_string(pc);
-                                         Lisp_Object_Type_to_string(type));
+                    defer {
+                        free(t);
+                    };
+                    create_generic_error("The first element of the pair was not a function but: %s in %s",
+                                         Lisp_Object_Type_to_string(type), t);
                     return nullptr;
                 }
                 }
@@ -518,10 +522,11 @@ namespace Slime {
                     --pcs.next_index;
                     int am = ams.data[--ams.next_index];
                     Lisp_Object* function = cs.data[am];
-                    assert_type(function, Lisp_Object_Type::Function);
+                    try assert_type(function, Lisp_Object_Type::Function);
-                    Environment* extended_env =
+
-                        create_extended_environment_for_function_application_nrc(
+                    Environment* extended_env;
-                            &cs, function, am+1, cs.next_index-am-1);
+                    try extended_env = create_extended_environment_for_function_application_nrc(
+                            &cs, function, am+1, cs.next_index);
                     cs.next_index = am;
                     push_environment(extended_env);
                     if (function->value.function->is_c) {
@@ -572,10 +577,6 @@ namespace Slime {
         return cs.data[--cs.next_index];
     }
 
-    proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
-        return nrc_eval(node);
-    }
-
     proc is_truthy(Lisp_Object* expression) -> bool {
         Lisp_Object* result;
         try result = eval_expr(expression);
@@ -607,12 +608,12 @@ namespace Slime {
             line = read_expression();
             try_void parsed = Parser::parse_single_expression(line);
             free(line);
-            try_void evaluated = nrc_eval(parsed);
+            try_void evaluated = eval_expr(parsed);
             // try_void evaluated = eval_expr(parsed);
-            if (evaluated != Memory::nil) {
+            if (evaluated && evaluated != Memory::nil) {
                 print(evaluated);
+            }
             fputs("\n", stdout);
         }
     }
 }
-}

src/forward_decls.cpp

@@ -16,7 +16,7 @@ namespace Slime {
 
     Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*);
     void define_symbol(Lisp_Object* symbol, Lisp_Object* value);
-    char* lisp_object_to_string(Lisp_Object* node, bool print_repr);
+    char* lisp_object_to_string(Lisp_Object* node, bool print_repr = true);
     void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
     void print_environment(Environment*);
 
@@ -73,6 +73,7 @@ namespace Slime {
     }
 
     namespace Globals {
+        extern bool debug_log;
         extern char* bin_path;
         extern Log_Level log_level;
         extern Array_List<void*> load_path;

src/globals.cpp

@@ -1,7 +1,7 @@
 namespace Slime::Globals {
     char* bin_path = nullptr;
     Log_Level log_level = Log_Level::Debug;
-
+    bool debug_log = false;
     Array_List<void*> load_path;
     namespace Current_Execution {
         Array_List<Lisp_Object*>            cs;

src/io.cpp

@@ -366,15 +366,10 @@ namespace Slime {
             return temp;
         }
         case (Lisp_Object_Type::String): {
-            asprintf(&temp, "%s", Memory::get_c_str(node->value.symbol));
             if (print_repr) {
                 char* escaped = escape_string(Memory::get_c_str(node->value.string));
-                string_builder.append(strdup("\""));
+                asprintf(&temp, "\"%s\"", escaped);
-                string_builder.append(escaped);
-                string_builder.append(strdup("\""));
                 free(escaped);
-                temp = string_buider_to_string(string_builder);
-                // TODO free
                 return temp;
             } else
                 return strdup(Memory::get_c_str(node->value.string));
@@ -401,12 +396,16 @@ namespace Slime {
                 return temp;
             }
             if (node->value.function->is_c) {
+                // NOTE(Felix): try to find the symbol it is bound to
+                // in global env
+                Lisp_Object* name = (Lisp_Object*)(get_root_environment()->hm.search_key_to_object(node));
                 switch (node->value.function->type.c_function_type) {
-                case C_Function_Type::cFunction: return strdup("[c-function]");
+                case C_Function_Type::cFunction: asprintf(&temp, "[c-function %s]",&((Lisp_Object*)name)->value.symbol->data); break;
-                case C_Function_Type::cSpecial:  return strdup("[c-special]");
+                case C_Function_Type::cSpecial:  asprintf(&temp, "[c-special %s]", &((Lisp_Object*)name)->value.symbol->data); break;
-                case C_Function_Type::cMacro:    return strdup("[c-macro]");
+                case C_Function_Type::cMacro:    asprintf(&temp, "[c-macro %s]",   &((Lisp_Object*)name)->value.symbol->data); break;
                 default:                         return strdup("[c-??]");
                 }
+                return temp;
             } else {
                 switch (node->value.function->type.lisp_function_type) {
                 case Lisp_Function_Type::Lambda: return strdup("[lambda]");
@@ -448,7 +447,6 @@ namespace Slime {
                     assert(head->value.pair.rest->value.pair.rest == Memory::nil);
 
                     string_builder.append(lisp_object_to_string(head->value.pair.rest->value.pair.first, print_repr));
-                    temp = string_buider_to_string(string_builder);
                     return string_buider_to_string(string_builder);
                 } else if (symbol == quasiquote_sym) {
                     string_builder.append(strdup("`"));
@@ -485,9 +483,12 @@ namespace Slime {
     }
 
     proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
-        char* string = lisp_object_to_string(node, print_repr);
+        char* string = nullptr;
-        fputs(string, file);
+        defer {
             free(string);
+        };
+        string = lisp_object_to_string(node, print_repr);
+        fputs(string, file);
     }
 
     proc print_single_call(Lisp_Object* obj) -> void {

src/lisp_object.cpp

@@ -33,9 +33,6 @@ namespace Slime {
         sourceCodeLocation = 0;
 
         switch (Memory::get_type(this)) {
-        case Lisp_Object_Type::HashMap: {
-            delete this->value.hashMap;
-        } break;
         case Lisp_Object_Type::Function:{
             this->value.function->args.positional.symbols.dealloc();
             this->value.function->args.keyword.keywords.dealloc();

src/memory.cpp

@@ -18,6 +18,16 @@ namespace Slime::Memory {
     // ------------------
     Bucket_Allocator<Environment> environment_memory(1024, 8);
 
+    // NOTE(Felix): we are doing hashmaps separately so we don't have
+    // to malloc them every time, and if two lisp objects have the
+    // same hashmap, it will not cause double free problems when
+    // freeing all at the end. It also plays nice with garbage
+    // collection
+    // ------------------
+    //   Hashmaps
+    // ------------------
+    Bucket_Allocator<Hash_Map<Lisp_Object*, Lisp_Object*>> hashmap_memory(256, 8);
+
     // ------------------
     //   strings
     // ------------------
@@ -140,17 +150,23 @@ namespace Slime::Memory {
         });
         environment_memory.for_each([](Environment* env){
             env->parents.dealloc();
-            env->~Environment();
+            env->hm.dealloc();
+        });
+        hashmap_memory.for_each([](Hash_Map<Lisp_Object*, Lisp_Object*>* hm){
+            hm->dealloc();
         });
         // free the exe dir:
         free(Globals::load_path.data[0]);
         Globals::load_path.dealloc();
-        // Globals::Current_Execution::call_stack.dealloc();
         Globals::Current_Execution::envi_stack.dealloc();
         Globals::Current_Execution::cs.dealloc();
         Globals::Current_Execution::ams.dealloc();
         Globals::Current_Execution::pcs.dealloc();
         Globals::Current_Execution::nass.dealloc();
+
+        global_symbol_table.dealloc();
+        global_keyword_table.dealloc();
+        file_to_env_map.dealloc();
     }
 
 
@@ -160,6 +176,7 @@ namespace Slime::Memory {
 
         // inject a new array list;
         env->parents.alloc();
+        env->hm.alloc();
         if (parent)
             env->parents.append(parent);
 
@@ -179,7 +196,11 @@ namespace Slime::Memory {
         char* exe_path = get_exe_dir();
         // don't free exe path because it will be used until end of time
         Globals::load_path.alloc();
-        // Globals::Current_Execution::call_stack.alloc();
+
+        global_symbol_table.alloc();
+        global_keyword_table.alloc();
+        file_to_env_map.alloc();
+
         Globals::Current_Execution::envi_stack.alloc();
         Globals::Current_Execution::cs.alloc();
         Globals::Current_Execution::nass.alloc();
@@ -223,13 +244,13 @@ namespace Slime::Memory {
 
         free_spots_in_string_memory.next_index      = 0;
 
-        global_symbol_table.~Hash_Map();
+        global_symbol_table.dealloc();
-        global_keyword_table.~Hash_Map();
+        global_keyword_table.dealloc();
-        file_to_env_map.~Hash_Map();
+        file_to_env_map.dealloc();
 
-        new(&global_symbol_table)  Hash_Map<char*, Lisp_Object*>;
+        global_symbol_table.alloc();
-        new(&global_keyword_table) Hash_Map<char*, Lisp_Object*>;
+        global_keyword_table.alloc();
-        new(&file_to_env_map)      Hash_Map<char*, Lisp_Object*>;
+        file_to_env_map.alloc();
 
         try_void Parser::standard_in = create_string("stdin");
 
@@ -283,7 +304,8 @@ namespace Slime::Memory {
         Lisp_Object* node;
         try node = create_lisp_object();
         set_type(node, Lisp_Object_Type::HashMap);
-        node->value.hashMap = new Hash_Map<Lisp_Object*, Lisp_Object*>;
+        node->value.hashMap = hashmap_memory.allocate();
+        node->value.hashMap->alloc();
         return node;
     }
 

src/structs.cpp

@@ -112,10 +112,6 @@ namespace Slime {
     struct Environment {
         Array_List<Environment*> parents;
         Hash_Map<void*, Lisp_Object*> hm;
-
-        ~Environment() {
-            hm.~Hash_Map();
-        }
     };
 
     struct Function {

src/testing.cpp

@@ -628,9 +628,8 @@ namespace Slime {
         invoke_test_script("import_and_load");
         invoke_test_script("macro_expand");
         invoke_test_script("sicp");
-        // invoke_test_script("modules");
+        invoke_test_script("simple_built_ins");
-
+        invoke_test_script("modules");
-
         // invoke_test_script("class_macro");
         // invoke_test_script("automata");
         // invoke_test_script("alists");

todo.org

@@ -1,8 +1,18 @@
-* TODO rename slime to plisk
+* TODO update header files
+* TODO use better type names: u32, ..
+* TODO write and/or as macros
+* TODO docs as a external dict to make LO smaller
+* TODO doc generation
+* TODO function let
+(let fac ([n 10])
+    (if (zero? n)
+        1
+      (* n (fac (sub1 n)))))
+3628800
+* TODO runHook NAS_Action 
+* TODO consisitent names (Lisp_Object_Type_to_string .. lisp_object_to_string)
 * TODO rename modifying functions to prefix '!'
-* TODO go through sicp and use the examples as test files
+* TODO rename slime to plisk
-
-* TODO test macro expanding to macro
 * TODO BUG 1: eval dot notation
 #+BEGIN_SRC lisp
   (eval `(+ . ,(list 1 2 3)))