felix/slime
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

hashmaps test

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files
bin/alist.slime
+58 -59
View File
@@ -1,43 +1,20 @@
(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-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 (make-alist)
(define-module alist
:imports ("cxr.slime")
:exports (make print get find key-exists? remove! set! set-overwrite!)
(define (make)
(set-type!
'(())
:alist))
(define (make-plist)
(set-type!
'(())
:plist))
(define (pprint-alist alist)
(define (print alist)
(let ((associations (first alist)))
(define (pprint-intern associations)
(when associations
@@ -51,21 +28,8 @@
(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)
(define (get alist key)
(let ((associations (first alist)))
(define (alist-get-intern associations key)
(cond ((null? associations)
@@ -76,7 +40,7 @@
(alist-get-intern associations key)))
(define (alist-find alist key)
(define (find alist key)
(let ((associations (first alist)))
(define (alist-find-intern associations key current-index)
(cond ((null? associations) key-not-found-index)
@@ -87,12 +51,12 @@
(alist-find-intern associations key 0)))
(define (alist-key-exists? alist key)
(define (key-exists? alist key)
(not (= (alist-find alist key)
key-not-found-index)))
(define (alist-remove! alist key)
(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
@@ -112,14 +76,13 @@
alist)
(define (alist-set! alist key value)
(define (set! alist key value)
(mutate alist (set-type! (pair (pair (pair key value)
(car alist))
())
:alist)))
(define (alist-set-overwrite! alist key value)
(define (set-overwrite! alist key value)
(let ((associations (first alist)))
(define (alist-set-overwrite-intern associations key value)
(cond ((= (caar associations) key)
@@ -129,9 +92,42 @@
(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 (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)))
(define (plist-get-intern props prop)
(cond ((null? props)
@@ -141,11 +137,11 @@
(else (plist-get-intern (cddr 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))) ())
:plist)))
(define (plist-set-overwrite! plist prop value)
(define (set-overwrite! plist prop value)
(let ((props (first plist)))
(define (plist-set-overwrite-intern props prop value)
(cond ((= (car props) prop)
@@ -156,7 +152,7 @@
(plist-set-overwrite-intern props prop value))
plist)
(define (plist-find plist prop)
(define (find plist prop)
(let ((props (first plist)))
(define (plist-find-intern props prop current-index)
(cond ((null? props) key-not-found-index)
@@ -165,11 +161,11 @@
(+ 1 current-index)))))
(plist-find-intern props prop 0)))
(define (plist-prop-exists? plist prop)
(define (prop-exists? plist prop)
(not (= (plist-find plist prop)
key-not-found-index)))
(define (plist-remove! plist prop)
(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
@@ -187,3 +183,6 @@
((= index 0) (mutate plist (pair (cddar plist) ())))
(else (plist-remove!-internal plist index))))
plist)
)
)
bin/interpolation.slime
-1
View File
@@ -42,7 +42,6 @@
(lambda (t)
(point-lerp (lerper1 t)
(lerper2 t) t))))
)
bin/sets.slime
+1 -2
View File
@@ -1,8 +1,7 @@
(define-module set
:imports ("cxr.slime")
:exports (make find contains? insert!)
(import "cxr.slime")
(define key-not-found-index -1)
(define (make . vals)
build.sh
+1 -1
View File
@@ -4,7 +4,7 @@ pushd $SCRIPTPATH > /dev/null
# _DEBUG
# 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 ""
pushd ./bin > /dev/null
src/built_ins.cpp
+1 -2
View File
@@ -301,7 +301,6 @@ proc load_built_ins_into_environment() -> void {
define((* . args), "TODO")
{
fetch(args);
if (args == Memory::nil) {
return Memory::create_lisp_object_number(1);
}
@@ -951,7 +950,7 @@ proc load_built_ins_into_environment() -> void {
define((generate-docs file_name), "TODO") {
fetch(file_name);
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;
};
define((print (:sep " ") (:end "\n") . things), "TODO") {
src/docgeneration.cpp
+154 -154
View File
@@ -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);
};
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);
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]));
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 (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);
// 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);
// };
for (int i = 0; i < env->parents.next_index; ++i) {
print_this_env(env->parents.data[i], prefix);
}
};
// Environment_Array_List visited = create_Environment_array_list();
print_this_env(get_current_environment(), (char*)"");
}
// // 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();
// };
// 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, "=");
// /*
// * 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);
// // }
// }
// }
// 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*)"");
// }
src/env.cpp
+17 -33
View File
@@ -1,27 +1,10 @@
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();
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*));
hm_set(env->hm, Memory::get_c_str(symbol->value.symbol.identifier), value);
}
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* {
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 {
@@ -112,19 +95,20 @@ proc print_environment_indent(Environment* env, int indent) -> void {
printf("[built-ins]-Environment (%lld)\n", (long long)env);
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 {
src/ftb
+1 -1
Submodule src/ftb updated: 2b00885ba2...b9de82c0d8
src/gc.cpp
+4 -4
View File
@@ -68,10 +68,10 @@ namespace GC {
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 {
src/memory.cpp
+1 -4
View File
@@ -379,10 +379,7 @@ namespace Memory {
if (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;
}
src/slime.h
+1
View File
@@ -26,6 +26,7 @@
#include "./ftb/macros.hpp"
#include "./ftb/profiler.hpp"
#include "./ftb/hashmap.hpp"
namespace Slime {
# include "./defines.cpp"
src/structs.cpp
+6 -5
View File
@@ -111,12 +111,13 @@ struct Arguments {
struct Environment {
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 {