felix
/
slime
1
0
Rozštěpit 0
Zdrojový kód Úkoly 0 Požadavky na natažení 0 Vydání 0 Wiki Aktivita
Procházet zdrojové kódy

hashmaps test

master
Felix Brendel před 6 roky
rodič
97f45f166f
revize
1c31749875
12 změnil soubory, kde provedl 368 přidání a 389 odebrání
Jednotný pohled
Diff Options
Zobrazit statistiky Stáhněte soubor opravy Stáhněte rozdílový soubor
  1. +188
    -189
      bin/alist.slime
  2. +0
    -1
      bin/interpolation.slime
  3. +1
    -2
      bin/sets.slime
  4. +1
    -1
      build.sh
  5. +1
    -2
      src/built_ins.cpp
  6. +147
    -147
      src/docgeneration.cpp
  7. +17
    -33
      src/env.cpp
  8. +1
    -1
      src/ftb
  9. +4
    -4
      src/gc.cpp
  10. +1
    -4
      src/memory.cpp
  11. +1
    -0
      src/slime.h
  12. +6
    -5
      src/structs.cpp

+ 188
- 189
bin/alist.slime Zobrazit soubor

@@ -1,189 +1,188 @@
(import "cxr.slime")

;; alist:
;; [ |/]
;; |
;; V
;; [ | ]------------->[ | ]-------------> ...
;; | |
;; V V
;; [ | ]->value1 [ | ]->value2
;; | |
;; V V
;; key1 key2
;;
;; '(((key1 . value1) (key2 . value2)))

;; plist:
;; [ |/]
;; |
;; V
;; [ | ]------------->[ | ]-------------> ...
;; | |
;; V V
;; :key1 value1
;;
;; '((:key1 value1 :key2 value2))

(define key-not-found-index -1)

(define (make-alist)
(set-type!
'(())
:alist))

(define (make-plist)
(set-type!
'(())
:plist))

(define (pprint-alist alist)
(let ((associations (first alist)))
(define (pprint-intern associations)
(when associations
(print " "
(caar associations) "->"
(cdar associations))
(pprint-intern (rest associations))))
(print "(")
(when associations
(print "\n")
(pprint-intern associations))
(print ")\n")))

(define (pprint-plist plist)
(let ((props (first plist)))
(define (pprint-intern props)
(when props
(print " "
(car props) "->"
(cadr props))
(pprint-intern (cddr props))))
(print "(")
(when props
(print "\n")
(pprint-intern props))
(print ")\n")))

(define (alist-get alist key)
(let ((associations (first alist)))
(define (alist-get-intern associations key)
(cond ((null? associations)
(error "key was not found in alist"))
((= (caar associations) key)
(cdar associations))
(else (alist-get-intern (rest associations) key))))
(alist-get-intern associations key)))


(define (alist-find alist key)
(let ((associations (first alist)))
(define (alist-find-intern associations key current-index)
(cond ((null? associations) key-not-found-index)
((= (caar associations) key) current-index)
(else (alist-find-intern (rest associations)
key
(+ 1 current-index)))))
(alist-find-intern associations key 0)))


(define (alist-key-exists? alist key)
(not (= (alist-find alist key)
key-not-found-index)))


(define (alist-remove! alist key)
(let ((index (alist-find alist key)))
(define (alist-remove!-internal asociations index)
;; reminder: we only get called if we are not replacing the
;; first element in the alist
;; reminder2: we know that the key exists
(if (= index 1)
;; we want to remove the next one, so we set our
;; cdr to the next next one
(mutate associations (pair (first associations)
(rest (rest associations))))
;; else cdr-recurse
(alist-remove!-internal (rest asociations) (- index 1))))

(cond ((= index key-not-found-index) (error "key to remove was not found"))
((= index 0) (mutate alist (pair (cdar alist) ())))
(else (alist-remove!-internal alist index))))
alist)


(define (alist-set! alist key value)
(mutate alist (set-type! (pair (pair (pair key value)
(car alist))
())
:alist)))


(define (alist-set-overwrite! alist key value)
(let ((associations (first alist)))
(define (alist-set-overwrite-intern associations key value)
(cond ((= (caar associations) key)
(mutate (car associations) (pair key value)))
((null? associations) (alist-set! alist key value))
(else (alist-set-overwrite-intern
(rest associations) key value))))
(alist-set-overwrite-intern associations key value))
alist)


