hashmaps test
This commit is contained in:
+166
-167
@@ -1,189 +1,188 @@
|
|||||||
(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)
|
||||||
|
(set-type!
|
||||||
|
'(())
|
||||||
|
:alist))
|
||||||
|
|
||||||
(define (make-alist)
|
(define (print alist)
|
||||||
(set-type!
|
(let ((associations (first alist)))
|
||||||
'(())
|
(define (pprint-intern associations)
|
||||||
:alist))
|
(when associations
|
||||||
|
(print " "
|
||||||
(define (make-plist)
|
(caar associations) "->"
|
||||||
(set-type!
|
(cdar associations))
|
||||||
'(())
|
(pprint-intern (rest associations))))
|
||||||
:plist))
|
(print "(")
|
||||||
|
(when associations
|
||||||
(define (pprint-alist alist)
|
(print "\n")
|
||||||
(let ((associations (first alist)))
|
(pprint-intern associations))
|
||||||
(define (pprint-intern associations)
|
(print ")\n")))
|
||||||
(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)
|
(define (get alist key)
|
||||||
(let ((associations (first alist)))
|
(let ((associations (first alist)))
|
||||||
(define (alist-find-intern associations key current-index)
|
(define (alist-get-intern associations key)
|
||||||
(cond ((null? associations) key-not-found-index)
|
(cond ((null? associations)
|
||||||
((= (caar associations) key) current-index)
|
(error "key was not found in alist"))
|
||||||
(else (alist-find-intern (rest associations)
|
((= (caar associations) key)
|
||||||
key
|
(cdar associations))
|
||||||
(+ 1 current-index)))))
|
(else (alist-get-intern (rest associations) key))))
|
||||||
(alist-find-intern associations key 0)))
|
(alist-get-intern associations key)))
|
||||||
|
|
||||||
|
|
||||||
(define (alist-key-exists? alist key)
|
(define (find alist key)
|
||||||
(not (= (alist-find alist key)
|
(let ((associations (first alist)))
|
||||||
key-not-found-index)))
|
(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-remove! alist key)
|
(define (key-exists? alist key)
|
||||||
(let ((index (alist-find alist key)))
|
(not (= (alist-find alist key)
|
||||||
(define (alist-remove!-internal asociations index)
|
key-not-found-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)
|
(define (remove! alist key)
|
||||||
(mutate alist (set-type! (pair (pair (pair key value)
|
(let ((index (alist-find alist key)))
|
||||||
(car alist))
|
(define (alist-remove!-internal asociations index)
|
||||||
())
|
;; reminder: we only get called if we are not replacing the
|
||||||
:alist)))
|
;; 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-overwrite! alist key value)
|
(define (set! alist key value)
|
||||||
(let ((associations (first alist)))
|
(mutate alist (set-type! (pair (pair (pair key value)
|
||||||
(define (alist-set-overwrite-intern associations key value)
|
(car alist))
|
||||||
(cond ((= (caar associations) key)
|
())
|
||||||
(mutate (car associations) (pair key value)))
|
:alist)))
|
||||||
((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 (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)
|
(define-module plist
|
||||||
(let ((props (first plist)))
|
:imports ("cxr.slime")
|
||||||
(define (plist-get-intern props prop)
|
:exports (make print get find prop-exists? remove! set! set-overwrite!)
|
||||||
(cond ((null? props)
|
;; plist:
|
||||||
(error "property was not found in plist"))
|
;; [ |/]
|
||||||
((= (car props) prop)
|
;; |
|
||||||
(cadr props))
|
;; V
|
||||||
(else (plist-get-intern (cddr props) prop))))
|
;; [ | ]------------->[ | ]-------------> ...
|
||||||
(plist-get-intern props prop)))
|
;; | |
|
||||||
|
;; V V
|
||||||
|
;; :key1 value1
|
||||||
|
;;
|
||||||
|
;; '((:key1 value1 :key2 value2))
|
||||||
|
|
||||||
(define (plist-set! plist prop value)
|
(define (make)
|
||||||
(mutate plist (set-type! (pair (pair prop (pair value (first plist))) ())
|
(set-type!
|
||||||
:plist)))
|
'(())
|
||||||
|
:plist))
|
||||||
|
|
||||||
(define (plist-set-overwrite! plist prop value)
|
(define (print plist)
|
||||||
(let ((props (first plist)))
|
(let ((props (first plist)))
|
||||||
(define (plist-set-overwrite-intern props prop value)
|
(define (pprint-intern props)
|
||||||
(cond ((= (car props) prop)
|
(when props
|
||||||
(mutate (cdr props) (pair value (cddr props))))
|
(print " "
|
||||||
((null? props) (plist-set! plist prop value))
|
(car props) "->"
|
||||||
(else (plist-set-overwrite-intern
|
(cadr props))
|
||||||
(cddr props) prop value))))
|
(pprint-intern (cddr props))))
|
||||||
(plist-set-overwrite-intern props prop value))
|
(print "(")
|
||||||
plist)
|
(when props
|
||||||
|
(print "\n")
|
||||||
|
(pprint-intern props))
|
||||||
|
(print ")\n")))
|
||||||
|
|
||||||
(define (plist-find plist prop)
|
(define (get plist prop)
|
||||||
(let ((props (first plist)))
|
(let ((props (first plist)))
|
||||||
(define (plist-find-intern props prop current-index)
|
(define (plist-get-intern props prop)
|
||||||
(cond ((null? props) key-not-found-index)
|
(cond ((null? props)
|
||||||
((= (car props) prop) current-index)
|
(error "property was not found in plist"))
|
||||||
(else (plist-find-intern (cddr props) prop
|
((= (car props) prop)
|
||||||
(+ 1 current-index)))))
|
(cadr props))
|
||||||
(plist-find-intern props prop 0)))
|
(else (plist-get-intern (cddr props) prop))))
|
||||||
|
(plist-get-intern props prop)))
|
||||||
|
|
||||||
(define (plist-prop-exists? plist prop)
|
(define (set plist prop value)
|
||||||
(not (= (plist-find plist prop)
|
(mutate plist (set-type! (pair (pair prop (pair value (first plist))) ())
|
||||||
key-not-found-index)))
|
:plist)))
|
||||||
|
|
||||||
(define (plist-remove! plist prop)
|
(define (set-overwrite! plist prop value)
|
||||||
(let ((index (plist-find plist prop)))
|
(let ((props (first plist)))
|
||||||
(define (plist-remove!-internal props index)
|
(define (plist-set-overwrite-intern props prop value)
|
||||||
;; reminder: we only get called if we are not replacing the
|
(cond ((= (car props) prop)
|
||||||
;; first element in the alist
|
(mutate (cdr props) (pair value (cddr props))))
|
||||||
;; reminder2: we know that the key exists
|
((null? props) (plist-set! plist prop value))
|
||||||
(if (= index 1)
|
(else (plist-set-overwrite-intern
|
||||||
;; we want to remove the next one, so we set our
|
(cddr props) prop value))))
|
||||||
;; cdr to the next next one
|
(plist-set-overwrite-intern props prop value))
|
||||||
(mutate (cdar props) (pair (cadar props) ;; xD nice meme dude!!!
|
plist)
|
||||||
(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"))
|
(define (find plist prop)
|
||||||
((= index 0) (mutate plist (pair (cddar plist) ())))
|
(let ((props (first plist)))
|
||||||
(else (plist-remove!-internal plist index))))
|
(define (plist-find-intern props prop current-index)
|
||||||
plist)
|
(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)
|
||||||
|
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|||||||
@@ -42,7 +42,6 @@
|
|||||||
(lambda (t)
|
(lambda (t)
|
||||||
(point-lerp (lerper1 t)
|
(point-lerp (lerper1 t)
|
||||||
(lerper2 t) t))))
|
(lerper2 t) t))))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
+1
-2
@@ -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)
|
||||||
|
|||||||
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -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
@@ -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 {
|
||||||
|
|||||||
Reference in New Issue
Block a user