hashmaps test

This commit is contained in:
Felix Brendel
2019-09-29 23:20:37 +02:00
parent 97f45f166f
commit 1c31749875
12 changed files with 346 additions and 367 deletions
+58 -59
View File
@@ -1,43 +1,20 @@
(import "cxr.slime") (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!)
;; alist: (define key-not-found-index -1)
;; [ |/]
;; |
;; V
;; [ | ]------------->[ | ]-------------> ...
;; | |
;; V V
;; [ | ]->value1 [ | ]->value2
;; | |
;; V V
;; key1 key2
;;
;; '(((key1 . value1) (key2 . value2)))
;; plist: (define-module alist
;; [ |/] :imports ("cxr.slime")
;; | :exports (make print get find key-exists? remove! set! set-overwrite!)
;; V
;; [ | ]------------->[ | ]-------------> ...
;; | |
;; V V
;; :key1 value1
;;
;; '((:key1 value1 :key2 value2))
(define key-not-found-index -1) (define (make)
(define (make-alist)
(set-type! (set-type!
'(()) '(())
:alist)) :alist))
(define (make-plist) (define (print alist)
(set-type!
'(())
:plist))
(define (pprint-alist alist)
(let ((associations (first alist))) (let ((associations (first alist)))
(define (pprint-intern associations) (define (pprint-intern associations)
(when associations (when associations
@@ -51,21 +28,8 @@
(pprint-intern associations)) (pprint-intern associations))
(print ")\n"))) (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) (define (get alist key)
(let ((associations (first alist))) (let ((associations (first alist)))
(define (alist-get-intern associations key) (define (alist-get-intern associations key)
(cond ((null? associations) (cond ((null? associations)
@@ -76,7 +40,7 @@
(alist-get-intern associations key))) (alist-get-intern associations key)))
(define (alist-find alist key) (define (find alist key)
(let ((associations (first alist))) (let ((associations (first alist)))
(define (alist-find-intern associations key current-index) (define (alist-find-intern associations key current-index)
(cond ((null? associations) key-not-found-index) (cond ((null? associations) key-not-found-index)
@@ -87,12 +51,12 @@
(alist-find-intern associations key 0))) (alist-find-intern associations key 0)))
(define (alist-key-exists? alist key) (define (key-exists? alist key)
(not (= (alist-find alist key) (not (= (alist-find alist key)
key-not-found-index))) key-not-found-index)))
(define (alist-remove! alist key) (define (remove! alist key)
(let ((index (alist-find alist key))) (let ((index (alist-find alist key)))
(define (alist-remove!-internal asociations index) (define (alist-remove!-internal asociations index)
;; reminder: we only get called if we are not replacing the ;; reminder: we only get called if we are not replacing the
@@ -112,14 +76,13 @@
alist) alist)
(define (alist-set! alist key value) (define (set! alist key value)
(mutate alist (set-type! (pair (pair (pair key value) (mutate alist (set-type! (pair (pair (pair key value)
(car alist)) (car alist))
()) ())
:alist))) :alist)))
(define (set-overwrite! alist key value)
(define (alist-set-overwrite! alist key value)
(let ((associations (first alist))) (let ((associations (first alist)))
(define (alist-set-overwrite-intern associations key value) (define (alist-set-overwrite-intern associations key value)
(cond ((= (caar associations) key) (cond ((= (caar associations) key)
@@ -129,9 +92,42 @@
(rest associations) key value)))) (rest associations) key value))))
(alist-set-overwrite-intern associations key value)) (alist-set-overwrite-intern associations key value))
alist) 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 (plist-get plist prop) (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))) (let ((props (first plist)))
(define (plist-get-intern props prop) (define (plist-get-intern props prop)
(cond ((null? props) (cond ((null? props)
@@ -141,11 +137,11 @@
(else (plist-get-intern (cddr props) prop)))) (else (plist-get-intern (cddr props) prop))))
(plist-get-intern props prop))) (plist-get-intern props prop)))
(define (plist-set! plist prop value) (define (set plist prop value)
(mutate plist (set-type! (pair (pair prop (pair value (first plist))) ()) (mutate plist (set-type! (pair (pair prop (pair value (first plist))) ())
:plist))) :plist)))
(define (plist-set-overwrite! plist prop value) (define (set-overwrite! plist prop value)
(let ((props (first plist))) (let ((props (first plist)))
(define (plist-set-overwrite-intern props prop value) (define (plist-set-overwrite-intern props prop value)
(cond ((= (car props) prop) (cond ((= (car props) prop)
@@ -156,7 +152,7 @@
(plist-set-overwrite-intern props prop value)) (plist-set-overwrite-intern props prop value))
plist) plist)
(define (plist-find plist prop) (define (find plist prop)
(let ((props (first plist))) (let ((props (first plist)))
(define (plist-find-intern props prop current-index) (define (plist-find-intern props prop current-index)
(cond ((null? props) key-not-found-index) (cond ((null? props) key-not-found-index)
@@ -165,11 +161,11 @@
(+ 1 current-index))))) (+ 1 current-index)))))
(plist-find-intern props prop 0))) (plist-find-intern props prop 0)))
(define (plist-prop-exists? plist prop) (define (prop-exists? plist prop)
(not (= (plist-find plist prop) (not (= (plist-find plist prop)
key-not-found-index))) key-not-found-index)))
(define (plist-remove! plist prop) (define (remove! plist prop)
(let ((index (plist-find plist prop))) (let ((index (plist-find plist prop)))
(define (plist-remove!-internal props index) (define (plist-remove!-internal props index)
;; reminder: we only get called if we are not replacing the ;; reminder: we only get called if we are not replacing the
@@ -187,3 +183,6 @@
((= index 0) (mutate plist (pair (cddar plist) ()))) ((= index 0) (mutate plist (pair (cddar plist) ())))
(else (plist-remove!-internal plist index)))) (else (plist-remove!-internal plist index))))
plist) plist)
)
)
-1
View File
@@ -42,7 +42,6 @@
(lambda (t) (lambda (t)
(point-lerp (lerper1 t) (point-lerp (lerper1 t)
(lerper2 t) t)))) (lerper2 t) t))))
) )
+1 -2
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -1,157 +1,157 @@
proc generate_docs(String* path) -> void { // proc generate_docs(String* path) -> void {
FILE *f = fopen(Memory::get_c_str(path), "w"); // FILE *f = fopen(Memory::get_c_str(path), "w");
if (!f) { // if (!f) {
create_generic_error("The file for writing the documentation (%s) " // create_generic_error("The file for writing the documentation (%s) "
"could not be opened for writing.", Memory::get_c_str(path)); // "could not be opened for writing.", Memory::get_c_str(path));
return; // return;
} // }
defer { // defer {
fclose(f); // fclose(f);
}; // };
Environment_Array_List visited = create_Environment_array_list(); // Environment_Array_List visited = create_Environment_array_list();
// recursive inner funciton // // recursive inner funciton
std::function<void(Environment*, char* prefix)> print_this_env; // std::function<void(Environment*, char* prefix)> print_this_env;
print_this_env = [&](Environment* env, char* prefix) -> void { // print_this_env = [&](Environment* env, char* prefix) -> void {
bool we_already_printed = false; // bool we_already_printed = false;
// TODO(Felix): Make a generic array_list_contains function // // TODO(Felix): Make a generic array_list_contains function
for_array_list(visited) { // for_array_list(visited) {
if (it == env) { // if (it == env) {
we_already_printed = true; // we_already_printed = true;
break; // break;
} // }
} // }
if (!we_already_printed) { // if (!we_already_printed) {
printf("Working ion env::::"); // printf("Working ion env::::");
print_environment(env); // print_environment(env);
printf("\n--------------------------------\n"); // printf("\n--------------------------------\n");
append_to_array_list(&visited, env); // append_to_array_list(&visited, env);
push_environment(env); // push_environment(env);
defer { // defer {
pop_environment(); // pop_environment();
}; // };
for (int i = 0; i < env->next_index; ++i) { // for (int i = 0; i < env->next_index; ++i) {
fprintf(f, "\\hrule\n* =%s%s= \n" // fprintf(f, "\\hrule\n* =%s%s= \n"
// " :PROPERTIES:\n" // // " :PROPERTIES:\n"
// " :UNNUMBERED: t\n" // // " :UNNUMBERED: t\n"
// " :END:" // // " :END:"
,prefix, env->keys[i]); // ,prefix, env->keys[i]);
/* // /*
* sourcecodeLocation // * sourcecodeLocation
*/ // */
if (env->values[i]->sourceCodeLocation) { // if (env->values[i]->sourceCodeLocation) {
try_void fprintf(f, "\n - defined in :: =%s:%d:%d=", // try_void fprintf(f, "\n - defined in :: =%s:%d:%d=",
Memory::get_c_str(env->values[i]->sourceCodeLocation->file), // Memory::get_c_str(env->values[i]->sourceCodeLocation->file),
env->values[i]->sourceCodeLocation->line, // env->values[i]->sourceCodeLocation->line,
env->values[i]->sourceCodeLocation->column); // env->values[i]->sourceCodeLocation->column);
} // }
/* // /*
* type // * type
*/ // */
Lisp_Object_Type type = Memory::get_type(env->values[i]); // Lisp_Object_Type type = Memory::get_type(env->values[i]);
Lisp_Object* LOtype; // Lisp_Object* LOtype;
try_void LOtype = eval_expr(Memory::create_list( // try_void LOtype = eval_expr(Memory::create_list(
Memory::get_or_create_lisp_object_symbol("type"), // Memory::get_or_create_lisp_object_symbol("type"),
env->values[i])); // env->values[i]));
fprintf(f, "\n - type :: ="); // fprintf(f, "\n - type :: =");
print(LOtype, true, f); // print(LOtype, true, f);
fprintf(f, "="); // fprintf(f, "=");
/* // /*
* if printable value -> print it // * if printable value -> print it
*/ // */
switch (type) { // switch (type) {
case(Lisp_Object_Type::Nil): // case(Lisp_Object_Type::Nil):
case(Lisp_Object_Type::T): // case(Lisp_Object_Type::T):
case(Lisp_Object_Type::Number): // case(Lisp_Object_Type::Number):
case(Lisp_Object_Type::String): // case(Lisp_Object_Type::String):
case(Lisp_Object_Type::Pair): // case(Lisp_Object_Type::Pair):
case(Lisp_Object_Type::Symbol): // case(Lisp_Object_Type::Symbol):
case(Lisp_Object_Type::Keyword): { // case(Lisp_Object_Type::Keyword): {
fprintf(f, "\n - value :: ="); // fprintf(f, "\n - value :: =");
print(env->values[i], true, f); // print(env->values[i], true, f);
fprintf(f, "="); // fprintf(f, "=");
} break; // } break;
default: break; // default: break;
} // }
/* // /*
* if function then print arguments // * if function then print arguments
*/ // */
if (type == Lisp_Object_Type::Function) { // if (type == Lisp_Object_Type::Function) {
Lisp_Object* fun = env->values[i]; // Lisp_Object* fun = env->values[i];
bool printed_at_least_some_args = false; // bool printed_at_least_some_args = false;
fprintf(f, "\n - arguments :: "); // fprintf(f, "\n - arguments :: ");
if (fun->value.function.args.positional.symbols.next_index != 0) { // if (fun->value.function.args.positional.symbols.next_index != 0) {
if (!printed_at_least_some_args) // if (!printed_at_least_some_args)
fprintf(f, ":"); // fprintf(f, ":");
fprintf(f, "\n - postitional :: "); // fprintf(f, "\n - postitional :: ");
try_void fprintf(f, "=%s=", Memory::get_c_str(fun->value.function.args.positional.symbols.data[0]->value.symbol.identifier)); // 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) { // 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)); // 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 (fun->value.function.args.keyword.values.next_index != 0) {
if (!printed_at_least_some_args) // if (!printed_at_least_some_args)
fprintf(f, ":"); // fprintf(f, ":");
fprintf(f, "\n - keyword :: "); // fprintf(f, "\n - keyword :: ");
fprintf(f, "=%s=", Memory::get_c_str(fun->value.function.args.keyword.keywords.data[0]->value.symbol.identifier)); // 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]) { // if (fun->value.function.args.keyword.values.data[0]) {
fprintf(f, " =("); // fprintf(f, " =(");
print(fun->value.function.args.keyword.values.data[0], true, f); // print(fun->value.function.args.keyword.values.data[0], true, f);
fprintf(f, ")="); // fprintf(f, ")=");
} // }
for (int i = 1; i < fun->value.function.args.keyword.values.next_index; ++i) { // 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)); // 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]) { // if (fun->value.function.args.keyword.values.data[i]) {
fprintf(f, " =("); // fprintf(f, " =(");
print(fun->value.function.args.keyword.values.data[i], true, f); // print(fun->value.function.args.keyword.values.data[i], true, f);
fprintf(f, ")="); // fprintf(f, ")=");
} // }
} // }
} // }
if (fun->value.function.args.rest) { // if (fun->value.function.args.rest) {
if (!printed_at_least_some_args) // if (!printed_at_least_some_args)
fprintf(f, ":"); // fprintf(f, ":");
fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(fun->value.function.args.rest->value.symbol.identifier)); // fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(fun->value.function.args.rest->value.symbol.identifier));
} // }
// if no args at all // // if no args at all
if (fun->value.function.args.positional.symbols.next_index == 0 && // if (fun->value.function.args.positional.symbols.next_index == 0 &&
fun->value.function.args.keyword.values.next_index == 0 && // fun->value.function.args.keyword.values.next_index == 0 &&
!fun->value.function.args.rest) // !fun->value.function.args.rest)
{ // {
fprintf(f, "none."); // fprintf(f, "none.");
} // }
} // }
fprintf(f, "\n - docu :: "); // fprintf(f, "\n - docu :: ");
if (env->values[i]->docstring) // if (env->values[i]->docstring)
fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n", // fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n",
Memory::get_c_str(env->values[i]->docstring)); // Memory::get_c_str(env->values[i]->docstring));
else // else
fprintf(f, "none\n"); // fprintf(f, "none\n");
// if (Memory::get_type(env->values[i]) == Lisp_Object_Type::Function && // // if (Memory::get_type(env->values[i]) == Lisp_Object_Type::Function &&
// env->values[i]->userType && // // env->values[i]->userType &&
// (string_equal(env->values[i]->userType->value.symbol.identifier, "package") || // // (string_equal(env->values[i]->userType->value.symbol.identifier, "package") ||
// string_equal(env->values[i]->userType->value.symbol.identifier, "constructor"))) // // string_equal(env->values[i]->userType->value.symbol.identifier, "constructor")))
// { // // {
// char new_prefix[200]; // // char new_prefix[200];
// strcpy(new_prefix, prefix); // // strcpy(new_prefix, prefix);
// strcat(new_prefix, env->keys[i]); // // strcat(new_prefix, env->keys[i]);
// strcat(new_prefix, " "); // // strcat(new_prefix, " ");
// print_this_env(env->values[i]->value.function.parent_environment, new_prefix); // // print_this_env(env->values[i]->value.function.parent_environment, new_prefix);
// } // // }
} // }
} // }
for (int i = 0; i < env->parents.next_index; ++i) { // for (int i = 0; i < env->parents.next_index; ++i) {
print_this_env(env->parents.data[i], prefix); // print_this_env(env->parents.data[i], prefix);
} // }
}; // };
print_this_env(get_current_environment(), (char*)""); // print_this_env(get_current_environment(), (char*)"");
} // }
+17 -33
View File
@@ -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();
hm_set(env->hm, Memory::get_c_str(symbol->value.symbol.identifier), value);
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;
} }
proc lookup_symbol_in_this_envt(String* identifier, Environment* env) -> Lisp_Object* { inline proc lookup_symbol_in_this_envt(String* identifier, Environment* env) -> Lisp_Object* {
for (int i = env->next_index - 1; i >= 0; --i) return (Lisp_Object*)hm_get_object(env->hm, Memory::get_c_str(identifier));
if (string_equal(env->keys[i], Memory::get_c_str(identifier)))
return env->values[i];
return nullptr;
} }
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) { printf("TODO\n");
print_indent(indent); // for (int i = 0; i < env->next_index; ++i) {
printf("-> %s :: ", env->keys[i]); // print_indent(indent);
print(env->values[i]); // printf("-> %s :: ", env->keys[i]);
printf(" (%lld)", (long long)env->values[i]); // print(env->values[i]);
puts(""); // printf(" (%lld)", (long long)env->values[i]);
} // puts("");
for (int i = 0; i < env->parents.next_index; ++i) { // }
print_indent(indent); // for (int i = 0; i < env->parents.next_index; ++i) {
printf("parent (%lld)", (long long)env->parents.data[i]); // print_indent(indent);
puts(":"); // printf("parent (%lld)", (long long)env->parents.data[i]);
print_environment_indent(env->parents.data[i], indent+4); // puts(":");
} // print_environment_indent(env->parents.data[i], indent+4);
// }
} }
proc print_environment(Environment* env) -> void { proc print_environment(Environment* env) -> void {
+1 -1
Submodule src/ftb updated: 2b00885ba2...b9de82c0d8
+4 -4
View File
@@ -68,10 +68,10 @@ namespace GC {
maybe_mark(it); maybe_mark(it);
} }
Lisp_Object* it = env->values[0]; // Lisp_Object* it = env->values[0];
for (int i = 0; i < env->next_index; it = env->values[++i]) { // for (int i = 0; i < env->next_index; it = env->values[++i]) {
maybe_mark(it); // maybe_mark(it);
} // }
} }
proc garbage_collect() -> void { proc garbage_collect() -> void {
+1 -4
View File
@@ -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->hm = create_hashmap();
env->next_index = 0;
env->keys = (char**)malloc(start_capacity * sizeof(char*));
env->values = (Lisp_Object**)malloc(start_capacity * sizeof(Lisp_Object*));
return env; return env;
} }
+1
View File
@@ -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
View File
@@ -111,12 +111,13 @@ struct Arguments {
struct Environment { struct Environment {
Environment_Array_List parents; Environment_Array_List parents;
int capacity; StringHashMap* hm;
int next_index; // int capacity;
// int next_index;
// TODO(Felix): Use a hashmap here. // // TODO(Felix): Use a hashmap here.
char** keys; // char** keys;
Lisp_Object** values; // Lisp_Object** values;
}; };
struct Function { struct Function {