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

Work transfer

Browse Source
This commit is contained in:
Felix Brendel
2020-02-18 10:52:05 +01:00
parent 7aa492df67
commit 7c220ed9d6
72 changed files with 19257 additions and 19094 deletions
Download Patch File Download Diff File Expand all files Collapse all files
3rd/ftb
+1 -1
Submodule 3rd/ftb updated: 60e3253036...8b50444d9e
bin/pre.slime
+31 -32
View File
@@ -5,7 +5,12 @@
(mytry (hm/get hm key) ()))
(define-syntax (pe expr)
`(print ',expr "evaluates to" ,expr))
`((begin
(print :end " " ',expr "evaluates to")
((lambda (e)
(print e)
e) ,expr))
))
(define the-empty-stream ())
@@ -63,17 +68,15 @@ condition is false."
(iter (rest lists)
(pair (first elem) l1)
(pair (first (rest elem)) l2))
(list l1 l2))))
(iter lists () ()))
(list l1 l2)))
(iter lists () ())))
(define unzipped (unzip bindings))
`((,lambda ,(first unzipped) ,@body) ,@(first (rest unzipped))))
(define-syntax (cond . clauses)
(define (rec clauses)
(if (= nil clauses)
nil
(if (= () clauses)
()
(if (= (first (first clauses)) 'else)
(begin
(if (not (= (rest clauses) ()))
@@ -84,7 +87,6 @@ condition is false."
,(rec (rest clauses))))))
(rec clauses))
(define-syntax (case var . clauses)
(define (rec clauses)
(if (= nil clauses)
@@ -163,14 +165,30 @@ condition is false."
(eval `(begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body))
(pair 'begin
(map (lambda (orig-export-name)
(let ((export-name (string->symbol
(concat-strings module-prefix
(symbol->string orig-export-name)))))
((lambda (export-name)
`(define ,export-name
,(mytry (eval orig-export-name)
(error :module-error "The module does not contain a key it tries to export")))))
,(eval orig-export-name)))
(string->symbol
(concat-strings module-prefix
(symbol->string orig-export-name)))))
exports))))
(define (tdefine-module module-name (:imports ()) (:exports ()) . body)
(let ((module-prefix (concat-strings (symbol->string module-name) "::"))
(exec `(begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body)))
(eval exec)
(enable-debug-log)
(pair begin
(map (lambda (orig-export-name)
((lambda (export-name)
`(define ,export-name
,(eval orig-export-name)))
(string->symbol
(concat-strings module-prefix
(symbol->string orig-export-name)))))
exports))
(disable-debug-log)
))
(define-syntax (generic-extend args . body)
(let ((fun-name (first args))
@@ -455,25 +473,6 @@ added to a list, which in the end is returned."
(enumerate-inner (rest seq) (+ 1 next-num)))))
(enumerate-inner seq 0))
;; (define (print (:sep " ") (:end "\n") . args)
;; "A wrapper for the built-in function [[=print=]] that accepts a
;; variable number of arguments and also provides keywords for specifying
;; the printed separators (=sep=) between the arguments and what should
;; be printed after the last argument (=end=)."
;; (define (print-inner args)
;; (if args
;; (begin
;; (print (first args))
;; (when (rest args)
;; (print sep))
;; (print-inner (rest args)))
;; ; else
;; (print end)))
;; (print-inner args)
;; ())
;; (generic-extend (+ v1 :vector v2 :vector)
;; (assert (= (vector-length v1)
bin/tests/modules.slime
+10 -1
View File
@@ -10,4 +10,13 @@
;; (assert (= math::pi 3.1415))
;; (assert (= math::tau (* 2 math::tau)))
(1 2 3)
(tdefine-module 'math
:exports
'(pi tau pow sqrt)
'(define pi 3.1415)
'(define tau (* 2 pi))
'(define (pow a b) (** a b))
'(define (sqrt a) (** a 0.5)))
bin/tests/sicp.slime
+35 -27
View File
@@ -1,3 +1,4 @@
;; (define (abs x)
;; (cond ((< x 0) (- x))
;; (else x)))
@@ -6,10 +7,10 @@
;; (assert (= (abs (- 2)) 2))
(define (abs x)
(if (< x 0)
(- x)
x))
;; (define (abs x)
;; (if (< x 0)
;; (- x)
;; x))
;; (assert (= (abs 12) 12))
;; (assert (= (abs (- 32)) 32))
@@ -40,8 +41,8 @@
;; (assert (= (a-plus-abs-b 1 2) 3))
;; (assert (= (a-plus-abs-b 1 -2) 3))
(define (square x) (* x x))
(define (cube x) (* x x x))
;; (define (square x) (* x x))
;; (define (cube x) (* x x x))
;; (assert (= ((lambda (x y z)
;; (+ x y (square z)))
@@ -57,8 +58,8 @@
;; (define (square x)
;; (* x x))
(define (average x y)
(/ (+ x y) 2))
;; (define (average x y)
;; (/ (+ x y) 2))
;; (define (improve guess x)
;; (average guess (/ x guess)))
@@ -119,30 +120,30 @@
;; ;;; factorial
;; ;;; -----------------
(define (factorial n)
(if (= n 1)
1
(* n (factorial (- n 1)))))
;; (define (factorial n)
;; (if (= n 1)
;; 1
;; (* n (factorial (- n 1)))))
(define (factorial2 n)
(fact-iter 1 1 n))
;; (define (factorial2 n)
;; (fact-iter 1 1 n))
(define (fact-iter product counter max-count)
(if (> counter max-count)
product
(fact-iter (* counter product) (+ counter 1) max-count)))
;; (define (fact-iter product counter max-count)
;; (if (> counter max-count)
;; product
;; (fact-iter (* counter product) (+ counter 1) max-count)))
(define (factorial3 n)
(define (iter product counter)
(if (> counter n)
product
(iter (* counter product) (+ counter 1))))
;; (define (factorial3 n)
;; (define (iter product counter)
;; (if (> counter n)
;; product
;; (iter (* counter product) (+ counter 1))))
(iter 1 1))
;; (iter 1 1))
(assert (= (factorial 6) 720))
(assert (= (factorial2 6) 720))
(assert (= (factorial3 6) 720))
;; (assert (= (factorial 6) 720))
;; (assert (= (factorial2 6) 720))
;; (assert (= (factorial3 6) 720))
;;; ----------------
;;; ackermann
@@ -153,6 +154,13 @@
((= n 0) (A (- m 1) 1))
(else (A (- m 1) (A m (- n 1))))))
;; (define (A m n)
;; (if (= m 0)
;; (+ n 1)
;; (if (= n 0)
;; (A (- m 1) 1)
;; (A (- m 1) (A m (- n 1))))))
(assert (= (A 0 0) 1))
(assert (= (A 1 2) 4))
(assert (= (A 3 1) 13))
bin/tests/simple_built_ins.slime
+58
View File
@@ -0,0 +1,58 @@
;;
;; let testing
;;
(assert (not (bound? var1)))
(assert (not (bound? var2)))
(assert (not (bound? var3)))
(let ((var1 1)
(var2 [1 2 3])
(var3 {1 2 3 4}))
(assert (bound? var1))
(assert (bound? var2))
(assert (bound? var3))
(assert (= var1 1))
(assert (= var2 [1 2 3]))
(assert (= var3 {1 2 3 4})))
(assert (not (bound? var1)))
(assert (not (bound? var2)))
(assert (not (bound? var3)))
(assert (= (let ((val 'sym))
val)
'sym))
(assert (= (let ()
'sym)
'sym))
;;
;; Quasiquote testing
;;
(assert (= '() `()))
(assert (= '(1 1 2)
`(1 1 2)))
(assert (= '(1 1 2)
`(1 ,1 2)))
(assert (= '(1 1 2)
`(1 ,(- 10 9) 2)))
(assert (= '(1 1 2)
`(1 ,@(list 1 2))))
(let ((body '(2 3)))
(assert (= '(1 2 3)
`(1 ,@body))))
(let ((body '((define a 1)
(define b 2)))
(imports '()))
(let ((expr `(begin ,@(map (lambda (x) `(import ,x)) imports) ,@body)))
(assert (= '(begin
(define a 1)
(define b 2))))
(eval expr)
(assert (= a 1))
(assert (= b 2))))
build.sh
+19 -19
View File
@@ -2,13 +2,13 @@ TIMEFORMAT=%3lU
SCRIPTPATH="$( cd "$(dirname "$0")" ; pwd -P )"
pushd $SCRIPTPATH > /dev/null
echo ""
echo "----------------------"
echo " compiling libslime "
echo "----------------------"
time clang++ --std=c++17 \
src/libslime.cpp -c -o libslime.o \
-I3rd/ || exit 1
# echo ""
# echo "----------------------"
# echo " compiling libslime "
# echo "----------------------"
# time clang++ --std=c++17 \
# src/libslime.cpp -c -o libslime.o \
# -I3rd/ || exit 1
echo ""
echo "------------------------------"
@@ -18,13 +18,13 @@ time clang++ -D_DEBUG -D_DONT_BREAK_ON_ERRORS \
src/main.cpp -gfull -gdwarf -o ./bin/slime_d --std=c++17 \
-I3rd/ || exit 1
echo ""
echo "--------------------------------"
echo " compiling fullslime (release) "
echo "--------------------------------"
time clang++ -D_DONT_BREAK_ON_ERRORS -O3 \
src/main.cpp -g -o ./bin/slime --std=c++17 \
-I3rd/ || exit 1
# echo ""
# echo "--------------------------------"
# echo " compiling fullslime (release) "
# echo "--------------------------------"
# time clang++ -D_DONT_BREAK_ON_ERRORS -O3 \
# src/main.cpp -g -o ./bin/slime --std=c++17 \
# -I3rd/ || exit 1
pushd ./bin > /dev/null
@@ -40,11 +40,11 @@ echo " running tests "
echo "----------------------"
time valgrind -q --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime_d --run-tests || exit 1
echo ""
echo "------------------------"
echo " running benches "
echo "------------------------"
hyperfine -s color --warmup 5 "./slime --run-tests > /dev/null"
# echo ""
# echo "------------------------"
# echo " running benches "
# echo "------------------------"
# hyperfine -s color --warmup 5 "./slime --run-tests > /dev/null"
popd > /dev/null
# popd > /dev/null
src/assert.hpp
+8 -5
View File
@@ -22,19 +22,22 @@
#define create_symbol_undefined_error(...) \
__create_error("symbol-undefined", __VA_ARGS__)
#define create_type_missmatch_error(expected, actual) \
__create_error("type-missmatch", \
"Type missmatch: expected %s, got %s", \
expected, actual)
#define create_type_missmatch_error(expected, actual, exp) \
__create_error("type-missmatch", \
"Type missmatch: expected %s, got %s in %s", \
expected, actual, exp)
#ifdef _DEBUG
#define assert_type(_node, _type) \
do { \
if (Memory::get_type(_node) != _type) { \
char* t = lisp_object_to_string(_node); \
defer { free(t); }; \
create_type_missmatch_error( \
Lisp_Object_Type_to_string(_type), \
Lisp_Object_Type_to_string(Memory::get_type(_node))); \
Lisp_Object_Type_to_string(Memory::get_type(_node)), \
t); \
} \
} while(0)
src/built_ins.cpp
+68 -9
View File
@@ -22,9 +22,40 @@ namespace Slime {
return lisp_object_equal(n1->value.pair.first, n2->value.pair.first) &&
lisp_object_equal(n1->value.pair.rest, n2->value.pair.rest);
} break;
case Lisp_Object_Type::HashMap:
case Lisp_Object_Type::Vector:
create_not_yet_implemented_error();
case Lisp_Object_Type::HashMap: {
auto n1_keys = n1->value.hashMap->get_all_keys();
auto n2_keys = n2->value.hashMap->get_all_keys();
defer {
n1_keys.dealloc();
n2_keys.dealloc();
};
if (n1_keys.next_index != n2_keys.next_index)
return false;
n1_keys.sort();
n2_keys.sort();
for (int i = 0; i < n1_keys.next_index; ++i) {
if (!lisp_object_equal(n1_keys[i], n2_keys[i]))
return false;
if (!lisp_object_equal(n1->value.hashMap->get_object(n1_keys[i]),
n2->value.hashMap->get_object(n2_keys[i])))
return false;
}
return true;
}
case Lisp_Object_Type::Vector: {
if (n1->value.vector.length != n2->value.vector.length )
return false;
for (int i = 0; i < n1->value.vector.length; ++i) {
if (!lisp_object_equal(n1->value.vector.data+i, n2->value.vector.data+i))
return false;
}
return true;
} break;
default: create_not_yet_implemented_error();
}
// we should never reach here
@@ -72,9 +103,9 @@ namespace Slime {
// NOTE(Felix): deferred so even if the eval failes, it will
// run
defer {
program->dealloc();
free(program);
free(file_content);
program->dealloc();
free(program);
free(file_content);
};
for (auto expr : *program) {
try result = eval_expr(expr);
@@ -234,6 +265,32 @@ namespace Slime {
profile_with_name("(helper)");
return Memory::create_lisp_object(101.0);
};
define((enable-debug-log), "") {
profile_with_name("(enable-debug-log)");
Globals::debug_log = true;
return Memory::t;
};
define((disable-debug-log), "") {
profile_with_name("(disable-debug-log)");
Globals::debug_log = false;
return Memory::t;
};
define_special((with-debug-log . rest), "") {
profile_with_name("(enable-debug-log)");
fetch(rest);
Lisp_Object* result;
Globals::debug_log = true;
in_caller_env {
for_lisp_list(rest) {
// TODO(Felix): hooky would be really nice to
// have. Then this would be a macro and we would
// reset the debug log
try result = eval_expr(it);
}
}
Globals::debug_log = false;
return result;
};
define((test (:k (helper))), "") {
profile_with_name("(test)");
fetch(k);
@@ -437,8 +494,10 @@ namespace Slime {
fetch(test);
in_caller_env {
if (is_truthy(nrc_eval(test)))
return Memory::t;
Lisp_Object* res;
try res = eval_expr(test);
if (is_truthy(res))
return Memory::t;
}
char* string = lisp_object_to_string(test, true);
@@ -970,7 +1029,7 @@ namespace Slime {
profile_with_name("(show)");
fetch(n);
try assert_type(n, Lisp_Object_Type::Function);
try assert(n->value.function->is_c);
try assert(!n->value.function->is_c);
puts("body:\n");
print(n->value.function->body.lisp_body);
puts("\n");
src/eval.cpp
+48 -47
View File
@@ -6,10 +6,11 @@ namespace Slime {
Array_List<Lisp_Object*>* cs,
Lisp_Object* function,
int arg_start,
int arg_count) -> Environment*
int arg_end) -> Environment*
{
profile_this();
int arg_pos = arg_start;
bool is_c_function = function->value.function->is_c;
Environment* new_env = Memory::create_child_environment(function->value.function->parent_environment);
Arguments* arg_spec = &function->value.function->args;
@@ -40,19 +41,23 @@ namespace Slime {
int obligatory_keywords_count = 0;
int read_obligatory_keywords_count = 0;
Lisp_Object* next_arg = cs->data[arg_start];
Lisp_Object* next_arg = cs->data[arg_pos];
proc read_positional_args = [&] {
for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
if (arg_count == 0) {
create_parsing_error("Wrong number of arguments.");
sym = arg_spec->positional.symbols.data[i];
if (arg_pos == arg_end) {
create_parsing_error(
"Not enough positional args supplied. Needed: %d suppied, %d.\n"
"Next missing arg is '%s'",
arg_spec->positional.symbols.next_index, arg_end-arg_pos,
&sym->value.symbol->data);
return;
}
// NOTE(Felix): We have to copy all the arguments,
// otherwise we change the program code.
// XXX(Felix): T C functions we pass by reference.
// TODO(Felix): Why did we decide this??
sym = arg_spec->positional.symbols.data[i];
if (is_c_function) {
define_symbol(sym, next_arg);
} else {
@@ -60,8 +65,7 @@ namespace Slime {
sym,
Memory::copy_lisp_object_except_pairs(next_arg));
}
next_arg = cs->data[++arg_start];
--arg_count;
next_arg = cs->data[++arg_pos];
}
};
@@ -72,7 +76,7 @@ namespace Slime {
// something that is not a keyword is encountered or a keyword
// that is not recognized is encoutered, jump out of the loop.
if (arg_count == 0) {
if (arg_pos == arg_end) {
return;
}
@@ -129,7 +133,7 @@ namespace Slime {
// okay so we found a keyword that has to be read in and was
// not already read in, is there a next element to actually
// set it to?
if (arg_count == 0) {
if (arg_pos == arg_end) {
create_generic_error(
"Attempting to set the keyword argument ':%s', but no value was supplied.",
&(next_arg->value.symbol->data));
@@ -139,8 +143,7 @@ namespace Slime {
// if not set it and then add it to the array list
Lisp_Object* key = next_arg;
try_void sym = Memory::get_symbol(key->value.symbol);
next_arg = cs->data[++arg_start];
--arg_count;
next_arg = cs->data[++arg_pos];
// NOTE(Felix): It seems we do not need to evaluate the argument here...
if (is_c_function) {
@@ -154,10 +157,9 @@ namespace Slime {
++read_obligatory_keywords_count;
// overstep both for next one
next_arg = cs->data[++arg_start];
--arg_count;
next_arg = cs->data[++arg_pos];
if (arg_count == 0) {
if (arg_pos == arg_end) {
break;
}
}
@@ -200,7 +202,7 @@ namespace Slime {
};
proc read_rest_arg = [&]() -> void {
if (arg_count == 0) {
if (arg_pos == arg_end) {
if (arg_spec->rest) {
define_symbol(arg_spec->rest, Memory::nil);
}
@@ -210,13 +212,10 @@ namespace Slime {
Lisp_Object* list;
try_void list = Memory::create_list(next_arg);
Lisp_Object* head = list;
next_arg = cs->data[++arg_start];
--arg_count;
while (arg_count > 0) {
for (++arg_pos;arg_pos < arg_end; ++arg_pos) {
next_arg = cs->data[arg_pos];
try_void head->value.pair.rest = Memory::create_list(next_arg);
head = head->value.pair.rest;
next_arg = cs->data[++arg_start];
--arg_count;
}
define_symbol(arg_spec->rest, list);
} else {
@@ -346,7 +345,7 @@ namespace Slime {
if (node == Memory::nil)
return 0;
assert_type(node, Lisp_Object_Type::Pair);
try assert_type(node, Lisp_Object_Type::Pair);
int len = 0;
@@ -380,7 +379,7 @@ namespace Slime {
return Memory::create_lisp_object_pair(begin_symbol, body);
}
proc nrc_eval(Lisp_Object* expr) -> Lisp_Object* {
proc eval_expr(Lisp_Object* expr) -> Lisp_Object* {
using namespace Globals::Current_Execution;
nass.reserve(1);
@@ -392,12 +391,13 @@ namespace Slime {
};
proc debug_step = [&] {
return;
// printf("%d\n", cs.next_index);
printf("cs:\n ");
for (auto lo : cs) {
print(lo, true);
printf("\n ");
if (!Globals::debug_log)
return;
printf("\n-------------------\ncs:\n ");
for (int i = 0; i < cs.next_index; ++i) {
char* t = lisp_object_to_string(cs.data[i], true);
printf(" %d: %s\n ", i, t);
defer { free(t); };
}
printf("\npcs:\n ");
for (auto lo : pcs) {
@@ -411,13 +411,13 @@ namespace Slime {
printf(" - %s\n ", [&]
{
switch(na) {
case NasAction::Pop_Environment: return "Pop_Environment";
case NasAction::Pop_Environment: return "Pop_Environment";
case NasAction::Define_Var: return "Define_Var";
case NasAction::Eval: return "Eval";
case NasAction::Step: return "Step";
case NasAction::TM: return "TM";
case NasAction::Pop: return "Pop";
case NasAction::If: return "If";
case NasAction::Eval: return "Eval";
case NasAction::Step: return "Step";
case NasAction::TM: return "TM";
case NasAction::Pop: return "Pop";
case NasAction::If: return "If";
}
return "??";
}());
@@ -506,8 +506,12 @@ namespace Slime {
}
} break;
default: {
create_generic_error("The first element of the pair was not a function but: %s",
Lisp_Object_Type_to_string(type));
char* t = lisp_object_to_string(pc);
defer {
free(t);
};
create_generic_error("The first element of the pair was not a function but: %s in %s",
Lisp_Object_Type_to_string(type), t);
return nullptr;
}
}
@@ -518,10 +522,11 @@ namespace Slime {
--pcs.next_index;
int am = ams.data[--ams.next_index];
Lisp_Object* function = cs.data[am];
assert_type(function, Lisp_Object_Type::Function);
Environment* extended_env =
create_extended_environment_for_function_application_nrc(
&cs, function, am+1, cs.next_index-am-1);
try assert_type(function, Lisp_Object_Type::Function);
Environment* extended_env;
try extended_env = create_extended_environment_for_function_application_nrc(
&cs, function, am+1, cs.next_index);
cs.next_index = am;
push_environment(extended_env);
if (function->value.function->is_c) {
@@ -572,10 +577,6 @@ namespace Slime {
return cs.data[--cs.next_index];
}
proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
return nrc_eval(node);
}
proc is_truthy(Lisp_Object* expression) -> bool {
Lisp_Object* result;
try result = eval_expr(expression);
@@ -607,12 +608,12 @@ namespace Slime {
line = read_expression();
try_void parsed = Parser::parse_single_expression(line);
free(line);
try_void evaluated = nrc_eval(parsed);
try_void evaluated = eval_expr(parsed);
// try_void evaluated = eval_expr(parsed);
if (evaluated != Memory::nil) {
if (evaluated && evaluated != Memory::nil) {
print(evaluated);
fputs("\n", stdout);
}
fputs("\n", stdout);
}
}
}
src/forward_decls.cpp
+2 -1
View File
@@ -16,7 +16,7 @@ namespace Slime {
Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*);
void define_symbol(Lisp_Object* symbol, Lisp_Object* value);
char* lisp_object_to_string(Lisp_Object* node, bool print_repr);
char* lisp_object_to_string(Lisp_Object* node, bool print_repr = true);
void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
void print_environment(Environment*);
@@ -73,6 +73,7 @@ namespace Slime {
}
namespace Globals {
extern bool debug_log;
extern char* bin_path;
extern Log_Level log_level;
extern Array_List<void*> load_path;
src/globals.cpp
+1 -1
View File
@@ -1,7 +1,7 @@
namespace Slime::Globals {
char* bin_path = nullptr;
Log_Level log_level = Log_Level::Debug;
bool debug_log = false;
Array_List<void*> load_path;
namespace Current_Execution {
Array_List<Lisp_Object*> cs;
src/io.cpp
+14 -13
View File
@@ -364,17 +364,12 @@ namespace Slime {
free(str);
}
return temp;
}
}
case (Lisp_Object_Type::String): {
asprintf(&temp, "%s", Memory::get_c_str(node->value.symbol));
if (print_repr) {
char* escaped = escape_string(Memory::get_c_str(node->value.string));
string_builder.append(strdup("\""));
string_builder.append(escaped);
string_builder.append(strdup("\""));
asprintf(&temp, "\"%s\"", escaped);
free(escaped);
temp = string_buider_to_string(string_builder);
// TODO free
return temp;
} else
return strdup(Memory::get_c_str(node->value.string));
@@ -401,12 +396,16 @@ namespace Slime {
return temp;
}
if (node->value.function->is_c) {
// NOTE(Felix): try to find the symbol it is bound to
// in global env
Lisp_Object* name = (Lisp_Object*)(get_root_environment()->hm.search_key_to_object(node));
switch (node->value.function->type.c_function_type) {
case C_Function_Type::cFunction: return strdup("[c-function]");
case C_Function_Type::cSpecial: return strdup("[c-special]");
case C_Function_Type::cMacro: return strdup("[c-macro]");
case C_Function_Type::cFunction: asprintf(&temp, "[c-function %s]",&((Lisp_Object*)name)->value.symbol->data); break;
case C_Function_Type::cSpecial: asprintf(&temp, "[c-special %s]", &((Lisp_Object*)name)->value.symbol->data); break;
case C_Function_Type::cMacro: asprintf(&temp, "[c-macro %s]", &((Lisp_Object*)name)->value.symbol->data); break;
default: return strdup("[c-??]");
}
return temp;
} else {
switch (node->value.function->type.lisp_function_type) {
case Lisp_Function_Type::Lambda: return strdup("[lambda]");
@@ -448,7 +447,6 @@ namespace Slime {
assert(head->value.pair.rest->value.pair.rest == Memory::nil);
string_builder.append(lisp_object_to_string(head->value.pair.rest->value.pair.first, print_repr));
temp = string_buider_to_string(string_builder);
return string_buider_to_string(string_builder);
} else if (symbol == quasiquote_sym) {
string_builder.append(strdup("`"));
@@ -485,9 +483,12 @@ namespace Slime {
}
proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
char* string = lisp_object_to_string(node, print_repr);
char* string = nullptr;
defer {
free(string);
};
string = lisp_object_to_string(node, print_repr);
fputs(string, file);
free(string);
}
proc print_single_call(Lisp_Object* obj) -> void {
src/lisp_object.cpp
-3
View File
@@ -33,9 +33,6 @@ namespace Slime {
sourceCodeLocation = 0;
switch (Memory::get_type(this)) {
case Lisp_Object_Type::HashMap: {
delete this->value.hashMap;
} break;
case Lisp_Object_Type::Function:{
this->value.function->args.positional.symbols.dealloc();
this->value.function->args.keyword.keywords.dealloc();
src/memory.cpp
+32 -10
View File
@@ -18,6 +18,16 @@ namespace Slime::Memory {
// ------------------
Bucket_Allocator<Environment> environment_memory(1024, 8);
// NOTE(Felix): we are doing hashmaps separately so we don't have
// to malloc them every time, and if two lisp objects have the
// same hashmap, it will not cause double free problems when
// freeing all at the end. It also plays nice with garbage
// collection
// ------------------
// Hashmaps
// ------------------
Bucket_Allocator<Hash_Map<Lisp_Object*, Lisp_Object*>> hashmap_memory(256, 8);
// ------------------
// strings
// ------------------
@@ -140,17 +150,23 @@ namespace Slime::Memory {
});
environment_memory.for_each([](Environment* env){
env->parents.dealloc();
env->~Environment();
env->hm.dealloc();
});
hashmap_memory.for_each([](Hash_Map<Lisp_Object*, Lisp_Object*>* hm){
hm->dealloc();
});
// free the exe dir:
free(Globals::load_path.data[0]);
Globals::load_path.dealloc();
// Globals::Current_Execution::call_stack.dealloc();
Globals::Current_Execution::envi_stack.dealloc();
Globals::Current_Execution::cs.dealloc();
Globals::Current_Execution::ams.dealloc();
Globals::Current_Execution::pcs.dealloc();
Globals::Current_Execution::nass.dealloc();
global_symbol_table.dealloc();
global_keyword_table.dealloc();
file_to_env_map.dealloc();
}
@@ -160,6 +176,7 @@ namespace Slime::Memory {
// inject a new array list;
env->parents.alloc();
env->hm.alloc();
if (parent)
env->parents.append(parent);
@@ -179,7 +196,11 @@ namespace Slime::Memory {
char* exe_path = get_exe_dir();
// don't free exe path because it will be used until end of time
Globals::load_path.alloc();
// Globals::Current_Execution::call_stack.alloc();
global_symbol_table.alloc();
global_keyword_table.alloc();
file_to_env_map.alloc();
Globals::Current_Execution::envi_stack.alloc();
Globals::Current_Execution::cs.alloc();
Globals::Current_Execution::nass.alloc();
@@ -223,13 +244,13 @@ namespace Slime::Memory {
free_spots_in_string_memory.next_index = 0;
global_symbol_table.~Hash_Map();
global_keyword_table.~Hash_Map();
file_to_env_map.~Hash_Map();
global_symbol_table.dealloc();
global_keyword_table.dealloc();
file_to_env_map.dealloc();
new(&global_symbol_table) Hash_Map<char*, Lisp_Object*>;
new(&global_keyword_table) Hash_Map<char*, Lisp_Object*>;
new(&file_to_env_map) Hash_Map<char*, Lisp_Object*>;
global_symbol_table.alloc();
global_keyword_table.alloc();
file_to_env_map.alloc();
try_void Parser::standard_in = create_string("stdin");
@@ -283,7 +304,8 @@ namespace Slime::Memory {
Lisp_Object* node;
try node = create_lisp_object();
set_type(node, Lisp_Object_Type::HashMap);
node->value.hashMap = new Hash_Map<Lisp_Object*, Lisp_Object*>;
node->value.hashMap = hashmap_memory.allocate();
node->value.hashMap->alloc();
return node;
}
src/structs.cpp
-4
View File
@@ -112,10 +112,6 @@ namespace Slime {
struct Environment {
Array_List<Environment*> parents;
Hash_Map<void*, Lisp_Object*> hm;
~Environment() {
hm.~Hash_Map();
}
};
struct Function {
src/testing.cpp
+2 -3
View File
@@ -628,9 +628,8 @@ namespace Slime {
invoke_test_script("import_and_load");
invoke_test_script("macro_expand");
invoke_test_script("sicp");
// invoke_test_script("modules");
invoke_test_script("simple_built_ins");
invoke_test_script("modules");
// invoke_test_script("class_macro");
// invoke_test_script("automata");
// invoke_test_script("alists");
todo.org
+14 -4
View File
@@ -1,8 +1,18 @@
* TODO rename slime to plisk
* TODO update header files
* TODO use better type names: u32, ..
* TODO write and/or as macros
* TODO docs as a external dict to make LO smaller
* TODO doc generation
* TODO function let
(let fac ([n 10])
(if (zero? n)
1
(* n (fac (sub1 n)))))
3628800
* TODO runHook NAS_Action
* TODO consisitent names (Lisp_Object_Type_to_string .. lisp_object_to_string)
* TODO rename modifying functions to prefix '!'
* TODO go through sicp and use the examples as test files
* TODO test macro expanding to macro
* TODO rename slime to plisk
* TODO BUG 1: eval dot notation
#+BEGIN_SRC lisp
(eval `(+ . ,(list 1 2 3)))