fixed the tests with new args

bin/oo.slime

@@ -1,8 +1,8 @@
-(define-syntax (define-class name-and-members :rest body)
+(define-syntax (define-class name-and-members . body)
   "Macro for creating simple classes."
   (let ((name    (first name-and-members))
         (members (rest name-and-members)))
-    `(set-type
+    `(set-type!
       (define
         ;; The function definition
         (,(string->symbol (concat-strings "make-" (symbol->string name))) @members)
@@ -11,8 +11,8 @@
         ;; the body
         @body
         (let ,(zip members members)
-          (set-type
-           (lambda (:rest args)
+          (set-type!
+           (lambda args
              "This is the docs for the handle"
              (let ((op (eval (first args))))
                (if (callable? op)
@@ -21,6 +21,5 @@
            ,(symbol->keyword name))))
       :constructor)))
 
-(define-syntax (-> obj meth :rest args)
+(define-syntax (-> obj meth . args)
   `(,obj ',meth @args))
-

bin/pre.slime

@@ -36,7 +36,6 @@ condition is false."
 
 (define-syntax (let bindings . body)
   (define (unzip lists)
-    (break)
     (when lists
       (define (iter lists l1 l2)
         (define elem (first lists))
@@ -45,7 +44,6 @@ condition is false."
                   (pair (first elem) l1)
                   (pair (first (rest elem)) l2))
           (list l1 l2))))
-
     (iter lists () ()))
 
   (define unzipped (unzip bindings))
@@ -152,7 +150,7 @@ ithe sequence as arguemens."
                                      (concat-strings module-prefix
                                                      (symbol->string orig-export-name)))))
                    `(define ,export-name
-                      ,(try (eval orig-export-name)
+                      ,(mytry (eval orig-export-name)
                             (error "The module does not contain" orig-export-name)))))
                exports))))
 

bin/pre.slime.expanded

@@ -6,7 +6,7 @@
 
 (define-syntax (n-times times action) :doc "Executes action times times." (define (repeat times elem) (unless (> 1 times) (pair elem (repeat (- times 1) elem)))) `(begin (unquote-splicing (repeat times action))))
 
-(define-syntax (let bindings . body) (define (unzip lists) (break) (when lists (define (iter lists l1 l2) (define elem (first lists)) (if elem (iter (rest lists) (pair (first elem) l1) (pair (first (rest elem)) l2)) (list l1 l2)))) (iter lists () ())) (define unzipped (unzip bindings)) `((,lambda ,(first unzipped) (unquote-splicing body)) (unquote-splicing (first (rest unzipped)))))
+(define-syntax (let bindings . body) (define (unzip lists) (when lists (define (iter lists l1 l2) (define elem (first lists)) (if elem (iter (rest lists) (pair (first elem) l1) (pair (first (rest elem)) l2)) (list l1 l2)))) (iter lists () ())) (define unzipped (unzip bindings)) `((,lambda ,(first unzipped) (unquote-splicing body)) (unquote-splicing (first (rest unzipped)))))
 
 (define-syntax (cond . clauses) (define (rec clauses) (if (= nil clauses) nil (if (= (first (first clauses)) 'else) (begin (if (not (= (rest clauses) ())) (error "There are additional clauses after the else clause!") (pair 'begin (rest (first clauses))))) `(if ,(first (first clauses)) (begin (unquote-splicing (rest (first clauses)))) ,(rec (rest clauses)))))) (rec clauses))
 
@@ -20,7 +20,7 @@
 
 (define-syntax (define-typed args . body) (define (get-arg-names args) (when args (pair (first args) (get-arg-names (rest (rest args)))))) (let ((name (first args)) (lambda-list (rest args)) (arg-names (get-arg-names (rest args)))) `(define (,name (unquote-splicing arg-names)) (assert-types= (unquote-splicing lambda-list)) (unquote-splicing body))))
 
-(define-syntax (define-module module-name :exports . body) (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) (eval `(begin (unquote-splicing body))) (pair 'begin (map (lambda (orig-export-name) (let ((export-name (string->symbol (concat-strings module-prefix (symbol->string orig-export-name))))) `(define ,export-name ,(try (eval orig-export-name) (error "The module does not contain" orig-export-name))))) exports))))
+(define-syntax (define-module module-name :exports . body) (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) (eval `(begin (unquote-splicing body))) (pair 'begin (map (lambda (orig-export-name) (let ((export-name (string->symbol (concat-strings module-prefix (symbol->string orig-export-name))))) `(define ,export-name ,(mytry (eval orig-export-name) (error "The module does not contain" orig-export-name))))) exports))))
 
 (define (null? x) :doc "Checks if the argument is =nil=." (= x ()))
 

