fixed let not coying the initial value nodes

.dir-locals.el

@@ -34,7 +34,7 @@
                    (define-key context-mode-map (kbd "<f2>") 'hydra-context/body)
 
                    (font-lock-add-keywords 'c++-mode
-                                           '(("\\<\\(if_debug\\|if_windows\\|if_linux\\)\\>" .
+                                           '(("\\<\\(if_debug\\|if_windows\\|if_linux\\|defer\\|proc\\)\\>" .
                                               font-lock-keyword-face)))))))
  (c++-mode . ((eval . (company-clang-set-prefix "main.cpp"))
               (eval . (flycheck-mode 0))

.gitignore

@@ -7,3 +7,4 @@
 *.psess
 *.vspx
 todo.html
+*.expanded

bin/tests/class_macro.slime

@@ -0,0 +1,111 @@
+(define (type-wrap obj type)
+  (set-type obj type)
+  obj)
+
+(define-syntax defclass (name members :rest body)
+  "Macro for creatating classes."
+  (define (underscore sym)
+    (string->symbol (concat-strings "_" (symbol->string sym))))
+
+  (define underscored-members (map underscore members))
+
+  ;; the wrapping let environment
+  (define let-body (list 'let (zip members underscored-members)))
+
+  ;; the body
+  (map (lambda (fun) (append let-body fun)) body)
+
+  ;; the dispatch function
+  (append let-body '(special-lambda
+                     (message :rest args)
+                     "This is the docs for the handle"
+                     (eval (extend (list message) args))))
+
+  ;; stuff it all in the constructor function
+  (list 'define
+        (pair (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members)
+        "This is the handle to an object of the class "
+        let-body))
+
+(define (make-vector3 _x _y _z)
+  "This is the handle to an object of the class "
+  (let ((x _x)
+        (y _y)
+        (z _z))
+
+    (define (get-x) x)
+    (define (get-y) y)
+    (define (get-z) z)
+
+    (define (set-x new-x) (mutate x new-x))
+    (define (set-y new-y) (mutate y new-y))
+    (define (set-z new-z) (mutate z new-z))
+
+    (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000))
+    (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac)
+    (define (add other) (make-vector3 (+ x (other get-x)) (+ y (other get-y)) (+ z (other get-z))))
+    (define (subtract other) (make-vector3 (- x (other get-x)) (- y (other get-y)) (- z (other get-z))))
+    (define (scalar-product other) (+ (* x (other get-x)) (* y (other get-y)) (* z (other get-z))))
+    (define (cross-product other) (make-vector3 (- (* y (other get-z)) (* z (other get-y))) (- (* z (other get-x)) (* x (other get-z))) (- (* x (other get-y)) (* y (other get-x)))))
+    (define (printout) (printf "[vector3] (" x y z ")"))
+
+    (special-lambda
+     (message :rest args)
+     "This is the docs for the handle"
+     (eval (extend (list message) args)))))
+
+
+;; (v1 print)
+;; (v1 length)
+;; (v1 get-x)
+;; (v1 set-x 10)
+
+(defclass vector3 (x y z)
+  (define (get-x) x)
+  (define (get-y) y)
+  (define (get-z) z)
+
+  (define (set-x new-x) (mutate x new-x))
+  (define (set-y new-y) (mutate y new-y))
+  (define (set-z new-z) (mutate z new-z))
+
+  (define (length)
+    (** (+ (* x x) (* y y) (* z z)) 0.5))
+
+  (define (scale fac)
+    (mutate x (* fac x))
+    (mutate y (* fac y))
+    (mutate z (* fac z))
+    fac)
+
+  (define (add other)
+    (make-vector3
+     (+ x (other get-x))
+     (+ y (other get-y))
+     (+ z (other get-z))))
+
+  (define (subtract other)
+    (make-vector3
+     (- x (other get-x))
+     (- y (other get-y))
+     (- z (other get-z))))
+
+  (define (scalar-product other)
+    (+ (* x (other get-x))
+       (* y (other get-y))
+       (* z (other get-z))))
+
+  (define (cross-product other)
+    (make-vector3
+     (- (* y (other get-z)) (* z (other get-y)))
+     (- (* z (other get-x)) (* x (other get-z)))
+     (- (* x (other get-y)) (* y (other get-x)))))
+
+  (define (printout)
+    (printf "[vector3] (" x  y  z ")"))
+  )
+
+(define v1 (make-vector3 1 2 3))
+(define v2 (make-vector3 3 2 1))
+
+(assert (= (v1 scalar-product v2) 10))

bin/tests/class_macro.slime.expanded

@@ -0,0 +1,12 @@
+(define (type-wrap obj type) (set-type obj type) obj)
+
+(define (make-vector3 _x _y _z) "This is the handle to an object of the class " (let ((x _x) (y _y) (z _z)) (define (get-x) x) (define (get-y) y) (define (get-z) z) (define (set-x new-x) (mutate x new-x)) (define (set-y new-y) (mutate y new-y)) (define (set-z new-z) (mutate z new-z)) (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000)) (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (define (add other) (make-vector3 (+ x (other get-x)) (+ y (other get-y)) (+ z (other get-z)))) (define (subtract other) (make-vector3 (- x (other get-x)) (- y (other get-y)) (- z (other get-z)))) (define (scalar-product other) (+ (* x (other get-x)) (* y (other get-y)) (* z (other get-z)))) (define (cross-product other) (make-vector3 (- (* y (other get-z)) (* z (other get-y))) (- (* z (other get-x)) (* x (other get-z))) (- (* x (other get-y)) (* y (other get-x))))) (define (printout) (printf "[vector3] (" x y z ")")) (special-lambda (message :rest args) "This is the docs for the handle" (eval (extend (list message) args)))))
+
+(define (make-vector3 _x _y _z) "This is the handle to an object of the class " (let ((x _x) (y _y) (z _z)) (define (get-x) x) (define (get-y) y) (define (get-z) z) (define (set-x new-x) (mutate x new-x)) (define (set-y new-y) (mutate y new-y)) (define (set-z new-z) (mutate z new-z)) (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000)) (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (define (add other) (make-vector3 (+ x (other get-x)) (+ y (other get-y)) (+ z (other get-z)))) (define (subtract other) (make-vector3 (- x (other get-x)) (- y (other get-y)) (- z (other get-z)))) (define (scalar-product other) (+ (* x (other get-x)) (* y (other get-y)) (* z (other get-z)))) (define (cross-product other) (make-vector3 (- (* y (other get-z)) (* z (other get-y))) (- (* z (other get-x)) (* x (other get-z))) (- (* x (other get-y)) (* y (other get-x))))) (define (printout) (printf "[vector3] (" x y z ")")) (special-lambda (message :rest args) "This is the docs for the handle" (eval (extend (list message) args)))))
+
+(define v1 (make-vector3 1.000000 2.000000 3.000000))
+
+(define v2 (make-vector3 3.000000 2.000000 1.000000))
+
+(assert (= (v1 scalar-product v2) 10.000000))
+

bin/tests/lexical_scope.slime

@@ -0,0 +1,16 @@
+(define (make-counter)
+  (let ((var 0))
+    (lambda ()
+      (mutate var (+ 1 var))
+      var)))
+
+(define counter1 (make-counter))
+(assert (= (counter1) 1))
+
+(define counter2 (make-counter))
+(assert (= (counter2) 1))
+
+(assert (= (counter2) 2))
+(assert (= (counter1) 2))
+(assert (= (counter1) 3))
+(assert (= (counter2) 3))

bin/tests/lexical_scope.slime.expanded

@@ -0,0 +1,18 @@
+(define (make-counter) (let ((var 0.000000)) (lambda nil (mutate var (+ 1.000000 var)) var)))
+
+(define counter1 (make-counter))
+
+(assert (= (counter1) 1.000000))
+
+(define counter2 (make-counter))
+
+(assert (= (counter2) 1.000000))
+
+(assert (= (counter2) 2.000000))
+
+(assert (= (counter1) 2.000000))
+
+(assert (= (counter1) 3.000000))
+
+(assert (= (counter2) 3.000000))
+

src/built_ins.cpp

@@ -66,7 +66,9 @@ proc load_built_ins_into_environment(Environment* env) -> void {
 
 #define cLambda [=](Lisp_Object* arguments, Environment* env) mutable -> Lisp_Object*
 #define report_error(_type) {                                         \
+        if (log_level == Log_Level::Debug) {                          \
             printf("Error occurred\nin %s:%d\n", __FILE__, __LINE__); \
+        }                                                             \
         create_error(_type, current_source_code_location);            \
         return nullptr;                                               \
     }
@@ -682,7 +684,10 @@ proc load_built_ins_into_environment(Environment* env) -> void {
 
                 Lisp_Object* value = eval_expr(rest_sym->value.pair->first, env);
 
-                define_symbol(sym, value, let_env);
+                // NOTE(Felix): We have to copy the value here because
+                // if the let body modifies the value, it would bake
+                // in... bad bad...
+                define_symbol(sym, Memory::copy_lisp_object(value), let_env);
 
                 bindings = bindings->value.pair->rest;
             }

src/defines.cpp

@@ -23,7 +23,9 @@ constexpr bool is_debug_build = false;
 #define assert(cond)                                                    \
     if_debug {                                                          \
         if (!cond) {                                                    \
+            if (log_level == Log_Level::Debug) {                        \
                 printf("Assertion failed: %s %d", __FILE__, __LINE__);  \
+            }                                                           \
             debug_break();                                              \
         }                                                               \
     } else {}                                                           \
@@ -37,7 +39,9 @@ constexpr bool is_debug_build = false;
         while (1)                                                       \
             if (1) {                                                    \
                 if(error) {                                             \
+                    if (log_level == Log_Level::Debug) {                \
                         printf("in %s:%d\n", __FILE__, __LINE__);       \
+                    }                                                   \
                     return 0;                                           \
                 }                                                       \
                 break;                                                  \
@@ -51,7 +55,9 @@ constexpr bool is_debug_build = false;
         while (1)                                                       \
             if (1) {                                                    \
                 if(error) {                                             \
+                    if (log_level == Log_Level::Debug) {                \
                         printf("in %s:%d\n", __FILE__, __LINE__);       \
+                    }                                                   \
                     return;                                             \
                 }                                                       \
                 break;                                                  \
@@ -85,6 +91,37 @@ constexpr bool is_debug_build = false;
         return ret;                                                     \
     }
 
+
+template<typename F>
+class defer_finalizer {
+    F f;
+    bool moved;
+public:
+    template<typename T>
+    defer_finalizer(T && f_) : f(std::forward<T>(f_)), moved(false) { }
+
+    defer_finalizer(const defer_finalizer &) = delete;
+
+    defer_finalizer(defer_finalizer && other) : f(std::move(other.f)), moved(other.moved) {
+        other.moved = true;
+    }
+
+    ~defer_finalizer() {
+        if (!moved) f();
+    }
+};
+
+struct {
+    template<typename F>
+    defer_finalizer<F> operator<<(F && f) {
+        return defer_finalizer<F>(std::forward<F>(f));
+    }
+} deferrer;
+
+#define TOKENPASTE(x, y) x ## y
+#define TOKENPASTE2(x, y) TOKENPASTE(x, y)
+#define defer auto TOKENPASTE2(__deferred_lambda_call, __COUNTER__) = deferrer << [&]
+
 #define console_normal "\x1B[0m"
 #define console_red    "\x1B[31m"
 #define console_green  "\x1B[32m"

src/error.cpp

@@ -39,10 +39,8 @@ proc Error_Type_to_string(Error_Type type) -> const char* {
 }
 
 proc assert_type(Lisp_Object* node, Lisp_Object_Type type) -> void {
-    if_debug {
         if (!node)
             create_error(Error_Type::Unknown_Error, nullptr);
         if (node->type == type) return;
         create_error(Error_Type::Type_Missmatch, node->sourceCodeLocation);
-    }
 }

src/testing.cpp

@@ -486,7 +486,12 @@ proc test_lexical_scope() -> testresult {
 }
 
 proc run_all_tests() -> bool {
-    // log_level = Log_Level::None;
+    Log_Level log_level_before = log_level;
+    log_level = Log_Level::None;
+    defer {
+        log_level = log_level_before;
+    };
+
     Memory::init();
     Parser::init(Memory::create_built_ins_environment());