Sfoglia il codice sorgente

Before implementing import name resolution, then after fic macro imports

master
Felix Brendel 7 anni fa
parent
commit
f77e4c56b3
20 ha cambiato i file con 296 aggiunte e 3227 eliminazioni
  1. +1
    -0
      bin/a.slime
  2. +3
    -0
      bin/b.slime
  3. +57
    -0
      bin/math.slime
  4. +29
    -0
      bin/oo.slime
  5. +37
    -29
      bin/pre.slime
  6. +1
    -4
      bin/pre.slime.expanded
  7. +2
    -31
      bin/tests/class_macro.slime
  8. +2
    -2
      bin/tests/class_macro.slime.expanded
  9. +37
    -0
      bin/tests/lexical_scope.slime
  10. +34
    -0
      bin/tests/lexical_scope.slime.expanded
  11. +13
    -0
      bin/tests/macro_expand.slime
  12. +0
    -3069
      bin/visualization.svg
  13. +8
    -22
      src/built_ins.cpp
  14. +2
    -1
      src/env.cpp
  15. +21
    -54
      src/eval.cpp
  16. +4
    -0
      src/forward_decls.cpp
  17. +5
    -1
      src/io.cpp
  18. +32
    -3
      src/memory.cpp
  19. +3
    -0
      src/parse.cpp
  20. +5
    -11
      src/testing.cpp

+ 1
- 0
bin/a.slime Vedi File

@@ -0,0 +1 @@
(define-syntax (e x) x)

+ 3
- 0
bin/b.slime Vedi File

@@ -0,0 +1,3 @@
(import "a.slime")

(printf (e 2))

+ 57
- 0
bin/math.slime Vedi File

@@ -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 ")"))
)
)

+ 29
- 0
bin/oo.slime Vedi File

@@ -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))

+ 37
- 29
bin/pre.slime Vedi File

@@ -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))))


+ 1
- 4
bin/pre.slime.expanded Vedi File

@@ -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


+ 2
- 31
bin/tests/class_macro.slime Vedi File

@@ -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)


+ 2
- 2
bin/tests/class_macro.slime.expanded Vedi File

@@ -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))



+ 37
- 0
bin/tests/lexical_scope.slime Vedi File

@@ -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

+ 34
- 0
bin/tests/lexical_scope.slime.expanded Vedi File

@@ -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))


+ 13
- 0
bin/tests/macro_expand.slime Vedi File

@@ -0,0 +1,13 @@
(define-syntax (error)
(assert t))


(define-syntax (test)
`(begin
(+ 1 1)
(error)
(+ 1 1)))

(test)

(assert t)

+ 0
- 3069
bin/visualization.svg
File diff soppresso perché troppo grande
Vedi File


+ 8
- 22
src/built_ins.cpp Vedi File

@@ -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


+ 2
- 1
src/env.cpp Vedi File

@@ -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);
}

+ 21
- 54
src/eval.cpp Vedi File

@@ -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");


+ 4
- 0
src/forward_decls.cpp Vedi File

@@ -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;


+ 5
- 1
src/io.cpp Vedi File

@@ -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;



+ 32
- 3
src/memory.cpp Vedi File

@@ -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;
}



+ 3
- 0
src/parse.cpp Vedi File

@@ -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;
}


+ 5
- 11
src/testing.cpp Vedi File

@@ -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;
}


Caricamento…
Annulla
Salva