(define (plist-get plist prop)
(let ((props (first plist)))
(define (plist-get-intern props prop)
(cond ((null? props)
(error "property was not found in plist"))
((= (car props) prop)
(cadr props))
(else (plist-get-intern (cddr props) prop))))
(plist-get-intern props prop)))

(define (plist-set! plist prop value)
(mutate plist (set-type! (pair (pair prop (pair value (first plist))) ())
:plist)))

(define (plist-set-overwrite! plist prop value)
(let ((props (first plist)))
(define (plist-set-overwrite-intern props prop value)
(cond ((= (car props) prop)
(mutate (cdr props) (pair value (cddr props))))
((null? props) (plist-set! plist prop value))
(else (plist-set-overwrite-intern
(cddr props) prop value))))
(plist-set-overwrite-intern props prop value))
plist)

(define (plist-find plist prop)
(let ((props (first plist)))
(define (plist-find-intern props prop current-index)
(cond ((null? props) key-not-found-index)
((= (car props) prop) current-index)
(else (plist-find-intern (cddr props) prop
(+ 1 current-index)))))
(plist-find-intern props prop 0)))

(define (plist-prop-exists? plist prop)
(not (= (plist-find plist prop)
key-not-found-index)))

(define (plist-remove! plist prop)
(let ((index (plist-find plist prop)))
(define (plist-remove!-internal props index)
;; reminder: we only get called if we are not replacing the
;; first element in the alist
;; reminder2: we know that the key exists
(if (= index 1)
;; we want to remove the next one, so we set our
;; cdr to the next next one
(mutate (cdar props) (pair (cadar props) ;; xD nice meme dude!!!
(cdr (cdr (cdr (cdar props))))))
;; else cdr-recurse
(plist-remove!-internal (cddr props) (- index 1))))

(cond ((= index key-not-found-index) (error "prop to remove was not found"))
((= index 0) (mutate plist (pair (cddar plist) ())))
(else (plist-remove!-internal plist index))))
plist)
(define-module ds
:exports
(alist::make alist::print alist::get alist::find alist::key-exists? alist::remove! alist::set! alist::set-overwrite!
plist::make plist::print plist::get plist::find plist::prop-exists? plist::remove! plist::set! plist::set-overwrite!)

(define key-not-found-index -1)

(define-module alist
:imports ("cxr.slime")
:exports (make print get find key-exists? remove! set! set-overwrite!)

(define (make)
(set-type!
'(())
:alist))

(define (print alist)
(let ((associations (first alist)))
(define (pprint-intern associations)
(when associations
(print " "
(caar associations) "->"
(cdar associations))
(pprint-intern (rest associations))))
(print "(")
(when associations
(print "\n")
(pprint-intern associations))
(print ")\n")))


(define (get alist key)
(let ((associations (first alist)))
(define (alist-get-intern associations key)
(cond ((null? associations)
(error "key was not found in alist"))
((= (caar associations) key)
(cdar associations))
(else (alist-get-intern (rest associations) key))))
(alist-get-intern associations key)))


(define (find alist key)
(let ((associations (first alist)))
(define (alist-find-intern associations key current-index)
(cond ((null? associations) key-not-found-index)
((= (caar associations) key) current-index)
(else (alist-find-intern (rest associations)
key
(+ 1 current-index)))))
(alist-find-intern associations key 0)))


(define (key-exists? alist key)
(not (= (alist-find alist key)
key-not-found-index)))


(define (remove! alist key)
(let ((index (alist-find alist key)))
(define (alist-remove!-internal asociations index)
;; reminder: we only get called if we are not replacing the
;; first element in the alist
;; reminder2: we know that the key exists
(if (= index 1)
;; we want to remove the next one, so we set our
;; cdr to the next next one
(mutate associations (pair (first associations)
(rest (rest associations))))
;; else cdr-recurse
(alist-remove!-internal (rest asociations) (- index 1))))

(cond ((= index key-not-found-index) (error "key to remove was not found"))
((= index 0) (mutate alist (pair (cdar alist) ())))
(else (alist-remove!-internal alist index))))
alist)


(define (set! alist key value)
(mutate alist (set-type! (pair (pair (pair key value)
(car alist))
())
:alist)))

(define (set-overwrite! alist key value)
(let ((associations (first alist)))
(define (alist-set-overwrite-intern associations key value)
(cond ((= (caar associations) key)
(mutate (car associations) (pair key value)))
((null? associations) (alist-set! alist key value))
(else (alist-set-overwrite-intern
(rest associations) key value))))
(alist-set-overwrite-intern associations key value))
alist)
)

(define-module plist
:imports ("cxr.slime")
:exports (make print get find prop-exists? remove! set! set-overwrite!)
;; plist:
;; [ |/]
;; |
;; V
;; [ | ]------------->[ | ]-------------> ...
;; | |
;; V V
;; :key1 value1
;;
;; '((:key1 value1 :key2 value2))

(define (make)
(set-type!
'(())
:plist))

(define (print plist)
(let ((props (first plist)))
(define (pprint-intern props)
(when props
(print " "
(car props) "->"
(cadr props))
(pprint-intern (cddr props))))
(print "(")
(when props
(print "\n")
(pprint-intern props))
(print ")\n")))

(define (get plist prop)
(let ((props (first plist)))
(define (plist-get-intern props prop)
(cond ((null? props)
(error "property was not found in plist"))
((= (car props) prop)
(cadr props))
(else (plist-get-intern (cddr props) prop))))
(plist-get-intern props prop)))

(define (set plist prop value)
(mutate plist (set-type! (pair (pair prop (pair value (first plist))) ())
:plist)))

(define (set-overwrite! plist prop value)
(let ((props (first plist)))
(define (plist-set-overwrite-intern props prop value)
(cond ((= (car props) prop)
(mutate (cdr props) (pair value (cddr props))))
((null? props) (plist-set! plist prop value))
(else (plist-set-overwrite-intern
(cddr props) prop value))))
(plist-set-overwrite-intern props prop value))
plist)

(define (find plist prop)
(let ((props (first plist)))
(define (plist-find-intern props prop current-index)
(cond ((null? props) key-not-found-index)
((= (car props) prop) current-index)
(else (plist-find-intern (cddr props) prop
(+ 1 current-index)))))
(plist-find-intern props prop 0)))

(define (prop-exists? plist prop)
(not (= (plist-find plist prop)
key-not-found-index)))

(define (remove! plist prop)
(let ((index (plist-find plist prop)))
(define (plist-remove!-internal props index)
;; reminder: we only get called if we are not replacing the
;; first element in the alist
;; reminder2: we know that the key exists
(if (= index 1)
;; we want to remove the next one, so we set our
;; cdr to the next next one
(mutate (cdar props) (pair (cadar props) ;; xD nice meme dude!!!
(cdr (cdr (cdr (cdar props))))))
;; else cdr-recurse
(plist-remove!-internal (cddr props) (- index 1))))

(cond ((= index key-not-found-index) (error "prop to remove was not found"))
((= index 0) (mutate plist (pair (cddar plist) ())))
(else (plist-remove!-internal plist index))))
plist)

)
)

