| @@ -0,0 +1 @@ | |||||
| (define-syntax (e x) x) | |||||
| @@ -0,0 +1,3 @@ | |||||
| (import "a.slime") | |||||
| (printf (e 2)) | |||||
| @@ -0,0 +1,57 @@ | |||||
| (import "oo.slime") | |||||
| (define-package math | |||||
| (define pi 3.14159265) | |||||
| (define (abs x) | |||||
| (if (> x 0) x (- x))) | |||||
| (define (sqrt x) | |||||
| (** x 0.5)) | |||||
| (define-class 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 (print) | |||||
| (printf :sep "" "[vector3] (" x y z ")")) | |||||
| ) | |||||
| ) | |||||
| @@ -0,0 +1,29 @@ | |||||
| (define-syntax (define-class name members :rest body) | |||||
| "Macro for creating classes." | |||||
| (define (underscore sym) | |||||
| (string->symbol (concat-strings "_" (symbol->string sym)))) | |||||
| (define underscored-members (map underscore members)) | |||||
| ;; the wrapping let environment | |||||
| (define let-body `(let ,(zip members underscored-members))) | |||||
| ;; the body | |||||
| (extend let-body body) | |||||
| ;; (map (lambda (fun) (append let-body fun)) body) | |||||
| ;; the dispatch function | |||||
| (append let-body `(set-type | |||||
| (special-lambda | |||||
| (message :rest args) | |||||
| "This is the docs for the handle" | |||||
| (eval (extend (list message) args))) ,(symbol->keyword name))) | |||||
| ;; stuff it all in the constructor function | |||||
| `(define | |||||
| ;; The function definition | |||||
| ,(pair (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members) | |||||
| ;; The docstring | |||||
| ,(concat-strings "This is the handle to an object of the class " (symbol->string name)) | |||||
| ;; the body | |||||
| ,let-body)) | |||||
| @@ -53,7 +53,23 @@ | |||||
| (define-syntax (define-special name-and-args :rest body) | (define-syntax (define-special name-and-args :rest body) | ||||
| `(define ,(first name-and-args) (special-lambda ,(rest name-and-args) @body))) | `(define ,(first name-and-args) (special-lambda ,(rest name-and-args) @body))) | ||||
| (define-syntax (do-list :rest body) | |||||
| (define-syntax (construct-list :rest body) | |||||
| " | |||||
| (construct-list | |||||
| i <- '(1 2 3 4 5) | |||||
| yield (* i i)) | |||||
| (construct-list | |||||
| i <- '(1 2 3 4) | |||||
| j <- '(A B) | |||||
| yield (pair i j)) | |||||
| (construct-list | |||||
| i <- '(1 2 3 4 5 6 7 8) | |||||
| when (evenp i) | |||||
| yield i) | |||||
| " | |||||
| (define (append-map f ll) | (define (append-map f ll) | ||||
| (unless (= ll ()) | (unless (= ll ()) | ||||
| (define val (f (first ll))) | (define val (f (first ll))) | ||||
| @@ -73,32 +89,29 @@ | |||||
| `(if ,(first (rest body)) ,(rec (rest (rest body))))) | `(if ,(first (rest body)) ,(rec (rest (rest body))))) | ||||
| ((= (first body) 'yield) | ((= (first body) 'yield) | ||||
| (first (rest body))) | (first (rest body))) | ||||
| (t (error "Not a do-able expression: ~S" `(quote ,body)))) | |||||
| ) | |||||
| (else (error "Not a do-able expression")))) | |||||
| (rec body)) | (rec body)) | ||||
| (define-syntax (apply fun seq) | |||||
| "Applies the funciton to the sequence, as in calls the function with | |||||
| ithe sequence as arguemens." | |||||
| `(eval (pair ,fun ,seq))) | |||||
| (define-syntax (define-package name :rest body) | |||||
| `(define ,(string->symbol (concat-strings (symbol->string name) "->")) | |||||
| ((lambda () | |||||
| @body | |||||
| (set-type | |||||
| (special-lambda (:rest args) | |||||
| (let ((op (first args)) | |||||
| (args (rest args))) | |||||
| (cond ((= op 'pi) 3.14159265) | |||||
| (else (try (apply op args) | |||||
| (error "The package does not contain this operation")))))) | |||||
| :package))))) | |||||
| ;; (define (append-map f ll) | |||||
| ;; (unless (= ll ()) | |||||
| ;; (define val (f (first ll))) | |||||
| ;; (if (= (first val) ()) | |||||
| ;; (append-map f (rest ll)) | |||||
| ;; (extend | |||||
| ;; val | |||||
| ;; (append-map f (rest ll)))))) | |||||
| ;; (define-special (do-list :rest body) | |||||
| ;; (cond | |||||
| ;; ((= () body) ()) | |||||
| ;; ((= () (rest body)) (first body)) | |||||
| ;; ((= (first (rest body)) '<-) | |||||
| ;; `(,append-map (lambda (,(first body)) (list ,(eval `(do-list @(rest (rest (rest body))))))) ,(first (rest (rest body))))) | |||||
| ;; ((= (first body) 'when) | |||||
| ;; `(if ,(first (rest body)) ,(eval `(do-list @(rest (rest body)))))) | |||||
| ;; ((= (first body) 'yield) | |||||
| ;; (first (rest body))) | |||||
| ;; (t (error "Not a do-able expression: ~S" `(quote ,body)))) | |||||
| ;; ) | |||||
| (define (nil? x) | (define (nil? x) | ||||
| "Checks if the argument is nil." | "Checks if the argument is nil." | ||||
| @@ -136,11 +149,6 @@ | |||||
| "Checks if the argument is a built-in function." | "Checks if the argument is a built-in function." | ||||
| (= (type x) :built-in-function)) | (= (type x) :built-in-function)) | ||||
| (define (apply fun seq) | |||||
| "Applies the funciton to the sequence, as in calls the function with | |||||
| ithe sequence as arguemens." | |||||
| (eval (pair fun seq))) | |||||
| (define (end seq) | (define (end seq) | ||||
| "Returns the last pair in the sqeuence." | "Returns the last pair in the sqeuence." | ||||
| (if (or (nil? seq) (not (pair? (rest seq)))) | (if (or (nil? seq) (not (pair? (rest seq)))) | ||||
| @@ -16,9 +16,6 @@ | |||||
| (define (built-n-function? x) "Checks if the argument is a built-in function." (= (type x) :built-in-function)) | (define (built-n-function? x) "Checks if the argument is a built-in function." (= (type x) :built-in-function)) | ||||
| (define (apply fun seq) "Applies the funciton to the sequence, as in calls the function with | |||||
| ithe sequence as arguemens." (eval (pair fun seq))) | |||||
| (define (end seq) "Returns the last pair in the sqeuence." (if (or (nil? seq) (not (pair? (rest seq)))) seq (end (rest seq)))) | (define (end seq) "Returns the last pair in the sqeuence." (if (or (nil? seq) (not (pair? (rest seq)))) seq (end (rest seq)))) | ||||
| (define (last seq) "Returns the (first) of the last (pair) of the given sequence." (first (end seq))) | (define (last seq) "Returns the (first) of the last (pair) of the given sequence." (first (end seq))) | ||||
| @@ -52,7 +49,7 @@ elemens as argument to that function." (if (nil? seq) seq (pair (fun (first seq) | |||||
| function to the argument sequence. This only works correctly if | function to the argument sequence. This only works correctly if | ||||
| the given function accepts a variable amount of parameters. If | the given function accepts a variable amount of parameters. If | ||||
| your funciton is limited to two arguments, use `reduce-binary' | your funciton is limited to two arguments, use `reduce-binary' | ||||
| instead." (apply fun seq)) | |||||
| instead." (eval (pair fun seq))) | |||||
| (define (reduce-binary fun seq) "Takes a function and a sequence as arguments and applies the | (define (reduce-binary fun seq) "Takes a function and a sequence as arguments and applies the | ||||
| function to the argument sequence. reduce-binary applies the | function to the argument sequence. reduce-binary applies the | ||||
| @@ -1,35 +1,6 @@ | |||||
| (define (type-wrap obj type) | |||||
| (set-type obj type) | |||||
| obj) | |||||
| (import "oo.slime") | |||||
| (define-syntax (defclass name members :rest body) | |||||
| "Macro for creating classes." | |||||
| (define (underscore sym) | |||||
| (string->symbol (concat-strings "_" (symbol->string sym)))) | |||||
| (define underscored-members (map underscore members)) | |||||
| ;; the wrapping let environment | |||||
| (define let-body `(let ,(zip members underscored-members))) | |||||
| ;; the body | |||||
| (map (lambda (fun) (append let-body fun)) body) | |||||
| ;; the dispatch function | |||||
| (append let-body `(type-wrap | |||||
| (special-lambda | |||||
| (message :rest args) | |||||
| "This is the docs for the handle" | |||||
| (eval (extend (list message) args))) ,(symbol->keyword name))) | |||||
| ;; stuff it all in the constructor function | |||||
| `(define | |||||
| ,(pair (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members) | |||||
| ,(concat-strings "This is the handle to an object of the class " (symbol->string name)) | |||||
| ,let-body)) | |||||
| (defclass vector3 (x y z) | |||||
| (define-class vector3 (x y z) | |||||
| (define (get-x) x) | (define (get-x) x) | ||||
| (define (get-y) y) | (define (get-y) y) | ||||
| (define (get-z) z) | (define (get-z) z) | ||||
| @@ -1,6 +1,6 @@ | |||||
| (define (type-wrap obj type) (set-type obj type) obj) | |||||
| (import "oo.slime") | |||||
| (define (make-vector3 _x _y _z) "This is the handle to an object of the class vector3" (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 (print) (printf :sep "" "[vector3] (" x y z ")")) (type-wrap (special-lambda (message :rest args) "This is the docs for the handle" (eval (extend (list message) args))) :vector3))) | |||||
| (define-class 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.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 (print) (printf :sep "" "[vector3] (" x y z ")"))) | |||||
| (define v1 (make-vector3 1 2 3)) | (define v1 (make-vector3 1 2 3)) | ||||
| @@ -1,3 +1,5 @@ | |||||
| ;; regular arguments | |||||
| (define (make-counter) | (define (make-counter) | ||||
| (let ((var 0)) | (let ((var 0)) | ||||
| (lambda () | (lambda () | ||||
| @@ -5,12 +7,47 @@ | |||||
| var))) | var))) | ||||
| (define counter1 (make-counter)) | (define counter1 (make-counter)) | ||||
| (assert (= (counter1) 1)) | (assert (= (counter1) 1)) | ||||
| (define counter2 (make-counter)) | (define counter2 (make-counter)) | ||||
| (assert (= (counter2) 1)) | (assert (= (counter2) 1)) | ||||
| (assert (= (counter2) 2)) | (assert (= (counter2) 2)) | ||||
| (assert (= (counter1) 2)) | (assert (= (counter1) 2)) | ||||
| (assert (= (counter1) 3)) | (assert (= (counter1) 3)) | ||||
| (assert (= (counter2) 3)) | (assert (= (counter2) 3)) | ||||
| (assert (= (counter2) 4)) | |||||
| (assert (= (counter2) 5)) | |||||
| (assert (= (counter1) 4)) | |||||
| (assert (= (counter1) 5)) | |||||
| ;; key arguments | |||||
| (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)) | |||||
| ;; rest arguments will no be copied so we don't need to test them here | |||||
| @@ -16,3 +16,37 @@ | |||||
| (assert (= (counter2) 3)) | (assert (= (counter2) 3)) | ||||
| (assert (= (counter2) 4)) | |||||
| (assert (= (counter2) 5)) | |||||
| (assert (= (counter1) 4)) | |||||
| (assert (= (counter1) 5)) | |||||
| (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)) | |||||
| @@ -0,0 +1,13 @@ | |||||
| (define-syntax (error) | |||||
| (assert t)) | |||||
| (define-syntax (test) | |||||
| `(begin | |||||
| (+ 1 1) | |||||
| (error) | |||||
| (+ 1 1))) | |||||
| (test) | |||||
| (assert t) | |||||
| @@ -30,7 +30,8 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool { | |||||
| } | } | ||||
| proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* { | proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* { | ||||
| char* file_content = read_entire_file(Memory::get_c_str(file_name)); | |||||
| char* full_file_name = find_slime_file(file_name); | |||||
| char* file_content = read_entire_file(full_file_name ); | |||||
| if (file_content) { | if (file_content) { | ||||
| Lisp_Object* result = Memory::nil; | Lisp_Object* result = Memory::nil; | ||||
| Lisp_Object_Array_List* program; | Lisp_Object_Array_List* program; | ||||
| @@ -50,6 +51,7 @@ proc built_in_import(String* file_name, Environment* env) -> Lisp_Object* { | |||||
| // create new empty environment | // create new empty environment | ||||
| Environment* new_env; | Environment* new_env; | ||||
| try new_env = Memory::create_child_environment(Globals::root_environment); | try new_env = Memory::create_child_environment(Globals::root_environment); | ||||
| append_to_array_list(env->parents, new_env); | |||||
| Environment* old_macro_env = Parser::environment_for_macros; | Environment* old_macro_env = Parser::environment_for_macros; | ||||
| Parser::environment_for_macros = new_env; | Parser::environment_for_macros = new_env; | ||||
| @@ -58,8 +60,6 @@ proc built_in_import(String* file_name, Environment* env) -> Lisp_Object* { | |||||
| Parser::environment_for_macros = old_macro_env; | Parser::environment_for_macros = old_macro_env; | ||||
| append_to_array_list(env->parents, new_env); | |||||
| return res; | return res; | ||||
| } | } | ||||
| @@ -391,10 +391,9 @@ proc load_built_ins_into_environment(Environment* env) -> void { | |||||
| defun("mutate", cLambda { | defun("mutate", cLambda { | ||||
| try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); | try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); | ||||
| try assert_arguments_length(2, arguments_length); | try assert_arguments_length(2, arguments_length); | ||||
| Lisp_Object* target = evaluated_arguments->value.pair.first; | Lisp_Object* target = evaluated_arguments->value.pair.first; | ||||
| Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first; | Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first; | ||||
| # | |||||
| if (target == Memory::nil || | if (target == Memory::nil || | ||||
| target == Memory::t || | target == Memory::t || | ||||
| Memory::get_type(target) == Lisp_Object_Type::Keyword || | Memory::get_type(target) == Lisp_Object_Type::Keyword || | ||||
| @@ -724,8 +723,8 @@ proc load_built_ins_into_environment(Environment* env) -> void { | |||||
| try assert_type(type, Lisp_Object_Type::Keyword); | try assert_type(type, Lisp_Object_Type::Keyword); | ||||
| evaluated_arguments->value.pair.first->userType = type; | |||||
| return type; | |||||
| object->userType = type; | |||||
| return object; | |||||
| }); | }); | ||||
| defun("delete-type", cLambda { | defun("delete-type", cLambda { | ||||
| try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); | try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); | ||||
| @@ -850,6 +849,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { | |||||
| puts("body:\n"); | puts("body:\n"); | ||||
| print(evaluated_arguments->value.pair.first->value.function.body); | print(evaluated_arguments->value.pair.first->value.function.body); | ||||
| puts("\n"); | puts("\n"); | ||||
| printf("parent_env: %lld\n", (long long)evaluated_arguments->value.pair.first->value.function.parent_environment); | |||||
| return Memory::nil; | return Memory::nil; | ||||
| }); | }); | ||||
| @@ -947,21 +947,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { | |||||
| try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); | try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); | ||||
| try assert_arguments_length(1, arguments_length); | try assert_arguments_length(1, arguments_length); | ||||
| if (evaluated_arguments->value.pair.first == Memory::nil || | |||||
| evaluated_arguments->value.pair.first == Memory::t || | |||||
| Memory::get_type(evaluated_arguments->value.pair.first) == Lisp_Object_Type::Symbol || | |||||
| Memory::get_type(evaluated_arguments->value.pair.first) == Lisp_Object_Type::Keyword) | |||||
| { | |||||
| // we don't copy singleton objects | |||||
| return evaluated_arguments->value.pair.first; | |||||
| } | |||||
| Lisp_Object* target = Memory::create_lisp_object(); | |||||
| Lisp_Object* source = evaluated_arguments->value.pair.first; | |||||
| *target = *source; | |||||
| return target; | |||||
| return Memory::copy_lisp_object(evaluated_arguments->value.pair.first); | |||||
| }); | }); | ||||
| defun("error", cLambda { | defun("error", cLambda { | ||||
| // TODO(Felix): make the error function useful | // TODO(Felix): make the error function useful | ||||
| @@ -71,6 +71,7 @@ proc print_environment_indent(Environment* env, int indent) -> void { | |||||
| print_indent(indent); | print_indent(indent); | ||||
| print(env->values[i]); | print(env->values[i]); | ||||
| printf(" %s", env->keys[i]); | printf(" %s", env->keys[i]); | ||||
| printf(" (%lld)", (long long)env->values[i]); | |||||
| puts(""); | puts(""); | ||||
| } | } | ||||
| for (int i = 0; i < env->parents->next_index; ++i) { | for (int i = 0; i < env->parents->next_index; ++i) { | ||||
| @@ -82,6 +83,6 @@ proc print_environment_indent(Environment* env, int indent) -> void { | |||||
| } | } | ||||
| proc print_environment(Environment* env) -> void { | proc print_environment(Environment* env) -> void { | ||||
| printf("\n=== Environment ===\n"); | |||||
| printf("\n=== Environment === (%lld)\n", (long long)env); | |||||
| print_environment_indent(env, 0); | print_environment_indent(env, 0); | ||||
| } | } | ||||
| @@ -14,8 +14,13 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> | |||||
| // their identifiers but before we converted them to | // their identifiers but before we converted them to | ||||
| // strings from symbols... Wo maybe just use the symbols? | // strings from symbols... Wo maybe just use the symbols? | ||||
| // NOTE(Felix): We have to copy all the arguments, otherwise | |||||
| // we change the program code. | |||||
| try sym = Memory::get_or_create_lisp_object_symbol(function->positional_arguments->identifiers[i]); | try sym = Memory::get_or_create_lisp_object_symbol(function->positional_arguments->identifiers[i]); | ||||
| define_symbol(sym, arguments->value.pair.first, new_env); | |||||
| define_symbol( | |||||
| sym, | |||||
| Memory::copy_lisp_object_except_pairs(arguments->value.pair.first), | |||||
| new_env); | |||||
| arguments = arguments->value.pair.rest; | arguments = arguments->value.pair.rest; | ||||
| } | } | ||||
| @@ -82,7 +87,10 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> | |||||
| // if not set it and then add it to the array list | // if not set it and then add it to the array list | ||||
| try sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.symbol.identifier); | try sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.symbol.identifier); | ||||
| // NOTE(Felix): It seems we do not need to evaluate the argument here... | // NOTE(Felix): It seems we do not need to evaluate the argument here... | ||||
| try define_symbol(sym, arguments->value.pair.rest->value.pair.first, new_env); | |||||
| try define_symbol( | |||||
| sym, | |||||
| Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first), | |||||
| new_env); | |||||
| append_to_array_list(read_in_keywords, arguments->value.pair.first->value.symbol.identifier); | append_to_array_list(read_in_keywords, arguments->value.pair.first->value.symbol.identifier); | ||||
| @@ -122,7 +130,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> | |||||
| // to use it or if the user supplied his own | // to use it or if the user supplied his own | ||||
| if (!was_set) { | if (!was_set) { | ||||
| try sym = Memory::get_or_create_lisp_object_symbol(defined_keyword); | try sym = Memory::get_or_create_lisp_object_symbol(defined_keyword); | ||||
| try val = Memory::copy_lisp_object(function->keyword_arguments->values->data[i]); | |||||
| try val = Memory::copy_lisp_object_except_pairs(function->keyword_arguments->values->data[i]); | |||||
| define_symbol(sym, val, new_env); | define_symbol(sym, val, new_env); | ||||
| } | } | ||||
| } | } | ||||
| @@ -137,7 +145,12 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> | |||||
| } else { | } else { | ||||
| if (function->rest_argument) { | if (function->rest_argument) { | ||||
| try sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument); | try sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument); | ||||
| define_symbol(sym, arguments, new_env); | |||||
| define_symbol( | |||||
| sym, | |||||
| // NOTE(Felix): arguments will be a list, and I THINK | |||||
| // we do not need to copy it... | |||||
| arguments, | |||||
| new_env); | |||||
| } else { | } else { | ||||
| // rest was not declared but additional arguments were found | // rest was not declared but additional arguments were found | ||||
| create_generic_error( | create_generic_error( | ||||
| @@ -152,20 +165,9 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> | |||||
| return result; | return result; | ||||
| } | } | ||||
| /* | |||||
| (begin | |||||
| (define type--before type) | |||||
| (define type | |||||
| (lambda (e) | |||||
| (if (and (= (type--before e) :pair) (= (first e) :my-type)) | |||||
| :my-type | |||||
| (type--before e)))) | |||||
| ) | |||||
| */ | |||||
| /** | /** | ||||
| This parses the argument specification of funcitons into their | This parses the argument specification of funcitons into their | ||||
| Function struct. It dois this by allocating new | |||||
| Function struct. It does this by allocating new | |||||
| positional_arguments, keyword_arguments and rest_argument and | positional_arguments, keyword_arguments and rest_argument and | ||||
| filling it in | filling it in | ||||
| */ | */ | ||||
| @@ -382,7 +384,6 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { | |||||
| case Lisp_Object_Type::Symbol: { | case Lisp_Object_Type::Symbol: { | ||||
| Lisp_Object* symbol; | Lisp_Object* symbol; | ||||
| try symbol = lookup_symbol(node, env); | try symbol = lookup_symbol(node, env); | ||||
| return symbol; | return symbol; | ||||
| } | } | ||||
| case Lisp_Object_Type::Pair: { | case Lisp_Object_Type::Pair: { | ||||
| @@ -409,7 +410,8 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { | |||||
| // check for lisp function | // check for lisp function | ||||
| if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) { | if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) { | ||||
| // only for lambdas we evaluate the arguments before | // only for lambdas we evaluate the arguments before | ||||
| // apllying | |||||
| // apllying, for the other types, special-lambda and macro | |||||
| // we do not need. | |||||
| if (lispOperator->value.function.type == Function_Type::Lambda) { | if (lispOperator->value.function.type == Function_Type::Lambda) { | ||||
| try arguments = eval_arguments(arguments, env, &arguments_length); | try arguments = eval_arguments(arguments, env, &arguments_length); | ||||
| } | } | ||||
| @@ -440,25 +442,7 @@ proc interprete_file (char* file_name) -> Lisp_Object* { | |||||
| try user_env = Memory::create_child_environment(root_env); | try user_env = Memory::create_child_environment(root_env); | ||||
| Parser::environment_for_macros = user_env; | Parser::environment_for_macros = user_env; | ||||
| // save the current working directory | |||||
| char cwd[1024]; | |||||
| getcwd(cwd, 1024); | |||||
| // get the direction of the exe | |||||
| char* exe_path = exe_dir(); | |||||
| // switch to the exe directory for loading pre.slime | |||||
| chdir(exe_path); | |||||
| free(exe_path); | |||||
| built_in_import(Memory::create_string("pre.slime"), user_env); | |||||
| // switch back to the users directory | |||||
| chdir(cwd); | |||||
| Lisp_Object* result; | |||||
| result = built_in_load(Memory::create_string(file_name), user_env); | |||||
| Lisp_Object* result = built_in_load(Memory::create_string(file_name), user_env); | |||||
| if (Globals::error) { | if (Globals::error) { | ||||
| log_error(); | log_error(); | ||||
| @@ -480,23 +464,6 @@ proc interprete_stdin(bool is_emacs_repl = false) -> void { | |||||
| return; | return; | ||||
| } | } | ||||
| // save the current working directory | |||||
| char cwd[1024]; | |||||
| getcwd(cwd, 1024); | |||||
| // get the direction of the exe | |||||
| char* exe_path = exe_dir(); | |||||
| // switch to the exe directory for loading pre.slime | |||||
| chdir(exe_path); | |||||
| free(exe_path); | |||||
| built_in_import(Memory::create_string("pre.slime"), user_env); | |||||
| // switch back to the users directory | |||||
| chdir(cwd); | |||||
| Parser::environment_for_macros = user_env; | Parser::environment_for_macros = user_env; | ||||
| printf("Welcome to the lispy interpreter.\n"); | printf("Welcome to the lispy interpreter.\n"); | ||||
| @@ -12,6 +12,8 @@ proc load_built_ins_into_environment(Environment*) -> void; | |||||
| proc parse_argument_list(Lisp_Object*, Function*) -> void; | proc parse_argument_list(Lisp_Object*, Function*) -> void; | ||||
| proc print_environment(Environment*) -> void; | proc print_environment(Environment*) -> void; | ||||
| proc exe_dir() -> char*; | |||||
| proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*; | proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*; | ||||
| proc visualize_lisp_machine() -> void; | proc visualize_lisp_machine() -> void; | ||||
| @@ -24,6 +26,8 @@ namespace Memory { | |||||
| namespace Parser { | namespace Parser { | ||||
| extern Environment* environment_for_macros; | |||||
| extern String* standard_in; | extern String* standard_in; | ||||
| extern String* parser_file; | extern String* parser_file; | ||||
| extern int parser_line; | extern int parser_line; | ||||
| @@ -90,6 +90,10 @@ proc unescape_string(char* in) -> bool { | |||||
| return true; | return true; | ||||
| } | } | ||||
| proc find_slime_file(String* filename) -> char* { | |||||
| return Memory::get_c_str(filename); | |||||
| } | |||||
| proc read_entire_file(char* filename) -> char* { | proc read_entire_file(char* filename) -> char* { | ||||
| char *fileContent = nullptr; | char *fileContent = nullptr; | ||||
| FILE *fp = fopen(filename, "r"); | FILE *fp = fopen(filename, "r"); | ||||
| @@ -351,7 +355,7 @@ proc log_error() -> void { | |||||
| puts(console_normal); | puts(console_normal); | ||||
| } | } | ||||
| char* exe_dir() { | |||||
| proc exe_dir() -> char* { | |||||
| size_t size = 512, i, n; | size_t size = 512, i, n; | ||||
| char *path, *temp; | char *path, *temp; | ||||
| @@ -182,7 +182,7 @@ namespace Memory { | |||||
| set_type(t, Lisp_Object_Type::T); | set_type(t, Lisp_Object_Type::T); | ||||
| try_void Globals::root_environment = create_built_ins_environment(); | try_void Globals::root_environment = create_built_ins_environment(); | ||||
| try_void Parser::standard_in = create_string("stdin"); | |||||
| try_void Parser::standard_in = create_string("stdin"); | |||||
| } | } | ||||
| proc reset() -> void { | proc reset() -> void { | ||||
| @@ -283,7 +283,14 @@ namespace Memory { | |||||
| } | } | ||||
| proc copy_lisp_object(Lisp_Object* n) -> Lisp_Object* { | proc copy_lisp_object(Lisp_Object* n) -> Lisp_Object* { | ||||
| if (n == nil || n == t) | |||||
| // TODO(Felix): If argument is a list (pair), do a FULL copy, | |||||
| // we don't copy singleton objects | |||||
| if ( | |||||
| n == Memory::nil || n == Memory::t || | |||||
| Memory::get_type(n) == Lisp_Object_Type::Symbol || | |||||
| Memory::get_type(n) == Lisp_Object_Type::Keyword | |||||
| ) | |||||
| return n; | return n; | ||||
| Lisp_Object* target; | Lisp_Object* target; | ||||
| @@ -292,6 +299,12 @@ namespace Memory { | |||||
| return target; | return target; | ||||
| } | } | ||||
| proc copy_lisp_object_except_pairs(Lisp_Object* n) -> Lisp_Object* { | |||||
| if (get_type(n) == Lisp_Object_Type::Pair) | |||||
| return n; | |||||
| return copy_lisp_object(n); | |||||
| } | |||||
| proc create_child_environment(Environment* parent) -> Environment* { | proc create_child_environment(Environment* parent) -> Environment* { | ||||
| int index; | int index; | ||||
| @@ -337,8 +350,24 @@ namespace Memory { | |||||
| proc create_built_ins_environment() -> Environment* { | proc create_built_ins_environment() -> Environment* { | ||||
| Environment* ret; | Environment* ret; | ||||
| try ret = create_child_environment(nullptr); | |||||
| try ret = create_empty_environment(); | |||||
| load_built_ins_into_environment(ret); | load_built_ins_into_environment(ret); | ||||
| Parser::environment_for_macros = ret; | |||||
| // save the current working directory | |||||
| char cwd[1024]; | |||||
| getcwd(cwd, 1024); | |||||
| // get the direction of the exe | |||||
| char* exe_path = exe_dir(); | |||||
| chdir(exe_path); | |||||
| free(exe_path); | |||||
| built_in_load(Memory::create_string("pre.slime"), ret); | |||||
| chdir(cwd); | |||||
| return ret; | return ret; | ||||
| } | } | ||||
| @@ -455,6 +455,9 @@ namespace Parser { | |||||
| Memory::get_type(macro) == Lisp_Object_Type::Function && | Memory::get_type(macro) == Lisp_Object_Type::Function && | ||||
| macro->value.function.type == Function_Type::Macro) | macro->value.function.type == Function_Type::Macro) | ||||
| { | { | ||||
| // printf("Found macro: ") ; | |||||
| // print(parsed_symbol); | |||||
| // printf("\n"); | |||||
| try expression = eval_expr(expression, environment_for_macros); | try expression = eval_expr(expression, environment_for_macros); | ||||
| } else break; | } else break; | ||||
| } | } | ||||
| @@ -572,21 +572,15 @@ proc test_singular_t_and_nil() -> testresult { | |||||
| } | } | ||||
| proc test_file(const char* file) -> testresult { | proc test_file(const char* file) -> testresult { | ||||
| Environment* root_env; | |||||
| Environment* user_env; | |||||
| Memory::reset(); | Memory::reset(); | ||||
| assert_no_error(); | assert_no_error(); | ||||
| root_env = Memory::create_built_ins_environment(); | |||||
| assert_no_error(); | |||||
| user_env = Memory::create_child_environment(root_env); | |||||
| Environment* root_env = Globals::root_environment; | |||||
| Environment* user_env = Memory::create_child_environment(root_env); | |||||
| assert_no_error(); | assert_no_error(); | ||||
| Parser::environment_for_macros = user_env; | Parser::environment_for_macros = user_env; | ||||
| built_in_import(Memory::create_string("pre.slime"), user_env); | |||||
| assert_no_error(); | |||||
| Lisp_Object* result = built_in_load(Memory::create_string(file), user_env); | Lisp_Object* result = built_in_load(Memory::create_string(file), user_env); | ||||
| assert_no_error(); | assert_no_error(); | ||||
| @@ -595,8 +589,7 @@ proc test_file(const char* file) -> testresult { | |||||
| } | } | ||||
| proc run_all_tests() -> bool { | proc run_all_tests() -> bool { | ||||
| Memory::init(4096 * 2000, 1024, 4096 * 16); | |||||
| Parser::environment_for_macros = Globals::root_environment; | |||||
| Memory::init(4096 * 2000, 1024 * 32, 4096 * 16); | |||||
| // get the direction of the exe | // get the direction of the exe | ||||
| char* exe_path = exe_dir(); | char* exe_path = exe_dir(); | ||||
| @@ -638,8 +631,9 @@ proc run_all_tests() -> bool { | |||||
| invoke_test_script("evaluation_of_default_args"); | invoke_test_script("evaluation_of_default_args"); | ||||
| invoke_test_script("lexical_scope"); | invoke_test_script("lexical_scope"); | ||||
| invoke_test_script("class_macro"); | invoke_test_script("class_macro"); | ||||
| invoke_test_script("sicp"); | |||||
| invoke_test_script("import_and_load"); | invoke_test_script("import_and_load"); | ||||
| invoke_test_script("sicp"); | |||||
| invoke_test_script("macro_expand"); | |||||
| return result; | return result; | ||||
| } | } | ||||