| @@ -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 ,(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) | |||
| (unless (= ll ()) | |||
| (define val (f (first ll))) | |||
| @@ -73,32 +89,29 @@ | |||
| `(if ,(first (rest body)) ,(rec (rest (rest body))))) | |||
| ((= (first body) 'yield) | |||
| (first (rest body))) | |||
| (t (error "Not a do-able expression: ~S" `(quote ,body)))) | |||
| ) | |||
| (else (error "Not a do-able expression")))) | |||
| (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) | |||
| "Checks if the argument is nil." | |||
| @@ -136,11 +149,6 @@ | |||
| "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)))) | |||
| @@ -16,9 +16,6 @@ | |||
| (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 (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 | |||
| the given function accepts a variable amount of parameters. If | |||
| 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 | |||
| 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-y) y) | |||
| (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)) | |||
| @@ -1,3 +1,5 @@ | |||
| ;; regular arguments | |||
| (define (make-counter) | |||
| (let ((var 0)) | |||
| (lambda () | |||
| @@ -5,12 +7,47 @@ | |||
| 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)) | |||
| ;; 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) 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* { | |||
| 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) { | |||
| Lisp_Object* result = Memory::nil; | |||
| Lisp_Object_Array_List* program; | |||
| @@ -50,6 +51,7 @@ proc built_in_import(String* file_name, Environment* env) -> Lisp_Object* { | |||
| // create new empty environment | |||
| Environment* new_env; | |||
| 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; | |||
| 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; | |||
| append_to_array_list(env->parents, new_env); | |||
| return res; | |||
| } | |||
| @@ -391,10 +391,9 @@ proc load_built_ins_into_environment(Environment* env) -> void { | |||
| defun("mutate", cLambda { | |||
| try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); | |||
| try assert_arguments_length(2, arguments_length); | |||
| Lisp_Object* target = evaluated_arguments->value.pair.first; | |||
| Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first; | |||
| # | |||
| if (target == Memory::nil || | |||
| target == Memory::t || | |||
| 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); | |||
| evaluated_arguments->value.pair.first->userType = type; | |||
| return type; | |||
| object->userType = type; | |||
| return object; | |||
| }); | |||
| defun("delete-type", cLambda { | |||
| 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"); | |||
| print(evaluated_arguments->value.pair.first->value.function.body); | |||
| puts("\n"); | |||
| printf("parent_env: %lld\n", (long long)evaluated_arguments->value.pair.first->value.function.parent_environment); | |||
| 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 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 { | |||
| // TODO(Felix): make the error function useful | |||
| @@ -71,6 +71,7 @@ proc print_environment_indent(Environment* env, int indent) -> void { | |||
| print_indent(indent); | |||
| print(env->values[i]); | |||
| printf(" %s", env->keys[i]); | |||
| printf(" (%lld)", (long long)env->values[i]); | |||
| puts(""); | |||
| } | |||
| 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 { | |||
| printf("\n=== Environment ===\n"); | |||
| printf("\n=== Environment === (%lld)\n", (long long)env); | |||
| 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 | |||
| // 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]); | |||
| 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; | |||
| } | |||
| @@ -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 | |||
| 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... | |||
| 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); | |||
| @@ -122,7 +130,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> | |||
| // to use it or if the user supplied his own | |||
| if (!was_set) { | |||
| 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); | |||
| } | |||
| } | |||
| @@ -137,7 +145,12 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> | |||
| } else { | |||
| if (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 { | |||
| // rest was not declared but additional arguments were found | |||
| create_generic_error( | |||
| @@ -152,20 +165,9 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> | |||
| 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 | |||
| Function struct. It dois this by allocating new | |||
| Function struct. It does this by allocating new | |||
| positional_arguments, keyword_arguments and rest_argument and | |||
| filling it in | |||
| */ | |||
| @@ -382,7 +384,6 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { | |||
| case Lisp_Object_Type::Symbol: { | |||
| Lisp_Object* symbol; | |||
| try symbol = lookup_symbol(node, env); | |||
| return symbol; | |||
| } | |||
| case Lisp_Object_Type::Pair: { | |||
| @@ -409,7 +410,8 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { | |||
| // check for lisp function | |||
| if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) { | |||
| // 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) { | |||
| 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); | |||
| 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) { | |||
| log_error(); | |||
| @@ -480,23 +464,6 @@ proc interprete_stdin(bool is_emacs_repl = false) -> void { | |||
| 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; | |||
| 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 print_environment(Environment*) -> void; | |||
| proc exe_dir() -> char*; | |||
| proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*; | |||
| proc visualize_lisp_machine() -> void; | |||
| @@ -24,6 +26,8 @@ namespace Memory { | |||
| namespace Parser { | |||
| extern Environment* environment_for_macros; | |||
| extern String* standard_in; | |||
| extern String* parser_file; | |||
| extern int parser_line; | |||
| @@ -90,6 +90,10 @@ proc unescape_string(char* in) -> bool { | |||
| return true; | |||
| } | |||
| proc find_slime_file(String* filename) -> char* { | |||
| return Memory::get_c_str(filename); | |||
| } | |||
| proc read_entire_file(char* filename) -> char* { | |||
| char *fileContent = nullptr; | |||
| FILE *fp = fopen(filename, "r"); | |||
| @@ -351,7 +355,7 @@ proc log_error() -> void { | |||
| puts(console_normal); | |||
| } | |||
| char* exe_dir() { | |||
| proc exe_dir() -> char* { | |||
| size_t size = 512, i, n; | |||
| char *path, *temp; | |||
| @@ -182,7 +182,7 @@ namespace Memory { | |||
| set_type(t, Lisp_Object_Type::T); | |||
| 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 { | |||
| @@ -283,7 +283,14 @@ namespace Memory { | |||
| } | |||
| 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; | |||
| Lisp_Object* target; | |||
| @@ -292,6 +299,12 @@ namespace Memory { | |||
| 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* { | |||
| int index; | |||
| @@ -337,8 +350,24 @@ namespace Memory { | |||
| proc create_built_ins_environment() -> Environment* { | |||
| Environment* ret; | |||
| try ret = create_child_environment(nullptr); | |||
| try ret = create_empty_environment(); | |||
| 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; | |||
| } | |||
| @@ -455,6 +455,9 @@ namespace Parser { | |||
| Memory::get_type(macro) == Lisp_Object_Type::Function && | |||
| macro->value.function.type == Function_Type::Macro) | |||
| { | |||
| // printf("Found macro: ") ; | |||
| // print(parsed_symbol); | |||
| // printf("\n"); | |||
| try expression = eval_expr(expression, environment_for_macros); | |||
| } else break; | |||
| } | |||
| @@ -572,21 +572,15 @@ proc test_singular_t_and_nil() -> testresult { | |||
| } | |||
| proc test_file(const char* file) -> testresult { | |||
| Environment* root_env; | |||
| Environment* user_env; | |||
| Memory::reset(); | |||
| 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(); | |||
| 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); | |||
| assert_no_error(); | |||
| @@ -595,8 +589,7 @@ proc test_file(const char* file) -> testresult { | |||
| } | |||
| 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 | |||
| char* exe_path = exe_dir(); | |||
| @@ -638,8 +631,9 @@ proc run_all_tests() -> bool { | |||
| invoke_test_script("evaluation_of_default_args"); | |||
| invoke_test_script("lexical_scope"); | |||
| invoke_test_script("class_macro"); | |||
| invoke_test_script("sicp"); | |||
| invoke_test_script("import_and_load"); | |||
| invoke_test_script("sicp"); | |||
| invoke_test_script("macro_expand"); | |||
| return result; | |||
| } | |||