diff --git a/.dir-locals.el b/.dir-locals.el index 9d8f3e0..d03053a 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -34,7 +34,7 @@ (define-key context-mode-map (kbd "") '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)) diff --git a/.gitignore b/.gitignore index 53f182a..f91dee2 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,4 @@ *.psess *.vspx todo.html +*.expanded diff --git a/bin/tests/class_macro.slime b/bin/tests/class_macro.slime new file mode 100644 index 0000000..6761da0 --- /dev/null +++ b/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)) diff --git a/bin/tests/class_macro.slime.expanded b/bin/tests/class_macro.slime.expanded new file mode 100644 index 0000000..1c0d9fe --- /dev/null +++ b/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)) + diff --git a/bin/tests/lexical_scope.slime b/bin/tests/lexical_scope.slime new file mode 100644 index 0000000..4f29b84 --- /dev/null +++ b/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)) diff --git a/bin/tests/lexical_scope.slime.expanded b/bin/tests/lexical_scope.slime.expanded new file mode 100644 index 0000000..aa6a62c --- /dev/null +++ b/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)) + diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 676ef33..5ef2e9b 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -65,10 +65,12 @@ proc load_built_ins_into_environment(Environment* env) -> void { Lisp_Object* evaluated_arguments; #define cLambda [=](Lisp_Object* arguments, Environment* env) mutable -> Lisp_Object* -#define report_error(_type) { \ - printf("Error occurred\nin %s:%d\n", __FILE__, __LINE__); \ - create_error(_type, current_source_code_location); \ - return nullptr; \ +#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; \ } proc defun = [&](const char* name, auto fun) { @@ -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; } diff --git a/src/defines.cpp b/src/defines.cpp index 43ee094..cdfb70d 100644 --- a/src/defines.cpp +++ b/src/defines.cpp @@ -23,39 +23,45 @@ constexpr bool is_debug_build = false; #define assert(cond) \ if_debug { \ if (!cond) { \ - printf("Assertion failed: %s %d", __FILE__, __LINE__); \ + if (log_level == Log_Level::Debug) { \ + printf("Assertion failed: %s %d", __FILE__, __LINE__); \ + } \ debug_break(); \ } \ } else {} \ #define concat_( a, b) a##b #define label(prefix, lnum) concat_(prefix,lnum) -#define try \ - if (1) \ - goto label(body,__LINE__); \ - else \ - while (1) \ - if (1) { \ - if(error) { \ - printf("in %s:%d\n", __FILE__, __LINE__); \ - return 0; \ - } \ - break; \ - } \ +#define try \ + if (1) \ + goto label(body,__LINE__); \ + else \ + while (1) \ + if (1) { \ + if(error) { \ + if (log_level == Log_Level::Debug) { \ + printf("in %s:%d\n", __FILE__, __LINE__); \ + } \ + return 0; \ + } \ + break; \ + } \ else label(body,__LINE__): -#define try_void \ - if (1) \ - goto label(body,__LINE__); \ - else \ - while (1) \ - if (1) { \ - if(error) { \ - printf("in %s:%d\n", __FILE__, __LINE__); \ - return; \ - } \ - break; \ - } \ +#define try_void \ + if (1) \ + goto label(body,__LINE__); \ + else \ + while (1) \ + if (1) { \ + if(error) { \ + if (log_level == Log_Level::Debug) { \ + printf("in %s:%d\n", __FILE__, __LINE__); \ + } \ + return; \ + } \ + break; \ + } \ else label(body,__LINE__): @@ -85,6 +91,37 @@ constexpr bool is_debug_build = false; return ret; \ } + +template +class defer_finalizer { + F f; + bool moved; +public: + template + defer_finalizer(T && f_) : f(std::forward(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 + defer_finalizer operator<<(F && f) { + return defer_finalizer(std::forward(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" diff --git a/src/error.cpp b/src/error.cpp index 854d9f3..f688849 100644 --- a/src/error.cpp +++ b/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); - } } diff --git a/src/testing.cpp b/src/testing.cpp index 75b5fb2..09fdd3e 100644 --- a/src/testing.cpp +++ b/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());