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) ())) (mytry (hm/get hm key) ()))
(define-syntax (pe expr) (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 ()) (define the-empty-stream ())
@@ -63,17 +68,15 @@ condition is false."
(iter (rest lists) (iter (rest lists)
(pair (first elem) l1) (pair (first elem) l1)
(pair (first (rest elem)) l2)) (pair (first (rest elem)) l2))
(list l1 l2)))) (list l1 l2)))
(iter lists () ())) (iter lists () ())))
(define unzipped (unzip bindings)) (define unzipped (unzip bindings))
`((,lambda ,(first unzipped) ,@body) ,@(first (rest unzipped)))) `((,lambda ,(first unzipped) ,@body) ,@(first (rest unzipped))))
(define-syntax (cond . clauses) (define-syntax (cond . clauses)
(define (rec clauses) (define (rec clauses)
(if (= nil clauses) (if (= () clauses)
nil ()
(if (= (first (first clauses)) 'else) (if (= (first (first clauses)) 'else)
(begin (begin
(if (not (= (rest clauses) ())) (if (not (= (rest clauses) ()))
@@ -84,7 +87,6 @@ condition is false."
,(rec (rest clauses)))))) ,(rec (rest clauses))))))
(rec clauses)) (rec clauses))
(define-syntax (case var . clauses) (define-syntax (case var . clauses)
(define (rec clauses) (define (rec clauses)
(if (= nil clauses) (if (= nil clauses)
@@ -163,14 +165,30 @@ condition is false."
(eval `(begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body)) (eval `(begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body))
(pair 'begin (pair 'begin
(map (lambda (orig-export-name) (map (lambda (orig-export-name)
(let ((export-name (string->symbol ((lambda (export-name)
(concat-strings module-prefix
(symbol->string orig-export-name)))))
`(define ,export-name `(define ,export-name
,(mytry (eval orig-export-name) ,(eval orig-export-name)))
(error :module-error "The module does not contain a key it tries to export"))))) (string->symbol
(concat-strings module-prefix
(symbol->string orig-export-name)))))
exports)))) 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) (define-syntax (generic-extend args . body)
(let ((fun-name (first args)) (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 (rest seq) (+ 1 next-num)))))
(enumerate-inner seq 0)) (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) ;; (generic-extend (+ v1 :vector v2 :vector)
;; (assert (= (vector-length v1) ;; (assert (= (vector-length v1)
bin/tests/modules.slime
+10 -1
View File
@@ -10,4 +10,13 @@
;; (assert (= math::pi 3.1415)) ;; (assert (= math::pi 3.1415))
;; (assert (= math::tau (* 2 math::tau))) ;; (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) ;; (define (abs x)
;; (cond ((< x 0) (- x)) ;; (cond ((< x 0) (- x))
;; (else x))) ;; (else x)))
@@ -6,10 +7,10 @@
;; (assert (= (abs (- 2)) 2)) ;; (assert (= (abs (- 2)) 2))
(define (abs x) ;; (define (abs x)
(if (< x 0) ;; (if (< x 0)
(- x) ;; (- x)
x)) ;; x))
;; (assert (= (abs 12) 12)) ;; (assert (= (abs 12) 12))
;; (assert (= (abs (- 32)) 32)) ;; (assert (= (abs (- 32)) 32))
@@ -40,8 +41,8 @@
;; (assert (= (a-plus-abs-b 1 2) 3)) ;; (assert (= (a-plus-abs-b 1 2) 3))
;; (assert (= (a-plus-abs-b 1 -2) 3)) ;; (assert (= (a-plus-abs-b 1 -2) 3))
(define (square x) (* x x)) ;; (define (square x) (* x x))
(define (cube x) (* x x x)) ;; (define (cube x) (* x x x))
;; (assert (= ((lambda (x y z) ;; (assert (= ((lambda (x y z)
;; (+ x y (square z))) ;; (+ x y (square z)))
@@ -57,8 +58,8 @@
;; (define (square x) ;; (define (square x)
;; (* x x)) ;; (* x x))
(define (average x y) ;; (define (average x y)
(/ (+ x y) 2)) ;; (/ (+ x y) 2))
;; (define (improve guess x) ;; (define (improve guess x)
;; (average guess (/ x guess))) ;; (average guess (/ x guess)))
@@ -119,30 +120,30 @@
;; ;;; factorial ;; ;;; factorial
;; ;;; ----------------- ;; ;;; -----------------
(define (factorial n) ;; (define (factorial n)
(if (= n 1) ;; (if (= n 1)
1 ;; 1
(* n (factorial (- n 1))))) ;; (* n (factorial (- n 1)))))
(define (factorial2 n) ;; (define (factorial2 n)
(fact-iter 1 1 n)) ;; (fact-iter 1 1 n))
(define (fact-iter product counter max-count) ;; (define (fact-iter product counter max-count)
(if (> counter max-count) ;; (if (> counter max-count)
product ;; product
(fact-iter (* counter product) (+ counter 1) max-count))) ;; (fact-iter (* counter product) (+ counter 1) max-count)))
(define (factorial3 n) ;; (define (factorial3 n)
(define (iter product counter) ;; (define (iter product counter)
(if (> counter n) ;; (if (> counter n)
product ;; product
(iter (* counter product) (+ counter 1)))) ;; (iter (* counter product) (+ counter 1))))
(iter 1 1)) ;; (iter 1 1))
(assert (= (factorial 6) 720)) ;; (assert (= (factorial 6) 720))
(assert (= (factorial2 6) 720)) ;; (assert (= (factorial2 6) 720))
(assert (= (factorial3 6) 720)) ;; (assert (= (factorial3 6) 720))
;;; ---------------- ;;; ----------------
;;; ackermann ;;; ackermann
@@ -153,6 +154,13 @@
((= n 0) (A (- m 1) 1)) ((= n 0) (A (- m 1) 1))
(else (A (- m 1) (A m (- n 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 0 0) 1))
(assert (= (A 1 2) 4)) (assert (= (A 1 2) 4))
(assert (= (A 3 1) 13)) (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 )" SCRIPTPATH="$( cd "$(dirname "$0")" ; pwd -P )"
pushd $SCRIPTPATH > /dev/null pushd $SCRIPTPATH > /dev/null
echo "" # echo ""
echo "----------------------" # echo "----------------------"
echo " compiling libslime " # echo " compiling libslime "
echo "----------------------" # echo "----------------------"
time clang++ --std=c++17 \ # time clang++ --std=c++17 \
src/libslime.cpp -c -o libslime.o \ # src/libslime.cpp -c -o libslime.o \
-I3rd/ || exit 1 # -I3rd/ || exit 1
echo "" echo ""
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 \ src/main.cpp -gfull -gdwarf -o ./bin/slime_d --std=c++17 \
-I3rd/ || exit 1 -I3rd/ || exit 1
echo "" # echo ""
echo "--------------------------------" # echo "--------------------------------"
echo " compiling fullslime (release) " # echo " compiling fullslime (release) "
echo "--------------------------------" # echo "--------------------------------"
time clang++ -D_DONT_BREAK_ON_ERRORS -O3 \ # time clang++ -D_DONT_BREAK_ON_ERRORS -O3 \
src/main.cpp -g -o ./bin/slime --std=c++17 \ # src/main.cpp -g -o ./bin/slime --std=c++17 \
-I3rd/ || exit 1 # -I3rd/ || exit 1
pushd ./bin > /dev/null pushd ./bin > /dev/null
@@ -40,11 +40,11 @@ echo " running tests "
echo "----------------------" echo "----------------------"
time valgrind -q --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime_d --run-tests || exit 1 time valgrind -q --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime_d --run-tests || exit 1
echo "" # echo ""
echo "------------------------" # echo "------------------------"
echo " running benches " # echo " running benches "
echo "------------------------" # echo "------------------------"
hyperfine -s color --warmup 5 "./slime --run-tests > /dev/null" # hyperfine -s color --warmup 5 "./slime --run-tests > /dev/null"
popd > /dev/null popd > /dev/null
# popd > /dev/null # popd > /dev/null
src/assert.hpp
+8 -5
View File
@@ -22,19 +22,22 @@
#define create_symbol_undefined_error(...) \ #define create_symbol_undefined_error(...) \
__create_error("symbol-undefined", __VA_ARGS__) __create_error("symbol-undefined", __VA_ARGS__)
#define create_type_missmatch_error(expected, actual) \ #define create_type_missmatch_error(expected, actual, exp) \
__create_error("type-missmatch", \ __create_error("type-missmatch", \
"Type missmatch: expected %s, got %s", \ "Type missmatch: expected %s, got %s in %s", \
expected, actual) expected, actual, exp)
#ifdef _DEBUG #ifdef _DEBUG
#define assert_type(_node, _type) \ #define assert_type(_node, _type) \
do { \ do { \
if (Memory::get_type(_node) != _type) { \ if (Memory::get_type(_node) != _type) { \
char* t = lisp_object_to_string(_node); \
defer { free(t); }; \
create_type_missmatch_error( \ create_type_missmatch_error( \
Lisp_Object_Type_to_string(_type), \ 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) } 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) && return lisp_object_equal(n1->value.pair.first, n2->value.pair.first) &&
lisp_object_equal(n1->value.pair.rest, n2->value.pair.rest); lisp_object_equal(n1->value.pair.rest, n2->value.pair.rest);
} break; } break;
case Lisp_Object_Type::HashMap: case Lisp_Object_Type::HashMap: {
case Lisp_Object_Type::Vector: auto n1_keys = n1->value.hashMap->get_all_keys();
create_not_yet_implemented_error(); 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 // we should never reach here
@@ -72,9 +103,9 @@ namespace Slime {
// NOTE(Felix): deferred so even if the eval failes, it will // NOTE(Felix): deferred so even if the eval failes, it will
// run // run
defer { defer {
program->dealloc(); program->dealloc();
free(program); free(program);
free(file_content); free(file_content);
}; };
for (auto expr : *program) { for (auto expr : *program) {
try result = eval_expr(expr); try result = eval_expr(expr);
@@ -234,6 +265,32 @@ namespace Slime {
profile_with_name("(helper)"); profile_with_name("(helper)");
return Memory::create_lisp_object(101.0); 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))), "") { define((test (:k (helper))), "") {
profile_with_name("(test)"); profile_with_name("(test)");
fetch(k); fetch(k);
@@ -437,8 +494,10 @@ namespace Slime {
fetch(test); fetch(test);
in_caller_env { in_caller_env {
if (is_truthy(nrc_eval(test))) Lisp_Object* res;
return Memory::t; try res = eval_expr(test);
if (is_truthy(res))
return Memory::t;
} }
char* string = lisp_object_to_string(test, true); char* string = lisp_object_to_string(test, true);
@@ -970,7 +1029,7 @@ namespace Slime {
profile_with_name("(show)"); profile_with_name("(show)");
fetch(n); fetch(n);
try assert_type(n, Lisp_Object_Type::Function); 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"); puts("body:\n");
print(n->value.function->body.lisp_body); print(n->value.function->body.lisp_body);
puts("\n"); puts("\n");
src/eval.cpp
+48 -47
View File
@@ -6,10 +6,11 @@ namespace Slime {
Array_List<Lisp_Object*>* cs, Array_List<Lisp_Object*>* cs,
Lisp_Object* function, Lisp_Object* function,
int arg_start, int arg_start,
int arg_count) -> Environment* int arg_end) -> Environment*
{ {
profile_this(); profile_this();
int arg_pos = arg_start;
bool is_c_function = function->value.function->is_c; bool is_c_function = function->value.function->is_c;
Environment* new_env = Memory::create_child_environment(function->value.function->parent_environment); Environment* new_env = Memory::create_child_environment(function->value.function->parent_environment);
Arguments* arg_spec = &function->value.function->args; Arguments* arg_spec = &function->value.function->args;
@@ -40,19 +41,23 @@ namespace Slime {
int obligatory_keywords_count = 0; int obligatory_keywords_count = 0;
int read_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 = [&] { proc read_positional_args = [&] {
for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) { for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
if (arg_count == 0) { sym = arg_spec->positional.symbols.data[i];
create_parsing_error("Wrong number of arguments."); 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; return;
} }
// NOTE(Felix): We have to copy all the arguments, // NOTE(Felix): We have to copy all the arguments,
// otherwise we change the program code. // otherwise we change the program code.
// XXX(Felix): T C functions we pass by reference. // XXX(Felix): T C functions we pass by reference.
// TODO(Felix): Why did we decide this?? // TODO(Felix): Why did we decide this??
sym = arg_spec->positional.symbols.data[i];
if (is_c_function) { if (is_c_function) {
define_symbol(sym, next_arg); define_symbol(sym, next_arg);
} else { } else {
@@ -60,8 +65,7 @@ namespace Slime {
sym, sym,
Memory::copy_lisp_object_except_pairs(next_arg)); Memory::copy_lisp_object_except_pairs(next_arg));
} }
next_arg = cs->data[++arg_start]; next_arg = cs->data[++arg_pos];
--arg_count;
} }
}; };
@@ -72,7 +76,7 @@ namespace Slime {
// something that is not a keyword is encountered or a keyword // something that is not a keyword is encountered or a keyword
// that is not recognized is encoutered, jump out of the loop. // that is not recognized is encoutered, jump out of the loop.
if (arg_count == 0) { if (arg_pos == arg_end) {
return; return;
} }
@@ -129,7 +133,7 @@ namespace Slime {
// okay so we found a keyword that has to be read in and was // 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 // not already read in, is there a next element to actually
// set it to? // set it to?
if (arg_count == 0) { if (arg_pos == arg_end) {
create_generic_error( create_generic_error(
"Attempting to set the keyword argument ':%s', but no value was supplied.", "Attempting to set the keyword argument ':%s', but no value was supplied.",
&(next_arg->value.symbol->data)); &(next_arg->value.symbol->data));
@@ -139,8 +143,7 @@ namespace Slime {
// if not set it and then add it to the array list // if not set it and then add it to the array list
Lisp_Object* key = next_arg; Lisp_Object* key = next_arg;
try_void sym = Memory::get_symbol(key->value.symbol); try_void sym = Memory::get_symbol(key->value.symbol);
next_arg = cs->data[++arg_start]; next_arg = cs->data[++arg_pos];
--arg_count;
// NOTE(Felix): It seems we do not need to evaluate the argument here... // NOTE(Felix): It seems we do not need to evaluate the argument here...
if (is_c_function) { if (is_c_function) {
@@ -154,10 +157,9 @@ namespace Slime {
++read_obligatory_keywords_count; ++read_obligatory_keywords_count;
// overstep both for next one // overstep both for next one
next_arg = cs->data[++arg_start]; next_arg = cs->data[++arg_pos];
--arg_count;
if (arg_count == 0) { if (arg_pos == arg_end) {
break; break;
} }
} }
@@ -200,7 +202,7 @@ namespace Slime {
}; };
proc read_rest_arg = [&]() -> void { proc read_rest_arg = [&]() -> void {
if (arg_count == 0) { if (arg_pos == arg_end) {
if (arg_spec->rest) { if (arg_spec->rest) {
define_symbol(arg_spec->rest, Memory::nil); define_symbol(arg_spec->rest, Memory::nil);
} }
@@ -210,13 +212,10 @@ namespace Slime {
Lisp_Object* list; Lisp_Object* list;
try_void list = Memory::create_list(next_arg); try_void list = Memory::create_list(next_arg);
Lisp_Object* head = list; Lisp_Object* head = list;
next_arg = cs->data[++arg_start]; for (++arg_pos;arg_pos < arg_end; ++arg_pos) {
--arg_count; next_arg = cs->data[arg_pos];
while (arg_count > 0) {
try_void head->value.pair.rest = Memory::create_list(next_arg); try_void head->value.pair.rest = Memory::create_list(next_arg);
head = head->value.pair.rest; head = head->value.pair.rest;
next_arg = cs->data[++arg_start];
--arg_count;
} }
define_symbol(arg_spec->rest, list); define_symbol(arg_spec->rest, list);
} else { } else {
@@ -346,7 +345,7 @@ namespace Slime {
if (node == Memory::nil) if (node == Memory::nil)
return 0; return 0;
assert_type(node, Lisp_Object_Type::Pair); try assert_type(node, Lisp_Object_Type::Pair);
int len = 0; int len = 0;
@@ -380,7 +379,7 @@ namespace Slime {
return Memory::create_lisp_object_pair(begin_symbol, body); 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; using namespace Globals::Current_Execution;
nass.reserve(1); nass.reserve(1);
@@ -392,12 +391,13 @@ namespace Slime {
}; };
proc debug_step = [&] { proc debug_step = [&] {
return; if (!Globals::debug_log)
// printf("%d\n", cs.next_index); return;
printf("cs:\n "); printf("\n-------------------\ncs:\n ");
for (auto lo : cs) { for (int i = 0; i < cs.next_index; ++i) {
print(lo, true); char* t = lisp_object_to_string(cs.data[i], true);
printf("\n "); printf(" %d: %s\n ", i, t);
defer { free(t); };
} }
printf("\npcs:\n "); printf("\npcs:\n ");
for (auto lo : pcs) { for (auto lo : pcs) {
@@ -411,13 +411,13 @@ namespace Slime {
printf(" - %s\n ", [&] printf(" - %s\n ", [&]
{ {
switch(na) { 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::Define_Var: return "Define_Var";
case NasAction::Eval: return "Eval"; case NasAction::Eval: return "Eval";
case NasAction::Step: return "Step"; case NasAction::Step: return "Step";
case NasAction::TM: return "TM"; case NasAction::TM: return "TM";
case NasAction::Pop: return "Pop"; case NasAction::Pop: return "Pop";
case NasAction::If: return "If"; case NasAction::If: return "If";
} }
return "??"; return "??";
}()); }());
@@ -506,8 +506,12 @@ namespace Slime {
} }
} break; } break;
default: { default: {
create_generic_error("The first element of the pair was not a function but: %s", char* t = lisp_object_to_string(pc);
Lisp_Object_Type_to_string(type)); 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; return nullptr;
} }
} }
@@ -518,10 +522,11 @@ namespace Slime {
--pcs.next_index; --pcs.next_index;
int am = ams.data[--ams.next_index]; int am = ams.data[--ams.next_index];
Lisp_Object* function = cs.data[am]; Lisp_Object* function = cs.data[am];
assert_type(function, Lisp_Object_Type::Function); try assert_type(function, Lisp_Object_Type::Function);
Environment* extended_env =
create_extended_environment_for_function_application_nrc( Environment* extended_env;
&cs, function, am+1, cs.next_index-am-1); try extended_env = create_extended_environment_for_function_application_nrc(
&cs, function, am+1, cs.next_index);
cs.next_index = am; cs.next_index = am;
push_environment(extended_env); push_environment(extended_env);
if (function->value.function->is_c) { if (function->value.function->is_c) {
@@ -572,10 +577,6 @@ namespace Slime {
return cs.data[--cs.next_index]; 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 { proc is_truthy(Lisp_Object* expression) -> bool {
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression); try result = eval_expr(expression);
@@ -607,12 +608,12 @@ namespace Slime {
line = read_expression(); line = read_expression();
try_void parsed = Parser::parse_single_expression(line); try_void parsed = Parser::parse_single_expression(line);
free(line); free(line);
try_void evaluated = nrc_eval(parsed); try_void evaluated = eval_expr(parsed);
// try_void evaluated = eval_expr(parsed); // try_void evaluated = eval_expr(parsed);
if (evaluated != Memory::nil) { if (evaluated && evaluated != Memory::nil) {
print(evaluated); 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*); Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*);
void define_symbol(Lisp_Object* symbol, Lisp_Object* value); 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(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
void print_environment(Environment*); void print_environment(Environment*);
@@ -73,6 +73,7 @@ namespace Slime {
} }
namespace Globals { namespace Globals {
extern bool debug_log;
extern char* bin_path; extern char* bin_path;
extern Log_Level log_level; extern Log_Level log_level;
extern Array_List<void*> load_path; extern Array_List<void*> load_path;
src/globals.cpp
+1 -1
View File
@@ -1,7 +1,7 @@
namespace Slime::Globals { namespace Slime::Globals {
char* bin_path = nullptr; char* bin_path = nullptr;
Log_Level log_level = Log_Level::Debug; Log_Level log_level = Log_Level::Debug;
bool debug_log = false;
Array_List<void*> load_path; Array_List<void*> load_path;
namespace Current_Execution { namespace Current_Execution {
Array_List<Lisp_Object*> cs; Array_List<Lisp_Object*> cs;
src/io.cpp
+14 -13
View File
@@ -364,17 +364,12 @@ namespace Slime {
free(str); free(str);
} }
return temp; return temp;
} }
case (Lisp_Object_Type::String): { case (Lisp_Object_Type::String): {
asprintf(&temp, "%s", Memory::get_c_str(node->value.symbol));
if (print_repr) { if (print_repr) {
char* escaped = escape_string(Memory::get_c_str(node->value.string)); char* escaped = escape_string(Memory::get_c_str(node->value.string));
string_builder.append(strdup("\"")); asprintf(&temp, "\"%s\"", escaped);
string_builder.append(escaped);
string_builder.append(strdup("\""));
free(escaped); free(escaped);
temp = string_buider_to_string(string_builder);
// TODO free
return temp; return temp;
} else } else
return strdup(Memory::get_c_str(node->value.string)); return strdup(Memory::get_c_str(node->value.string));
@@ -401,12 +396,16 @@ namespace Slime {
return temp; return temp;
} }
if (node->value.function->is_c) { 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) { switch (node->value.function->type.c_function_type) {
case C_Function_Type::cFunction: return strdup("[c-function]"); case C_Function_Type::cFunction: asprintf(&temp, "[c-function %s]",&((Lisp_Object*)name)->value.symbol->data); break;
case C_Function_Type::cSpecial: return strdup("[c-special]"); case C_Function_Type::cSpecial: asprintf(&temp, "[c-special %s]", &((Lisp_Object*)name)->value.symbol->data); break;
case C_Function_Type::cMacro: return strdup("[c-macro]"); case C_Function_Type::cMacro: asprintf(&temp, "[c-macro %s]", &((Lisp_Object*)name)->value.symbol->data); break;
default: return strdup("[c-??]"); default: return strdup("[c-??]");
} }
return temp;
} else { } else {
switch (node->value.function->type.lisp_function_type) { switch (node->value.function->type.lisp_function_type) {
case Lisp_Function_Type::Lambda: return strdup("[lambda]"); case Lisp_Function_Type::Lambda: return strdup("[lambda]");
@@ -448,7 +447,6 @@ namespace Slime {
assert(head->value.pair.rest->value.pair.rest == Memory::nil); 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)); 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); return string_buider_to_string(string_builder);
} else if (symbol == quasiquote_sym) { } else if (symbol == quasiquote_sym) {
string_builder.append(strdup("`")); string_builder.append(strdup("`"));
@@ -485,9 +483,12 @@ namespace Slime {
} }
proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void { 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); fputs(string, file);
free(string);
} }
proc print_single_call(Lisp_Object* obj) -> void { proc print_single_call(Lisp_Object* obj) -> void {
src/lisp_object.cpp
-3
View File
@@ -33,9 +33,6 @@ namespace Slime {
sourceCodeLocation = 0; sourceCodeLocation = 0;
switch (Memory::get_type(this)) { switch (Memory::get_type(this)) {
case Lisp_Object_Type::HashMap: {
delete this->value.hashMap;
} break;
case Lisp_Object_Type::Function:{ case Lisp_Object_Type::Function:{
this->value.function->args.positional.symbols.dealloc(); this->value.function->args.positional.symbols.dealloc();
this->value.function->args.keyword.keywords.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); 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 // strings
// ------------------ // ------------------
@@ -140,17 +150,23 @@ namespace Slime::Memory {
}); });
environment_memory.for_each([](Environment* env){ environment_memory.for_each([](Environment* env){
env->parents.dealloc(); 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 the exe dir:
free(Globals::load_path.data[0]); free(Globals::load_path.data[0]);
Globals::load_path.dealloc(); Globals::load_path.dealloc();
// Globals::Current_Execution::call_stack.dealloc();
Globals::Current_Execution::envi_stack.dealloc(); Globals::Current_Execution::envi_stack.dealloc();
Globals::Current_Execution::cs.dealloc(); Globals::Current_Execution::cs.dealloc();
Globals::Current_Execution::ams.dealloc(); Globals::Current_Execution::ams.dealloc();
Globals::Current_Execution::pcs.dealloc(); Globals::Current_Execution::pcs.dealloc();
Globals::Current_Execution::nass.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; // inject a new array list;
env->parents.alloc(); env->parents.alloc();
env->hm.alloc();
if (parent) if (parent)
env->parents.append(parent); env->parents.append(parent);
@@ -179,7 +196,11 @@ namespace Slime::Memory {
char* exe_path = get_exe_dir(); char* exe_path = get_exe_dir();
// don't free exe path because it will be used until end of time // don't free exe path because it will be used until end of time
Globals::load_path.alloc(); 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::envi_stack.alloc();
Globals::Current_Execution::cs.alloc(); Globals::Current_Execution::cs.alloc();
Globals::Current_Execution::nass.alloc(); Globals::Current_Execution::nass.alloc();
@@ -223,13 +244,13 @@ namespace Slime::Memory {
free_spots_in_string_memory.next_index = 0; free_spots_in_string_memory.next_index = 0;
global_symbol_table.~Hash_Map(); global_symbol_table.dealloc();
global_keyword_table.~Hash_Map(); global_keyword_table.dealloc();
file_to_env_map.~Hash_Map(); file_to_env_map.dealloc();
new(&global_symbol_table) Hash_Map<char*, Lisp_Object*>; global_symbol_table.alloc();
new(&global_keyword_table) Hash_Map<char*, Lisp_Object*>; global_keyword_table.alloc();
new(&file_to_env_map) Hash_Map<char*, Lisp_Object*>; file_to_env_map.alloc();
try_void Parser::standard_in = create_string("stdin"); try_void Parser::standard_in = create_string("stdin");
@@ -283,7 +304,8 @@ namespace Slime::Memory {
Lisp_Object* node; Lisp_Object* node;
try node = create_lisp_object(); try node = create_lisp_object();
set_type(node, Lisp_Object_Type::HashMap); 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; return node;
} }
src/structs.cpp
-4
View File
@@ -112,10 +112,6 @@ namespace Slime {
struct Environment { struct Environment {
Array_List<Environment*> parents; Array_List<Environment*> parents;
Hash_Map<void*, Lisp_Object*> hm; Hash_Map<void*, Lisp_Object*> hm;
~Environment() {
hm.~Hash_Map();
}
}; };
struct Function { struct Function {
src/testing.cpp
+2 -3
View File
@@ -628,9 +628,8 @@ namespace Slime {
invoke_test_script("import_and_load"); invoke_test_script("import_and_load");
invoke_test_script("macro_expand"); invoke_test_script("macro_expand");
invoke_test_script("sicp"); 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("class_macro");
// invoke_test_script("automata"); // invoke_test_script("automata");
// invoke_test_script("alists"); // 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 rename modifying functions to prefix '!'
* TODO go through sicp and use the examples as test files * TODO rename slime to plisk
* TODO test macro expanding to macro
* TODO BUG 1: eval dot notation * TODO BUG 1: eval dot notation
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(eval `(+ . ,(list 1 2 3))) (eval `(+ . ,(list 1 2 3)))