work on generic extend

bin/pre.slime

@@ -158,6 +158,30 @@ ithe sequence as arguemens."
                exports))))
 
 
+(define-syntax (generic-extend args . body)
+  (let ((fun-name (first args))
+        (params   (rest args))
+        (types    ())
+        (names    ()))
+    (define (process-params params)
+      (when params
+        (let ((_name (first       params))
+              (_type (first (rest params))))
+          (assert (symbol?  _name))
+          (assert (keyword? _type))
+          ;; (print (append types _type))
+          (break)
+          (set! types (append types _type))
+          ;; (print types)
+          (set! names (append names _name))
+          (process-params (rest (rest params))))))
+    (process-params params)
+    (print fun-name)
+    (print names)
+    (print types)
+    )
+  )
+
 (define (null? x)
   :doc "Checks if the argument is =nil=."
   (= x ()))
@@ -409,3 +433,8 @@ added to a list, which in the end is returned."
 
 ;;   (print-inner args)
 ;;   ())
+
+
+
+(generic-extend (+ v1 :vector v2 :vector)
+   (body))

bin/pre.slime.expanded

@@ -26,6 +26,8 @@
 
 (define-syntax (define-module module-name (:imports ()) :exports . body) (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) (eval `(begin (unquote-splicing (map (lambda (x) `(,import ,x)) imports)) (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 :module-error "The module does not contain a key it tries to export"))))) exports))))
 
+(define-syntax (generic-extend args . body) (let ((fun-name (first args)) (params (rest args)) (types ()) (names ())) (define (process-params params) (when params (let ((_name (first params)) (_type (first (rest params)))) (assert (symbol? _name)) (assert (keyword? _type)) (break) (set! types (append types _type)) (set! names (append names _name)) (process-params (rest (rest params)))))) (process-params params) (print fun-name) (print names) (print types)))
+
 (define (null? x) :doc "Checks if the argument is =nil=." (= x ()))
 
 (define (type=? obj typ) :doc "Checks if the argument =obj= is of type =typ=" (= (type obj) typ))
@@ -94,3 +96,5 @@
 
 (define (enumerate seq) (define (enumerate-inner seq next-num) (when seq (pair (list (first seq) next-num) (enumerate-inner (rest seq) (+ 1 next-num))))) (enumerate-inner seq 0))
 
+(generic-extend (+ v1 :vector v2 :vector) (body))
+

src/built_ins.cpp

@@ -366,6 +366,18 @@ proc load_built_ins_into_environment() -> void {
 
         return Memory::create_lisp_object_number(x);
     };
+    define_special((bound? var), "TODO") {
+        fetch(var);
+        try assert_type(var, Lisp_Object_Type::Symbol);
+
+        Lisp_Object* res;
+        in_caller_env {
+            res = try_lookup_symbol(var, get_current_environment());
+        }
+        if (res)
+            return Memory::t;
+        return Memory::nil;
+    };
     define((assert test), "TODO") {
         fetch(test);
 
@@ -541,12 +553,18 @@ proc load_built_ins_into_environment() -> void {
         in_caller_env {
             val = eval_expr(val);
             target_env = find_binding_environment(sym, get_current_environment());
-            try assert(target_env);
+            if (!target_env)
+                target_env = get_root_environment();
         }
 
 
         push_environment(target_env);
         {
+            printf("set!ing:: ");
+            print(sym);
+            printf(" to ");
+            print(val);
+            printf(" in %llu\n", (unsigned long long) target_env);
             define_symbol(sym, val);
         }
         pop_environment();

src/env.cpp

@@ -14,11 +14,11 @@ proc environment_binds_symbol(Lisp_Object* sym, Environment* env) -> bool {
 proc find_binding_environment(Lisp_Object* sym, Environment* env) -> Environment* {
     if (environment_binds_symbol(sym, env))
         return env;
-    for (int i = 0; i < env->parents.next_index; ++i) {
-        if (environment_binds_symbol(sym, env->parents.data[i]))
-            return env->parents.data[i];
+    for_array_list (env->parents) {
+        if (Environment* ret = find_binding_environment(sym, it))
+            return it;
     }
-    return get_root_environment();
+    return nullptr;
 }
 
 proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
@@ -34,7 +34,7 @@ proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
         if (result)
             return result;
     }
-    
+
     auto nil_sym = Memory::get_or_create_lisp_object_symbol("nil");
     auto t_sym   = Memory::get_or_create_lisp_object_symbol("t");