+ 0
- 1
bin/interpolation.slime Zobrazit soubor

@@ -42,7 +42,6 @@
(lambda (t) (lambda (t)
(point-lerp (lerper1 t) (point-lerp (lerper1 t)
(lerper2 t) t)))) (lerper2 t) t))))

) )






+ 1
- 2
bin/sets.slime Zobrazit soubor

@@ -1,8 +1,7 @@
(define-module set (define-module set
:imports ("cxr.slime")
:exports (make find contains? insert!) :exports (make find contains? insert!)


(import "cxr.slime")

(define key-not-found-index -1) (define key-not-found-index -1)


(define (make . vals) (define (make . vals)


+ 1
- 1
build.sh Zobrazit soubor

@@ -4,7 +4,7 @@ pushd $SCRIPTPATH > /dev/null


# _DEBUG # _DEBUG
# time g++ -fpermissive src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1 # time g++ -fpermissive src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1
time clang++ -D_DEBUG -D_PROFILING -fpermissive src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1
time clang++ -D_DEBUG -D_PROFILING src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1


echo "" echo ""
pushd ./bin > /dev/null pushd ./bin > /dev/null


+ 1
- 2
src/built_ins.cpp Zobrazit soubor

@@ -301,7 +301,6 @@ proc load_built_ins_into_environment() -> void {
define((* . args), "TODO") define((* . args), "TODO")
{ {
fetch(args); fetch(args);

if (args == Memory::nil) { if (args == Memory::nil) {
return Memory::create_lisp_object_number(1); return Memory::create_lisp_object_number(1);
} }
@@ -951,7 +950,7 @@ proc load_built_ins_into_environment() -> void {
define((generate-docs file_name), "TODO") { define((generate-docs file_name), "TODO") {
fetch(file_name); fetch(file_name);
try assert_type(file_name, Lisp_Object_Type::String); try assert_type(file_name, Lisp_Object_Type::String);
try generate_docs(file_name->value.string);
// try generate_docs(file_name->value.string);
return Memory::t; return Memory::t;
}; };
define((print (:sep " ") (:end "\n") . things), "TODO") { define((print (:sep " ") (:end "\n") . things), "TODO") {


+ 147
- 147
src/docgeneration.cpp Zobrazit soubor

@@ -1,157 +1,157 @@
proc generate_docs(String* path) -> void {
FILE *f = fopen(Memory::get_c_str(path), "w");
if (!f) {
create_generic_error("The file for writing the documentation (%s) "
"could not be opened for writing.", Memory::get_c_str(path));
return;
}
defer {
fclose(f);
};
// proc generate_docs(String* path) -> void {
// FILE *f = fopen(Memory::get_c_str(path), "w");
// if (!f) {
// create_generic_error("The file for writing the documentation (%s) "
// "could not be opened for writing.", Memory::get_c_str(path));
// return;
// }
// defer {
// fclose(f);
// };


Environment_Array_List visited = create_Environment_array_list();
// Environment_Array_List visited = create_Environment_array_list();


// recursive inner funciton
std::function<void(Environment*, char* prefix)> print_this_env;
print_this_env = [&](Environment* env, char* prefix) -> void {
bool we_already_printed = false;
// TODO(Felix): Make a generic array_list_contains function
for_array_list(visited) {
if (it == env) {
we_already_printed = true;
break;
}
}
if (!we_already_printed) {
printf("Working ion env::::");
print_environment(env);
printf("\n--------------------------------\n");
append_to_array_list(&visited, env);
// // recursive inner funciton
// std::function<void(Environment*, char* prefix)> print_this_env;
// print_this_env = [&](Environment* env, char* prefix) -> void {
// bool we_already_printed = false;
// // TODO(Felix): Make a generic array_list_contains function
// for_array_list(visited) {
// if (it == env) {
// we_already_printed = true;
// break;
// }
// }
// if (!we_already_printed) {
// printf("Working ion env::::");
// print_environment(env);
// printf("\n--------------------------------\n");
// append_to_array_list(&visited, env);


push_environment(env);
defer {
pop_environment();
};
// push_environment(env);
// defer {
// pop_environment();
// };


for (int i = 0; i < env->next_index; ++i) {
fprintf(f, "\\hrule\n* =%s%s= \n"
// " :PROPERTIES:\n"
// " :UNNUMBERED: t\n"
// " :END:"
,prefix, env->keys[i]);
/*
* sourcecodeLocation
*/
if (env->values[i]->sourceCodeLocation) {
try_void fprintf(f, "\n - defined in :: =%s:%d:%d=",
Memory::get_c_str(env->values[i]->sourceCodeLocation->file),
env->values[i]->sourceCodeLocation->line,
env->values[i]->sourceCodeLocation->column);
}
/*
* type
*/
Lisp_Object_Type type = Memory::get_type(env->values[i]);
Lisp_Object* LOtype;
try_void LOtype = eval_expr(Memory::create_list(
Memory::get_or_create_lisp_object_symbol("type"),
env->values[i]));
// for (int i = 0; i < env->next_index; ++i) {
// fprintf(f, "\\hrule\n* =%s%s= \n"
// // " :PROPERTIES:\n"
// // " :UNNUMBERED: t\n"
// // " :END:"
// ,prefix, env->keys[i]);
// /*
// * sourcecodeLocation
// */
// if (env->values[i]->sourceCodeLocation) {
// try_void fprintf(f, "\n - defined in :: =%s:%d:%d=",
// Memory::get_c_str(env->values[i]->sourceCodeLocation->file),
// env->values[i]->sourceCodeLocation->line,
// env->values[i]->sourceCodeLocation->column);
// }
// /*
// * type
// */
// Lisp_Object_Type type = Memory::get_type(env->values[i]);
// Lisp_Object* LOtype;
// try_void LOtype = eval_expr(Memory::create_list(
// Memory::get_or_create_lisp_object_symbol("type"),
// env->values[i]));


fprintf(f, "\n - type :: =");
print(LOtype, true, f);
fprintf(f, "=");
// fprintf(f, "\n - type :: =");
// print(LOtype, true, f);
// fprintf(f, "=");




/*
* if printable value -> print it
*/
switch (type) {
case(Lisp_Object_Type::Nil):
case(Lisp_Object_Type::T):
case(Lisp_Object_Type::Number):
case(Lisp_Object_Type::String):
case(Lisp_Object_Type::Pair):
case(Lisp_Object_Type::Symbol):
case(Lisp_Object_Type::Keyword): {
fprintf(f, "\n - value :: =");
print(env->values[i], true, f);
fprintf(f, "=");
} break;
default: break;
}
/*
* if function then print arguments
*/
if (type == Lisp_Object_Type::Function) {
Lisp_Object* fun = env->values[i];
bool printed_at_least_some_args = false;
fprintf(f, "\n - arguments :: ");
if (fun->value.function.args.positional.symbols.next_index != 0) {
if (!printed_at_least_some_args)
fprintf(f, ":");
fprintf(f, "\n - postitional :: ");
try_void fprintf(f, "=%s=", Memory::get_c_str(fun->value.function.args.positional.symbols.data[0]->value.symbol.identifier));
for (int i = 1; i < fun->value.function.args.positional.symbols.next_index; ++i) {
fprintf(f, ", =%s=", Memory::get_c_str(fun->value.function.args.positional.symbols.data[i]->value.symbol.identifier));
}
}
if (fun->value.function.args.keyword.values.next_index != 0) {
if (!printed_at_least_some_args)
fprintf(f, ":");
fprintf(f, "\n - keyword :: ");
fprintf(f, "=%s=", Memory::get_c_str(fun->value.function.args.keyword.keywords.data[0]->value.symbol.identifier));
if (fun->value.function.args.keyword.values.data[0]) {
fprintf(f, " =(");
print(fun->value.function.args.keyword.values.data[0], true, f);
fprintf(f, ")=");
}
for (int i = 1; i < fun->value.function.args.keyword.values.next_index; ++i) {
fprintf(f, ", =%s=", Memory::get_c_str(fun->value.function.args.keyword.keywords.data[i]->value.symbol.identifier));
if (fun->value.function.args.keyword.values.data[i]) {
fprintf(f, " =(");
print(fun->value.function.args.keyword.values.data[i], true, f);
fprintf(f, ")=");
}
}
}
if (fun->value.function.args.rest) {
if (!printed_at_least_some_args)
fprintf(f, ":");
fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(fun->value.function.args.rest->value.symbol.identifier));
}
// if no args at all
if (fun->value.function.args.positional.symbols.next_index == 0 &&
fun->value.function.args.keyword.values.next_index == 0 &&
!fun->value.function.args.rest)
{
fprintf(f, "none.");
}
}
fprintf(f, "\n - docu :: ");
if (env->values[i]->docstring)
fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n",
Memory::get_c_str(env->values[i]->docstring));
else
fprintf(f, "none\n");
// /*
// * if printable value -> print it
// */
// switch (type) {
// case(Lisp_Object_Type::Nil):
// case(Lisp_Object_Type::T):
// case(Lisp_Object_Type::Number):
// case(Lisp_Object_Type::String):
// case(Lisp_Object_Type::Pair):
// case(Lisp_Object_Type::Symbol):
// case(Lisp_Object_Type::Keyword): {
// fprintf(f, "\n - value :: =");
// print(env->values[i], true, f);
// fprintf(f, "=");
// } break;
// default: break;
// }
// /*
// * if function then print arguments
// */
// if (type == Lisp_Object_Type::Function) {
// Lisp_Object* fun = env->values[i];
// bool printed_at_least_some_args = false;
// fprintf(f, "\n - arguments :: ");
// if (fun->value.function.args.positional.symbols.next_index != 0) {
// if (!printed_at_least_some_args)
// fprintf(f, ":");
// fprintf(f, "\n - postitional :: ");
// try_void fprintf(f, "=%s=", Memory::get_c_str(fun->value.function.args.positional.symbols.data[0]->value.symbol.identifier));
// for (int i = 1; i < fun->value.function.args.positional.symbols.next_index; ++i) {
// fprintf(f, ", =%s=", Memory::get_c_str(fun->value.function.args.positional.symbols.data[i]->value.symbol.identifier));
// }
// }
// if (fun->value.function.args.keyword.values.next_index != 0) {
// if (!printed_at_least_some_args)
// fprintf(f, ":");
// fprintf(f, "\n - keyword :: ");
// fprintf(f, "=%s=", Memory::get_c_str(fun->value.function.args.keyword.keywords.data[0]->value.symbol.identifier));
// if (fun->value.function.args.keyword.values.data[0]) {
// fprintf(f, " =(");
// print(fun->value.function.args.keyword.values.data[0], true, f);
// fprintf(f, ")=");
// }
// for (int i = 1; i < fun->value.function.args.keyword.values.next_index; ++i) {
// fprintf(f, ", =%s=", Memory::get_c_str(fun->value.function.args.keyword.keywords.data[i]->value.symbol.identifier));
// if (fun->value.function.args.keyword.values.data[i]) {
// fprintf(f, " =(");
// print(fun->value.function.args.keyword.values.data[i], true, f);
// fprintf(f, ")=");
// }
// }
// }
// if (fun->value.function.args.rest) {
// if (!printed_at_least_some_args)
// fprintf(f, ":");
// fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(fun->value.function.args.rest->value.symbol.identifier));
// }
// // if no args at all
// if (fun->value.function.args.positional.symbols.next_index == 0 &&
// fun->value.function.args.keyword.values.next_index == 0 &&
// !fun->value.function.args.rest)
// {
// fprintf(f, "none.");
// }
// }
// fprintf(f, "\n - docu :: ");
// if (env->values[i]->docstring)
// fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n",
// Memory::get_c_str(env->values[i]->docstring));
// else
// fprintf(f, "none\n");


// if (Memory::get_type(env->values[i]) == Lisp_Object_Type::Function &&
// env->values[i]->userType &&
// (string_equal(env->values[i]->userType->value.symbol.identifier, "package") ||
// string_equal(env->values[i]->userType->value.symbol.identifier, "constructor")))
// {
// char new_prefix[200];
// strcpy(new_prefix, prefix);
// strcat(new_prefix, env->keys[i]);
// strcat(new_prefix, " ");
// print_this_env(env->values[i]->value.function.parent_environment, new_prefix);
// }
}
}
// // if (Memory::get_type(env->values[i]) == Lisp_Object_Type::Function &&
// // env->values[i]->userType &&
// // (string_equal(env->values[i]->userType->value.symbol.identifier, "package") ||
// // string_equal(env->values[i]->userType->value.symbol.identifier, "constructor")))
// // {
// // char new_prefix[200];
// // strcpy(new_prefix, prefix);
// // strcat(new_prefix, env->keys[i]);
// // strcat(new_prefix, " ");
// // print_this_env(env->values[i]->value.function.parent_environment, new_prefix);
// // }
// }
// }


for (int i = 0; i < env->parents.next_index; ++i) {
print_this_env(env->parents.data[i], prefix);
}
};
// for (int i = 0; i < env->parents.next_index; ++i) {
// print_this_env(env->parents.data[i], prefix);
// }
// };


print_this_env(get_current_environment(), (char*)"");
}
// print_this_env(get_current_environment(), (char*)"");
// }

+ 17
- 33
src/env.cpp Zobrazit soubor

@@ -1,27 +1,10 @@
proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void { proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void {
// NOTE(Felix): right now we are simply adding the symol at the
// back of the list without checking if it already exists but are
// also searching for thesymbol from the back, so we will find the
// latest defined one first, but a bit messy. Later we should use
// a hashmap here. @refactor
Environment* env = get_current_environment(); Environment* env = get_current_environment();

if (env->next_index == env->capacity) {
env->capacity *= 2;
env->keys = (char**)realloc(env->keys, env->capacity * sizeof(char*));
env->values = (Lisp_Object**)realloc(env->values, env->capacity * sizeof(Lisp_Object*));
}

env->keys [env->next_index] = Memory::get_c_str(symbol->value.symbol.identifier);
env->values[env->next_index] = value;
++env->next_index;
hm_set(env->hm, Memory::get_c_str(symbol->value.symbol.identifier), value);
} }


proc lookup_symbol_in_this_envt(String* identifier, Environment* env) -> Lisp_Object* {
for (int i = env->next_index - 1; i >= 0; --i)
if (string_equal(env->keys[i], Memory::get_c_str(identifier)))
return env->values[i];
return nullptr;
inline proc lookup_symbol_in_this_envt(String* identifier, Environment* env) -> Lisp_Object* {
return (Lisp_Object*)hm_get_object(env->hm, Memory::get_c_str(identifier));
} }


proc environment_binds_symbol(String* identifier, Environment* env) -> bool { proc environment_binds_symbol(String* identifier, Environment* env) -> bool {
@@ -112,19 +95,20 @@ proc print_environment_indent(Environment* env, int indent) -> void {
printf("[built-ins]-Environment (%lld)\n", (long long)env); printf("[built-ins]-Environment (%lld)\n", (long long)env);
return; return;
} }
for (int i = 0; i < env->next_index; ++i) {
print_indent(indent);
printf("-> %s :: ", env->keys[i]);
print(env->values[i]);
printf(" (%lld)", (long long)env->values[i]);
puts("");
}
for (int i = 0; i < env->parents.next_index; ++i) {
print_indent(indent);
printf("parent (%lld)", (long long)env->parents.data[i]);
puts(":");
print_environment_indent(env->parents.data[i], indent+4);
}
printf("TODO\n");
// for (int i = 0; i < env->next_index; ++i) {
// print_indent(indent);
// printf("-> %s :: ", env->keys[i]);
// print(env->values[i]);
// printf(" (%lld)", (long long)env->values[i]);
// puts("");
// }
// for (int i = 0; i < env->parents.next_index; ++i) {
// print_indent(indent);
// printf("parent (%lld)", (long long)env->parents.data[i]);
// puts(":");
// print_environment_indent(env->parents.data[i], indent+4);
// }
} }


proc print_environment(Environment* env) -> void { proc print_environment(Environment* env) -> void {


+ 1
- 1
src/ftb

@@ -1 +1 @@
Subproject commit 2b00885ba250a2a186e7399f9df6d36db8608cf1
Subproject commit b9de82c0d84384a7ab78e2cb7dd368612efa50f9

+ 4
- 4
src/gc.cpp Zobrazit soubor

@@ -68,10 +68,10 @@ namespace GC {
maybe_mark(it); maybe_mark(it);
} }
Lisp_Object* it = env->values[0];
for (int i = 0; i < env->next_index; it = env->values[++i]) {
maybe_mark(it);
}
// Lisp_Object* it = env->values[0];
// for (int i = 0; i < env->next_index; it = env->values[++i]) {
// maybe_mark(it);
// }
} }
proc garbage_collect() -> void { proc garbage_collect() -> void {


+ 1
- 4
src/memory.cpp Zobrazit soubor

@@ -379,10 +379,7 @@ namespace Memory {
if (parent) if (parent)
append_to_array_list(&env->parents, parent); append_to_array_list(&env->parents, parent);


env->capacity = start_capacity;
env->next_index = 0;
env->keys = (char**)malloc(start_capacity * sizeof(char*));
env->values = (Lisp_Object**)malloc(start_capacity * sizeof(Lisp_Object*));
env->hm = create_hashmap();


return env; return env;
} }


+ 1
- 0
src/slime.h Zobrazit soubor

@@ -26,6 +26,7 @@


#include "./ftb/macros.hpp" #include "./ftb/macros.hpp"
#include "./ftb/profiler.hpp" #include "./ftb/profiler.hpp"
#include "./ftb/hashmap.hpp"


namespace Slime { namespace Slime {
# include "./defines.cpp" # include "./defines.cpp"


+ 6
- 5
src/structs.cpp Zobrazit soubor

@@ -111,12 +111,13 @@ struct Arguments {


struct Environment { struct Environment {
Environment_Array_List parents; Environment_Array_List parents;
int capacity;
int next_index;
StringHashMap* hm;
// int capacity;
// int next_index;


// TODO(Felix): Use a hashmap here.
char** keys;
Lisp_Object** values;
// // TODO(Felix): Use a hashmap here.
// char** keys;
// Lisp_Object** values;
}; };


struct Function { struct Function {


Zapsat Náhled
Načítá se…
Zrušit
Uložit