bin/sets.slime

@@ -5,8 +5,8 @@
 
   (define key-not-found-index -1)
 
-  (define (make :rest vals)
-    (set-type
+  (define (make . vals)
+    (set-type!
      (if vals
          (list vals)
        '(()))
@@ -27,7 +27,6 @@
   (define (insert! set value)
     (unless (contains? set value)
       (set! set (pair (pair value (first set)) ()))
-      (set-type set :set))
+      (set-type! set :set))
     set)
-
   )

bin/tests/class_macro.slime.expanded

@@ -1,14 +1,14 @@
-(import "oo.slime")
-
-(define-class (vector3 x y 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 (+ (-> other x) x) (+ (-> other y) y) (+ (-> other z) z))) (define (subtract other) (make-vector3 (- (-> other x) x) (- (-> other y) y) (- (-> other z) z))) (define (equal? other) (and (= (-> other x) x) (= (-> other y) y) (= (-> other z) z))) (define (scalar-product other) (+ (* (-> other x) x) (* (-> other y) y) (* (-> other z) z))) (define (cross-product other) (make-vector3 (- (* (-> other z) y) (* (-> other y) z)) (- (* (-> other x) z) (* (-> other z) x)) (- (* (-> other y) x) (* (-> other x) y)))) (define (print) (printf :sep " " "[vector3] (" x y z ")")))
-
-(define v1 (make-vector3 1 2 3))
-
-(define v2 (make-vector3 3 2 1))
-
-(assert (= (type v1) (type v2) :vector3))
-
-(assert (= (v1 'scalar-product v2) 10))
-
-(assert (-> (-> v1 cross-product v2) equal? (make-vector3 -4 8 -4)))
-
+(import "oo.slime")
+
+(define-class (vector3 x y 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 (+ (-> other x) x) (+ (-> other y) y) (+ (-> other z) z))) (define (subtract other) (make-vector3 (- (-> other x) x) (- (-> other y) y) (- (-> other z) z))) (define (equal? other) (and (= (-> other x) x) (= (-> other y) y) (= (-> other z) z))) (define (scalar-product other) (+ (* (-> other x) x) (* (-> other y) y) (* (-> other z) z))) (define (cross-product other) (make-vector3 (- (* (-> other z) y) (* (-> other y) z)) (- (* (-> other x) z) (* (-> other z) x)) (- (* (-> other y) x) (* (-> other x) y)))) (define (print) (printf :sep " " "[vector3] (" x y z ")")))
+
+(define v1 (make-vector3 1 2 3))
+
+(define v2 (make-vector3 3 2 1))
+
+(assert (= (type v1) (type v2) :vector3))
+
+(assert (= (v1 'scalar-product v2) 10))
+
+(assert (-> (-> v1 cross-product v2) equal? (make-vector3 -4 8 -4)))
+

bin/tests/evaluation_of_default_args.slime

@@ -1,7 +1,7 @@
-((lambda (:keys k1 :defaults-to (+ 1 2 3))
+((lambda ((:k1 (+ 1 2 3)))
    (assert (= k1 6))))
 
-((lambda (:keys k1 :defaults-to ())
+((lambda ((:k1 ()))
    (when k1
      (assert ()))
    (assert (= k1 ()))))

bin/tests/lexical_scope.slime

@@ -32,7 +32,7 @@
 ;; key arguments
 
 (define (make-key-counter)
-  ((lambda (:keys var)
+  ((lambda (:var)
      (lambda ()
        (mutate var (+ 1 var))
        var))

bin/tests/lexical_scope.slime.expanded

@@ -1,54 +1,54 @@
-(define (make-counter) (let ((var 0)) (lambda () (set! var (+ 1 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))
-
-(assert (= (counter2) 4))
-
-(assert (= (counter2) 5))
-
-(assert (= (counter1) 4))
-
-(assert (= (counter1) 5))
-
-(define (g) (define x 0) (lambda () (define temp x) (mutate x (+ x 1)) temp))
-
-(define (make-key-counter) ((lambda (:keys var) (lambda () (mutate var (+ 1 var)) var)) :var 0))
-
-(define key-counter1 (make-key-counter))
-
-(assert (= (key-counter1) 1))
-
-(define key-counter2 (make-key-counter))
-
-(assert (= (key-counter2) 1))
-
-(assert (= (key-counter2) 2))
-
-(assert (= (key-counter1) 2))
-
-(assert (= (key-counter1) 3))
-
-(assert (= (key-counter2) 3))
-
-(assert (= (key-counter2) 4))
-
-(assert (= (key-counter2) 5))
-
-(assert (= (key-counter1) 4))
-
-(assert (= (key-counter1) 5))
-
+(define (make-counter) (let ((var 0)) (lambda () (set! var (+ 1 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))
+
+(assert (= (counter2) 4))
+
+(assert (= (counter2) 5))
+
+(assert (= (counter1) 4))
+
+(assert (= (counter1) 5))
+
+(define (g) (define x 0) (lambda () (define temp x) (mutate x (+ x 1)) temp))
+
+(define (make-key-counter) ((lambda (:var) (lambda () (mutate var (+ 1 var)) var)) :var 0))
+
+(define key-counter1 (make-key-counter))
+
+(assert (= (key-counter1) 1))
+
+(define key-counter2 (make-key-counter))
+
+(assert (= (key-counter2) 1))
+
+(assert (= (key-counter2) 2))
+
+(assert (= (key-counter1) 2))
+
+(assert (= (key-counter1) 3))
+
+(assert (= (key-counter2) 3))
+
+(assert (= (key-counter2) 4))
+
+(assert (= (key-counter2) 5))
+
+(assert (= (key-counter1) 4))
+
+(assert (= (key-counter1) 5))
+

src/built_ins.cpp

@@ -1,5 +1,5 @@
 inline proc maybe_wrap_body_in_begin(Lisp_Object* body) -> Lisp_Object* {
-    static Lisp_Object* begin_symbol = Memory::get_or_create_lisp_object_symbol("begin");
+    Lisp_Object* begin_symbol = Memory::get_or_create_lisp_object_symbol("begin");
     if (body->value.pair.rest == Memory::nil)
         return body->value.pair.first;
     else
@@ -101,11 +101,11 @@ proc built_in_import(String* file_name) -> Lisp_Object* {
 }
 
 proc load_built_ins_into_environment() -> void {
-    static String* file_name_built_ins = Memory::create_string(__FILE__);
+    String* file_name_built_ins = Memory::create_string(__FILE__);
 
 
 #define fetch1(var)                                                     \
-    static Lisp_Object* var##_symbol = Memory::get_or_create_lisp_object_symbol(#var); \
+    Lisp_Object* var##_symbol = Memory::get_or_create_lisp_object_symbol(#var); \
     Lisp_Object* var = lookup_symbol(var##_symbol, get_current_environment()); \
     if (Globals::error) printf("in %s:%d\n", __FILE__, __LINE__)
 
@@ -128,12 +128,12 @@ proc load_built_ins_into_environment() -> void {
 // parser relys on being able to temporaily put in markers
 // in the code
 #define _define_helper(def, docs, special)                              \
-    static Lisp_Object* label(params,__LINE__) = Parser::parse_single_expression( \
+    auto label(params,__LINE__) = Parser::parse_single_expression(      \
         Memory::get_c_str(Memory::create_string(#def))                  \
         );                                                              \
     assert_type(label(params,__LINE__), Lisp_Object_Type::Pair);        \
     assert_type(label(params,__LINE__)->value.pair.first, Lisp_Object_Type::Symbol); \
-    static auto label(sym,__LINE__) = label(params,__LINE__)->value.pair.first; \
+    auto label(sym,__LINE__) = label(params,__LINE__)->value.pair.first; \
     auto label(sfun,__LINE__) = Memory::create_lisp_object_cfunction(special); \
     /*NOTE(Felix): for evaluating default args*/                        \
     push_environment(get_root_environment());                           \
@@ -481,13 +481,13 @@ proc load_built_ins_into_environment() -> void {
         fetch(sym, val);
 
         try assert_type(sym, Lisp_Object_Type::Symbol);
-
+        Environment* target_env;
         in_caller_env {
             val = eval_expr(val);
+            target_env = find_binding_environment(sym->value.symbol.identifier, get_current_environment());
+            try assert(target_env);
         }
 
-        Environment* target_env = find_binding_environment(sym->value.symbol.identifier, get_current_environment());
-        try assert(target_env);
 
         push_environment(target_env);
         {
@@ -728,13 +728,14 @@ proc load_built_ins_into_environment() -> void {
 
         return result;
     };
-    define((begin . args), "TODO") {
+    define_special((begin . args), "TODO") {
         fetch(args);
         Lisp_Object* result = Memory::nil;
-        for_lisp_list(args) {
-            try result = eval_expr(it);
+        in_caller_env {
+            for_lisp_list(args) {
+                try result = eval_expr(it);
+            }
         }
-
         return result;
     };
     define((list . args), "TODO") {
@@ -813,6 +814,10 @@ proc load_built_ins_into_environment() -> void {
         }
         return Memory::get_or_create_lisp_object_keyword("unknown");
     };
+    define((mem-reset), "TODO") {
+        Memory::reset();
+        return Memory::nil;
+    };
     // NOTE(Felix): we need to define_special because the docstring is
     // attached to the symbol. Because some object are singletons
     // (symbols, keyowrds, nil, t) we dont want to store docs on the
@@ -887,20 +892,6 @@ proc load_built_ins_into_environment() -> void {
             printf("}\n");
 
         }
-        // }
-        // // TODO(Felix): Maybe don't compare strings here?? Wtf
-        // if (Memory::get_type(type) == Lisp_Object_Type::Keyword &&
-        //     (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(n);
-
-        //     if (fun->docstring)
-        //         printf("Docstring:\n==========\n%s\n\n", Memory::get_c_str(fun->docstring));
-        //     else
-        //         printf("No docstring avaliable\n");
-
         return Memory::nil;
     };
     define((show n), "TODO") {
@@ -968,21 +959,20 @@ proc load_built_ins_into_environment() -> void {
         Memory::print_status();
         return Memory::nil;
     };
-    // // defun("try", "TODO", __LINE__, cLambda {
-    // //         try arguments_length = list_length(arguments);
-    // //         try assert_arguments_length(2, arguments_length);
+    define_special((mytry try_part catch_part), "TODO") {
+        fetch(try_part, catch_part);
 
-    // //         Lisp_Object* try_part   = arguments->value.pair.first;
-    // //         Lisp_Object* catch_part = arguments->value.pair.rest->value.pair.first;
-    // //         Lisp_Object* result;
+        Lisp_Object* result;
 
-    // //         result = eval_expr(try_part);
-    // //         if (Globals::error) {
-    // //             delete_error();
-    // //             try result = eval_expr(catch_part);
-    // //         }
-    // //         return result;
-    // //     });
+        in_caller_env {
+            result = eval_expr(try_part);
+            if (Globals::error) {
+                delete_error();
+                try result = eval_expr(catch_part);
+            }
+        }
+        return result;
+    };
     define((load file), "TODO") {
         fetch(file);
         try assert_type(file, Lisp_Object_Type::String);

src/env.cpp

@@ -84,7 +84,9 @@ inline proc get_current_environment() -> Environment* {
 }
 
 proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
-        assert_type(node, Lisp_Object_Type::Symbol);
+    // print(node);
+    // printf("\n");
+    assert_type(node, Lisp_Object_Type::Symbol);
 
     Lisp_Object* result = try_lookup_symbol(node, env);
 

src/error.cpp

@@ -16,7 +16,7 @@ proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, S
 
     delete_error();
     if (Globals::breaking_on_errors) {
-        debug_break();
+        // debug_break();
     }
     // visualize_lisp_machine();
 

src/eval.cpp

@@ -321,6 +321,7 @@ proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_O
                 create_parsing_error("Default args must be a list of 2.");
             }
             auto value = arguments->value.pair.first->value.pair.rest->value.pair.first;
+            value = eval_expr(value);
             if (arguments->value.pair.first->value.pair.rest->value.pair.rest != Memory::nil) {
                 create_parsing_error("Default args must be a list of 2.");
             }

src/main.cpp

@@ -4,7 +4,7 @@ int main(int argc, char* argv[]) {
     if (argc > 1) {
         if (Slime::string_equal(argv[1], "--run-tests")) {
             int res = Slime::run_all_tests();
-            Slime::interprete_file((char*)"generate-docs.slime");
+            // Slime::interprete_file((char*)"generate-docs.slime");
             return res ? 0 : 1;
         }