diff --git a/bin/pre.slime b/bin/pre.slime index cf5556b..1d64633 100644 --- a/bin/pre.slime +++ b/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)) diff --git a/bin/pre.slime.expanded b/bin/pre.slime.expanded index 3bc7276..5697e3f 100644 --- a/bin/pre.slime.expanded +++ b/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)) + diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 62d9c44..d1655a8 100644 --- a/src/built_ins.cpp +++ b/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(); diff --git a/src/env.cpp b/src/env.cpp index bba0aa4..adc28c8 100644 --- a/src/env.cpp +++ b/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");