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

Using ftb print and updated the doc generation

Browse Source
This commit is contained in:
FelixBrendel
2020-05-20 23:20:47 +02:00
parent e660884e49
commit f190f40402
21 changed files with 621 additions and 4823 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.gitignore
+2
View File
@@ -26,3 +26,5 @@ todo.html
/bin/slime_d /bin/slime_d
/bin/slime_p /bin/slime_p
*.json *.json
/bin/manual.pdf
/bin/manual.tex
3rd/ftb
+1 -1
Submodule 3rd/ftb updated: a77b139305...dc98c61901
bin/pre.slime
+18 -7
View File
@@ -1,10 +1,3 @@
;; (remove_when_double_free_is_fixed)
;; (remove_when_double_free_is_fixed_2)
;; (define (kk (:key ()))
;; ())
;; (kk)
(define pair cons) (define pair cons)
(define first car) (define first car)
(define rest cdr) (define rest cdr)
@@ -117,7 +110,25 @@ condition is false."
(define unzipped (unzip bindings)) (define unzipped (unzip bindings))
`((,lambda ,(car unzipped) ,@body) ,@(car (cdr unzipped)))) `((,lambda ,(car unzipped) ,@body) ,@(car (cdr unzipped))))
(define-macro (while cond . body)
(let ((gs (gensym)))
`(,let ((,gs ()))
(,set! ,gs
(,lambda ()
(,when ,cond
,@body
(,gs))))
(,gs))))
(define-macro (cond . clauses) (define-macro (cond . clauses)
"Example usage:
(define (prime? x)
(define (rec i)
(cond ((> i (** x 0.5)) t)
((= 0 (% x i)) ())
(else (rec (+ 1 i))))
)
(rec 2))"
(define (rec clauses) (define (rec clauses)
(if (= () clauses) (if (= () clauses)
() ()
build.bat
+9 -3
View File
@@ -7,25 +7,31 @@ set exeName=slime.exe
taskkill /F /IM %exeName% > NUL 2> NUL taskkill /F /IM %exeName% > NUL 2> NUL
echo ---------- Compiling ---------- echo ---------- Compiling ----------
call cl ^ call ..\timecmd cl ^
../src/main.cpp^ ../src/main.cpp^
/I../3rd/ ^ /I../3rd/ ^
/D_PROFILING /D_DEBUG /D_DONT_BREAK_ON_ERRORS ^ /D_PROFILING /D_DEBUG /D_DONT_BREAK_ON_ERRORS ^
/Zi /std:c++latest /Fe%exeName% /W3 /wd4003 /wd4996 /nologo /EHsc /Zi /std:c++latest /Fe%exeName% /W3 /wd4003 /wd4996 /nologo /EHsc
rem call ..\timecmd cl ^ rem call ..\timecmd cl ^
rem ../src/main.cpp^ rem ../src/main.cpp^
rem /I../3rd/ ^ rem /I../3rd/ ^
rem /O2 /D_DONT_BREAK_ON_ERRORS ^ rem /O2 /D_DONT_BREAK_ON_ERRORS ^
rem /std:c++latest /Fe%exeName% /W3 /wd4003 /nologo /EHsc rem /std:c++latest /Fe%exeName% /W3 /wd4003 /nologo /EHsc
rem call ..\timecmd clang-cl ../src/main.cpp -o %exeName% /O2 /std:c++latest /W3 /Zi /EHsc rem call ..\timecmd clang-cl ../src/main.cpp /I../3rd/ -o %exeName% /O2 /std:c++latest /W3 /Zi /EHsc
if %errorlevel% == 0 ( if %errorlevel% == 0 (
echo. echo.
echo -------- Running Tests -------- echo -------- Running Tests --------
echo. echo.
call slime.exe --run-tests call ..\timecmd slime.exe --run-tests
echo.
echo -------- Generatign Docs --------
echo.
call ..\timecmd slime.exe --generate-docs-file
rem call ..\manual\build.bat
) else ( ) else (
echo. echo.
echo Fuckin' ell echo Fuckin' ell
manual/build.bat
+22
View File
@@ -0,0 +1,22 @@
@echo off
@setlocal
pushd %~dp0\bin
echo ================================================
echo Starting Tex Export
echo ================================================
set FILENAME=manual
emacsclient -c --frame-parameters="((visibility . nil))" -e "(progn (require 'org) (find-file-other-window \"%FILENAME%.org\") (org-latex-export-to-latex) (save-buffers-kill-terminal))" || exit 1
echo ================================================
echo Tex Export Finished
echo ================================================
latexmk -Werror -pdf -shell-escape %FILENAME%.tex || exit 1
latexmk -c %FILENAME%.tex
popd
manual/built-in-docs.tex
-1014
View File
File diff suppressed because it is too large Load Diff
manual/manual.html
-3236
View File
File diff suppressed because it is too large Load Diff
manual/manual.org
+1
View File
@@ -956,6 +956,7 @@ embedded scripting language.
#+latex_header: \usepackage[german]{babel} #+latex_header: \usepackage[german]{babel}
#+latex_header: \usepackage{xcolor} #+latex_header: \usepackage{xcolor}
#+latex_header: \usepackage{listings} #+latex_header: \usepackage{listings}
#+latex_header: \usepackage{inconsolata}
#+latex_header: \usepackage[pageanchor=false]{hyperref} #+latex_header: \usepackage[pageanchor=false]{hyperref}
#+latex_header: \definecolor{slimeKeyword}{HTML}{B58900} #+latex_header: \definecolor{slimeKeyword}{HTML}{B58900}
src/assert.hpp
+11 -13
View File
@@ -22,23 +22,21 @@
#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, exp) \ #define create_type_missmatch_error(expected, actual, exp) \
__create_error("type-missmatch", \ __create_error("type-missmatch", \
"Type missmatch: expected %s, got %s in %s", \ "Type missmatch: expected %{l_o_t}, got %{l_o_t} in %{l_o_r}", \
expected, actual, exp) expected, actual, exp)
#ifdef _DEBUG #ifdef _DEBUG
#define assert_type(_node, _type) \ #define assert_type(_node, _type) \
do { \ do { \
if (_node->type != _type) { \ if (_node->type != _type) { \
char* t = lisp_object_to_string(_node); \ create_type_missmatch_error( \
defer_free(t); \ _type, \
create_type_missmatch_error( \ _node->type, \
lisp_object_type_to_string(_type), \ _node); \
lisp_object_type_to_string(_node->type), \ } \
t); \
} \
} while(0) } while(0)
#define assert_list_length(_node, _len) assert("List length assertion", list_length(_node) == _len) #define assert_list_length(_node, _len) assert("List length assertion", list_length(_node) == _len)
src/built_ins.cpp
+129 -84
View File
@@ -203,7 +203,11 @@ namespace Slime {
(Current_Execution.nass.end()-1)->append(NasAction::Eval); (Current_Execution.nass.end()-1)->append(NasAction::Eval);
}; };
define_macro((set! sym val), "TODO") { define_macro((set! sym val),
"If ='sym= is bound in a lexical parent environment "
"it will be bound to =val=. If no binding is found, "
"then ='sym= will be bound to =val= in the global environment."
) {
// NOTE(Felix): This COULD be a define_special in theory, // NOTE(Felix): This COULD be a define_special in theory,
// but because of call/cc, it cannot be anymore because // but because of call/cc, it cannot be anymore because
// the define_symbol would not be a part of the // the define_symbol would not be a part of the
@@ -240,8 +244,8 @@ namespace Slime {
Lisp_Object* sym = Current_Execution.cs.data[Current_Execution.cs.next_index-1]; Lisp_Object* sym = Current_Execution.cs.data[Current_Execution.cs.next_index-1];
Environment* target_env = find_binding_environment(sym, get_current_environment()); Environment* target_env = find_binding_environment(sym, get_current_environment());
if (!target_env) if (!target_env)
target_env = get_root_environment(); target_env = get_root_environment();
define_symbol(sym, val, target_env); define_symbol(sym, val, target_env);
}); });
(Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action); (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);
@@ -354,7 +358,8 @@ namespace Slime {
{ {
profile_with_name("(if)"); profile_with_name("(if)");
using Globals::Current_Execution; using Globals::Current_Execution;
/* | | | <test> | /*
| | | <test> |
| | -> | <then> | | | -> | <then> |
| <if> | | <else> | | <if> | | <else> |
| .... | | ...... | */ | .... | | ...... | */
@@ -397,51 +402,51 @@ namespace Slime {
form = form->value.pair.rest; form = form->value.pair.rest;
Lisp_Object_Type type = definee->type; Lisp_Object_Type type = definee->type;
switch (type) { switch (type) {
case Lisp_Object_Type::Symbol: { case Lisp_Object_Type::Symbol: {
if (form != Memory::nil) { if (form != Memory::nil) {
Lisp_Object* doc = thing; Lisp_Object* doc = thing;
try_void assert_type(doc, Lisp_Object_Type::String); try_void assert_type(doc, Lisp_Object_Type::String);
try_void assert_type(form, Lisp_Object_Type::Pair); try_void assert_type(form, Lisp_Object_Type::Pair);
thing = form->value.pair.first; thing = form->value.pair.first;
try_void assert("list must end here.", form->value.pair.rest == Memory::nil); try_void assert("list must end here.", form->value.pair.rest == Memory::nil);
// TODO docs (maybe with hooks) we have to attach // TODO docs (maybe with hooks) we have to attach
// the docs to the result of evaluating // the docs to the result of evaluating
} }
Current_Execution.cs.append(definee); Current_Execution.cs.append(definee);
Current_Execution.cs.append(thing); Current_Execution.cs.append(thing);
(Current_Execution.nass.end()-1)->append(NasAction::Define_Var); (Current_Execution.nass.end()-1)->append(NasAction::Define_Var);
(Current_Execution.nass.end()-1)->append(NasAction::Eval); (Current_Execution.nass.end()-1)->append(NasAction::Eval);
} break; } break;
case Lisp_Object_Type::Pair: { case Lisp_Object_Type::Pair: {
try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol); try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol);
Lisp_Object* func; Lisp_Object* func;
try_void func = Memory::create_lisp_object_function(Lisp_Function_Type::Lambda); try_void func = Memory::create_lisp_object_function(Lisp_Function_Type::Lambda);
func->value.function->parent_environment = get_current_environment(); func->value.function->parent_environment = get_current_environment();
create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func); create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func);
if (thing_cons->type == Lisp_Object_Type::Pair && if (thing_cons->type == Lisp_Object_Type::Pair &&
// if there is stuff in the function body // if there is stuff in the function body
thing_cons->value.pair.first->type == Lisp_Object_Type::String && thing_cons->value.pair.first->type == Lisp_Object_Type::String &&
// if the first is a string // if the first is a string
thing_cons->value.pair.rest != Memory::nil thing_cons->value.pair.rest != Memory::nil
// if it is not the last // if it is not the last
) { ) {
// we found docs // we found docs
Globals::docs.set_object( Globals::docs.set_object(
func, func,
Memory::duplicate_string( Memory::duplicate_string(
thing_cons->value.pair.first->value.string).data); thing_cons->value.pair.first->value.string).data);
thing_cons = thing_cons->value.pair.rest; thing_cons = thing_cons->value.pair.rest;
} }
func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons); func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons);
define_symbol(definee->value.pair.first, func); define_symbol(definee->value.pair.first, func);
Current_Execution.cs.append(definee->value.pair.first); Current_Execution.cs.append(definee->value.pair.first);
} break; } break;
default: { default: {
create_generic_error("you can only define symbols"); create_generic_error("you can only define symbols");
return; return;
} }
} }
}; };
define((helper), "") { define((helper), "") {
@@ -458,7 +463,7 @@ namespace Slime {
Globals::debug_log = false; Globals::debug_log = false;
return Memory::t; return Memory::t;
}; };
define_special((with-debug-log . rest), "") { define_special((with-debug-log . rest), "TODO") {
profile_with_name("(enable-debug-log)"); profile_with_name("(enable-debug-log)");
fetch(rest); fetch(rest);
Lisp_Object* result = Memory::nil; Lisp_Object* result = Memory::nil;
@@ -694,10 +699,8 @@ namespace Slime {
if (is_truthy(res)) if (is_truthy(res))
return Memory::t; return Memory::t;
} }
create_generic_error("Userland assertion. (%{l_o_r})", test);
char* string = lisp_object_to_string(test, true);
create_generic_error("Userland assertion. (%s)", string);
free(string);
return nullptr; return nullptr;
}; };
define_special((define-macro form . body), "TODO") { define_special((define-macro form . body), "TODO") {
@@ -748,6 +751,24 @@ namespace Slime {
*target = *source; *target = *source;
return target; return target;
}; };
define((vector . args), "TODO") {
profile_with_name("(vector)");
fetch(args);
Lisp_Object* ret;
u32 length = list_length(args);
try ret = Memory::create_lisp_object_vector(length, args);
return ret;
};
define((alloc-vector len), "TODO") {
profile_with_name("(alloc-vector )");
fetch(len);
try assert_type(len, Lisp_Object_Type::Number);
u32 i_len = (u32)len->value.number;
Lisp_Object* res;
try res = Memory::create_lisp_object_vector(i_len, Memory::nil);
return res;
};
define((vector-length v), "TODO") { define((vector-length v), "TODO") {
profile_with_name("(vector-length)"); profile_with_name("(vector-length)");
fetch(v); fetch(v);
@@ -768,6 +789,39 @@ namespace Slime {
return vec->value.vector.data+int_idx; return vec->value.vector.data+int_idx;
}; };
define((vector-range (:from 0) :to), "TODO") {
profile_with_name("(vector-range)");
fetch(from, to);
try assert_type(from, Lisp_Object_Type::Number);
try assert_type(to, Lisp_Object_Type::Number);
s64 i_from = (s64)from->value.number;
s64 i_to = (s64)to->value.number;
try assert("to should be bigger then from", i_to > i_from);
Lisp_Object* data;
try data = Memory::allocate_vector((u32)(i_to - i_from + 1));
if (i_from == 0) {
for (s64 i = 0; i <= i_to; ++i) {
data[i].type = Lisp_Object_Type::Number;
data[i].value.number = (f64)i;
}
} else {
f64 num = (f64)i_from;
for (s64 i = 0; num <= to->value.number; ++num, ++i) {
data[i].type = Lisp_Object_Type::Number;
data[i].value.number = num;
}
}
Lisp_Object* node;
try node = Memory::create_lisp_object();
node->type = Lisp_Object_Type::Vector;
node->value.vector.data = data;
node->value.vector.length = (u32)(i_to - i_from + 1);
return node;
};
define((vector-set! vec idx val), "TODO") { define((vector-set! vec idx val), "TODO") {
profile_with_name("(vector-set!)"); profile_with_name("(vector-set!)");
fetch(vec, idx, val); fetch(vec, idx, val);
@@ -998,14 +1052,6 @@ namespace Slime {
hm->value.hashMap->delete_object(key); hm->value.hashMap->delete_object(key);
return Memory::nil; return Memory::nil;
}; };
define((vector . args), "TODO") {
profile_with_name("(vector)");
fetch(args);
Lisp_Object* ret;
u32 length = list_length(args);
try ret = Memory::create_lisp_object_vector(length, args);
return ret;
};
define((cons car cdr), "TODO") { define((cons car cdr), "TODO") {
profile_with_name("(cons)"); profile_with_name("(cons)");
fetch(car, cdr); fetch(car, cdr);
@@ -1097,7 +1143,7 @@ namespace Slime {
// // the global keyword // // the global keyword
profile_with_name("(info)"); profile_with_name("(info)");
fetch(n); fetch(n);
print(n); print("%{l_o}", n);
Lisp_Object* type; Lisp_Object* type;
Lisp_Object* val; Lisp_Object* val;
@@ -1106,11 +1152,9 @@ namespace Slime {
try val = eval_expr(n); try val = eval_expr(n);
} }
printf(" is of type "); print(" is of type %{l_o}", n);
print(type); print(" (internal: %{l_o_t})",val->type);
printf(" (internal: %s)", lisp_object_type_to_string(val->type)); print("\nand is printed as: %{l_o_r}", val);
printf("\nand is printed as: ");
print(val);
printf("\n\ndocs:\n=====\n %s\n\n", printf("\n\ndocs:\n=====\n %s\n\n",
(Globals::docs.get_object(val)) (Globals::docs.get_object(val))
? Globals::docs.get_object(val) ? Globals::docs.get_object(val)
@@ -1137,17 +1181,13 @@ namespace Slime {
printf("%s", printf("%s",
Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol)); Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol));
if (args->keyword.values.data[0]) { if (args->keyword.values.data[0]) {
printf(" ("); print(" (%{l_o_r})", args->keyword.values.data[0]);
print(args->keyword.values.data[0], true);
printf(")");
} }
for (u32 i = 1; i < args->keyword.values.next_index; ++i) { for (u32 i = 1; i < args->keyword.values.next_index; ++i) {
printf(", %s", printf(", %s",
Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol)); Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol));
if (args->keyword.values.data[i]) { if (args->keyword.values.data[i]) {
printf(" ("); print(" (%{l_o_r})", args->keyword.values.data[i]);
print(args->keyword.values.data[i], true);
printf(")");
} }
} }
} }
@@ -1166,10 +1206,8 @@ namespace Slime {
fetch(n); fetch(n);
try assert_type(n, Lisp_Object_Type::Function); try assert_type(n, Lisp_Object_Type::Function);
try assert("c-functoins cannot be shown", !n->value.function->is_c); try assert("c-functoins cannot be shown", !n->value.function->is_c);
puts("body:\n"); print("body:\n%{l_o}\n", n->value.function->body.lisp_body);
print(n->value.function->body.lisp_body); print("parent_env: %{ptr}\n",
puts("\n");
printf("parent_env: %p\n",
n->value.function->parent_environment); n->value.function->parent_environment);
return Memory::nil; return Memory::nil;
@@ -1194,21 +1232,28 @@ namespace Slime {
if (things != Memory::nil) { if (things != Memory::nil) {
bool print_repr = (repr != Memory::nil); bool print_repr = (repr != Memory::nil);
print(things->value.pair.first, print_repr); if (print_repr) {
print("%{l_o_r}",things->value.pair.first, print_repr);
} else {
print("%{l_o}",things->value.pair.first, print_repr);
}
for_lisp_list(things->value.pair.rest) { for_lisp_list(things->value.pair.rest) {
print(sep); if (print_repr) {
print(it, print_repr); print("%{l_o}%{l_o_r}", sep, it);
} else {
print("%{l_o}%{l_o}", sep, it);
}
} }
} }
print(end); print("%{l_o}", end);
return Memory::nil; return Memory::nil;
}; };
define((read (:prompt ">")), "TODO") { define((read (:prompt ">")), "TODO") {
profile_with_name("(read)"); profile_with_name("(read)");
fetch(prompt); fetch(prompt);
print(prompt); print("%{l_o}", prompt);
// TODO(Felix): make read_line return a String* // TODO(Felix): make read_line return a String*
char* line = read_line(); char* line = read_line();
@@ -1227,7 +1272,7 @@ namespace Slime {
define((show-environment), "TODO") { define((show-environment), "TODO") {
profile_with_name("(show-environment)"); profile_with_name("(show-environment)");
in_caller_env { in_caller_env {
print_environment(get_current_environment()); print("%{env}", get_current_environment());
} }
return Memory::nil; return Memory::nil;
}; };
@@ -1293,9 +1338,9 @@ namespace Slime {
using Globals::error; using Globals::error;
error = new(Error); error = new(Error);
error->type = type; error->type = type;
error->message = message->value.string; error->message = duplicate_c_string(message->value.string.data);
create_generic_error("Userlanderror"); create_generic_error("Userlanderror %s", message->value.string.data);
return nullptr; return nullptr;
}; };
define((symbol->keyword sym), "TODO") { define((symbol->keyword sym), "TODO") {
@@ -1310,7 +1355,7 @@ namespace Slime {
try assert_type(sym, Lisp_Object_Type::Symbol); try assert_type(sym, Lisp_Object_Type::Symbol);
return Memory::create_lisp_object( return Memory::create_lisp_object(
Memory::duplicate_string(sym->value.symbol)); Memory::duplicate_string(sym->value.symbol));
}; };
define((string->symbol str), "TODO") { define((string->symbol str), "TODO") {
profile_with_name("(string->symbol)"); profile_with_name("(string->symbol)");
src/docgeneration.cpp
+41 -40
View File
@@ -1,5 +1,6 @@
namespace Slime { namespace Slime {
proc generate_docs(String path) -> void { proc generate_docs(String path) -> void {
print("Generating Docs...");
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) "
@@ -11,6 +12,10 @@ namespace Slime {
}; };
Array_List<Environment*> visited; Array_List<Environment*> visited;
visited.alloc();
defer {
visited.dealloc();
};
const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void { const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void {
bool we_already_printed = false; bool we_already_printed = false;
@@ -22,8 +27,7 @@ namespace Slime {
} }
} }
if (!we_already_printed) { if (!we_already_printed) {
// printf("Working on env::::"); // print("Working on env::::%{env}",env);
// print_environment(env);
// printf("\n--------------------------------\n"); // printf("\n--------------------------------\n");
visited.append(env); visited.append(env);
@@ -34,7 +38,9 @@ namespace Slime {
for_hash_map(env->hm) { for_hash_map(env->hm) {
try_void fprintf(f, try_void fprintf(f,
"#+latex: \\vspace{0.5cm}\n"
"#+latex: \\hrule\n" "#+latex: \\hrule\n"
// "#+latex: \\hspace{0.5cm}\n"
"#+html: <hr/>\n" "#+html: <hr/>\n"
"* =%s%s= \n" "* =%s%s= \n"
" :PROPERTIES:\n" " :PROPERTIES:\n"
@@ -60,10 +66,8 @@ namespace Slime {
Lisp_Object* type_expr = Memory::create_list(Memory::get_symbol("type"), value); Lisp_Object* type_expr = Memory::create_list(Memory::get_symbol("type"), value);
try_void LOtype = eval_expr(type_expr); try_void LOtype = eval_expr(type_expr);
fprintf(f, "\n - type :: ="); fprintf(f, "\n*type*\\newline\\indent\n");
print(LOtype, true, f); print_to_file(f, "=%{l_o_r}=\\newline\\noindent", LOtype);
fprintf(f, "=");
/* /*
* if printable value -> print it * if printable value -> print it
@@ -76,9 +80,7 @@ namespace Slime {
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 :: ="); print_to_file(f, "\n*value*\\newline\\indent =%{l_o_r}=\\newline\\noindent", value);
print(value, true, f);
fprintf(f, "=");
} break; } break;
default: break; default: break;
} }
@@ -88,50 +90,48 @@ namespace Slime {
if (type == Lisp_Object_Type::Function) if (type == Lisp_Object_Type::Function)
{ {
Arguments* args = &value->value.function->args; Arguments* args = &value->value.function->args;
fprintf(f, "\n - arguments :: "); fprintf(f, "\n*signature*\n");
// if no args at all
if (args->positional.symbols.next_index == 0 && fprintf(f,
args->keyword.values.next_index == 0 && "#+BEGIN:\n"
!args->rest) "#+BEGIN_SRC slime\n"
"(%s%s", prefix, Memory::get_c_str(((Lisp_Object*)key)->value.symbol));
// if some args at all
if (args->positional.symbols.next_index != 0 ||
args->keyword.values.next_index != 0 ||
args->rest)
{ {
fprintf(f, "none.");
} else {
if (args->positional.symbols.next_index != 0) { if (args->positional.symbols.next_index != 0) {
fprintf(f, "\n - postitional :: "); for (auto lo: args->positional.symbols) {
fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol)); fprintf(f, " %s", lo->value.symbol.data);
for (u32 i = 1; i < args->positional.symbols.next_index; ++i) {
fprintf(f, ", =%s=", Memory::get_c_str(args->positional.symbols.data[i]->value.symbol));
} }
} }
if (args->keyword.values.next_index != 0) { if (args->keyword.values.next_index != 0) {
fprintf(f, "\n - keyword :: "); for (u32 i = 0; i < args->keyword.values.next_index; ++i) {
fprintf(f, "=%s=", Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol)); // if has default value
if (args->keyword.values.data[0]) {
fprintf(f, " =(");
print(args->keyword.values.data[0], true, f);
fprintf(f, ")=");
}
for (u32 i = 1; i < args->keyword.values.next_index; ++i) {
fprintf(f, ", =%s=", Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol));
if (args->keyword.values.data[i]) { if (args->keyword.values.data[i]) {
fprintf(f, " =("); print_to_file(f, " (:%s %{l_o})",
print(args->keyword.values.data[i], true, f); args->keyword.keywords.data[i]->value.symbol.data,
fprintf(f, ")="); args->keyword.values.data[i]);
} else {
fprintf(f, " :%s", args->keyword.keywords.data[i]->value.symbol.data);
} }
} }
} }
if (args->rest) { if (args->rest) {
fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(args->rest->value.symbol)); fprintf(f, " . %s", Memory::get_c_str(args->rest->value.symbol));
} }
} }
fprintf(f,
")\n"
"#+END_SRC\n"
"#+END:\n");
} }
fprintf(f, "\n - docu :: "); fprintf(f, "\n\\noindent\n*docu*\n");
// TODO(Felix): make docsting a hashmap lookup char* docs = Globals::docs.get_object(value);
// if (value->docstring) fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n",
// fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n", docs ? docs : "none");
// Memory::get_c_str(value->docstring));
// else
fprintf(f, "none\n");
} }
} }
@@ -141,5 +141,6 @@ namespace Slime {
}; };
print_this_env(print_this_env, get_current_environment(), (char*)""); print_this_env(print_this_env, get_current_environment(), (char*)"");
print("Done!\n");
} }
} }
src/env.cpp
+30 -30
View File
@@ -84,44 +84,44 @@ namespace Slime {
return result; return result;
String identifier = node->value.symbol; String identifier = node->value.symbol;
print_environment(env); print("%{env}\n", env);
printf("\n");
create_symbol_undefined_error("The symbol '%s' is not defined.", identifier.data); create_symbol_undefined_error("The symbol '%s' is not defined.", identifier.data);
return nullptr; return nullptr;
} }
proc print_environment_indent(Environment* env, u32 indent) -> void { proc print_environment(FILE* file, Environment* env) -> int {
proc print_indent = [indent]() { int written;
for (u32 i = 0; i < indent; ++i) {
printf(" "); const proc print_environment_indent = [&](const auto & self, Environment* env, u32 indent) -> void {
proc print_indent = [&]() -> int{
for (u32 i = 0; i < indent; ++i) {
print_to_file(file, " ");
}
return indent;
};
if(env == get_root_environment()) {
written += print_indent();
written += print_to_file(file, "[built-ins]-Environment (0x%p)\n", env);
return;
}
for_hash_map (env->hm) {
written += print_indent();
written += print_to_file(file, "-> %{str} :: %{L_O} (%{ptr})\n",
((Lisp_Object*)key)->value.symbol.data, value, value);
}
for (u32 i = 0; i < env->parents.next_index; ++i) {
written += print_indent();
written += print_to_file(file,"parent (%{ptr}):", env->parents.data[i]);
self(self, env->parents.data[i], indent+4);
} }
}; };
// if(env == get_root_environment()) { written = print_to_file(file, "\n=== Environment === %{ptr}\n", env);
// print_indent(); print_environment_indent(print_environment_indent, env, 0);
// printf("[built-ins]-Environment (0x%p)\n", env); return written;
// return;
// }
for_hash_map (env->hm) {
print_indent();
printf("-> %s :: ", (((Lisp_Object*)key)->value.symbol.data));
print((Lisp_Object*)value);
printf(" (0x%p)", value);
puts("");
}
for (u32 i = 0; i < env->parents.next_index; ++i) {
print_indent();
printf("parent (0x%p)", env->parents.data[i]);
puts(":");
print_environment_indent(env->parents.data[i], indent+4);
}
}
proc print_environment(Environment* env) -> void {
printf("\n=== Environment === (0x%p)\n", env);
print_environment_indent(env, 0);
} }
} }
src/error.cpp
+5 -5
View File
@@ -8,7 +8,7 @@ namespace Slime {
} }
proc create_error(const char* c_func_name, const char* c_file_name, proc create_error(const char* c_func_name, const char* c_file_name,
u32 c_file_line, Lisp_Object* type, String message) -> void u32 c_file_line, Lisp_Object* type, char* message) -> void
{ {
using Globals::error; using Globals::error;
delete_error(); delete_error();
@@ -42,14 +42,14 @@ namespace Slime {
error = new(Error); error = new(Error);
error->type = type; error->type = type;
} }
// contents will be filled in
String formatted_string = Memory::create_string("", 0); char* msg;
va_list args; va_list args;
va_start(args, format); va_start(args, format);
formatted_string.length = vasprintf(&formatted_string.data, format, args); print_va_args_to_string(&msg, format, &args);
va_end(args); va_end(args);
create_error(c_func_name, c_file_name, c_file_line, type, formatted_string); create_error(c_func_name, c_file_name, c_file_line, type, msg);
} }
} }
src/eval.cpp
+218 -217
View File
@@ -1,9 +1,9 @@
namespace Slime { namespace Slime {
proc create_extended_environment_for_function_application_nrc( proc create_extended_environment_for_function_application_nrc(Lisp_Object* function,
Lisp_Object* function, u32 arg_start,
u32 arg_start, u32 arg_end) -> Environment*
u32 arg_end) -> Environment*
{ {
profile_this(); profile_this();
using Globals::Current_Execution; using Globals::Current_Execution;
@@ -20,18 +20,15 @@ namespace Slime {
}; };
u32 obligatory_keywords_count = 0; u32 obligatory_keywords_count = 0;
u32 read_obligatory_keywords_count = 0; u32 read_obligatory_keywords_count = 0;
Lisp_Object* sym; Lisp_Object* sym;
Lisp_Object* val; Lisp_Object* val;
// read positionals // read positionals
for (u32 i = 0; i < arg_spec->positional.symbols.next_index; ++i) { for (u32 i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
if (index_of_next_arg == arg_end) { if (index_of_next_arg == arg_end) {
create_parsing_error( create_parsing_error("Not enough positional args supplied. Needed: %d suppied, %d.\n"
"Not enough positional args supplied. Needed: %d suppied, %d.\n" "Next missing arg is '%s'",
"Next missing arg is '%s'", arg_spec->positional.symbols.next_index, arg_end-index_of_next_arg,
arg_spec->positional.symbols.next_index, arg_end-index_of_next_arg, arg_spec->positional.symbols.data[i]->value.symbol.data);
arg_spec->positional.symbols.data[i]->value.symbol.data);
return nullptr; return nullptr;
} }
// NOTE(Felix): We have to copy all the arguments, // NOTE(Felix): We have to copy all the arguments,
@@ -72,10 +69,10 @@ namespace Slime {
// otherwise we would have to read more but there // otherwise we would have to read more but there
// was a not accepted kwarg, so signal the error // was a not accepted kwarg, so signal the error
create_generic_error( create_generic_error(
"The function does not take the keyword argument ':%s'\n" "The function does not take the keyword argument ':%s'\n"
"and not all required keyword arguments have been read\n" "and not all required keyword arguments have been read\n"
"in to potentially count it as the rest argument.", "in to potentially count it as the rest argument.",
Current_Execution.cs.data[index_of_next_arg]->value.symbol.data); Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
return nullptr; return nullptr;
} }
// This is an accepted kwarg; check if it was already // This is an accepted kwarg; check if it was already
@@ -91,8 +88,8 @@ namespace Slime {
// If there are some kwargs left to be read // If there are some kwargs left to be read
// in, it is an error // in, it is an error
create_generic_error( create_generic_error(
"The function already read the keyword argument ':%s'", "The function already read the keyword argument ':%s'",
Current_Execution.cs.data[index_of_next_arg]->value.symbol.data); Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
return nullptr; return nullptr;
} }
} }
@@ -101,8 +98,8 @@ namespace Slime {
// set it to? // set it to?
if (index_of_next_arg+1 == arg_end) { if (index_of_next_arg+1 == 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.",
Current_Execution.cs.data[index_of_next_arg]->value.symbol.data); Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
return nullptr; return nullptr;
} }
@@ -128,7 +125,15 @@ namespace Slime {
} }
} }
kw_done:
/*c
plot_title('Sine Wave')
plot_function_samples(1000)
plot_xaxis(0,30)
plot_yaxis(-1.5,1.5)
plot(sin(t))
*/
kw_done:
// check keywords for completeness // check keywords for completeness
for (u32 i = 0; i < arg_spec->keyword.values.next_index; ++i) { for (u32 i = 0; i < arg_spec->keyword.values.next_index; ++i) {
auto defined_keyword = arg_spec->keyword.keywords.data[i]; auto defined_keyword = arg_spec->keyword.keywords.data[i];
@@ -143,9 +148,9 @@ namespace Slime {
// if this one does not have a default value // if this one does not have a default value
if (!was_set) { if (!was_set) {
create_generic_error( create_generic_error(
"There was no value supplied for the required " "There was no value supplied for the required "
"keyword argument ':%s'.", "keyword argument ':%s'.",
defined_keyword->value.symbol.data); defined_keyword->value.symbol.data);
return nullptr; return nullptr;
} }
} else { } else {
@@ -180,9 +185,8 @@ namespace Slime {
define_symbol(arg_spec->rest, list, env); define_symbol(arg_spec->rest, list, env);
} else { } else {
// rest was not declared but additional arguments were found // rest was not declared but additional arguments were found
create_generic_error( create_generic_error("A rest argument was not declared "
"A rest argument was not declared " "but the function was called with additional arguments.");
"but the function was called with additional arguments.");
return nullptr; return nullptr;
} }
} }
@@ -215,8 +219,8 @@ namespace Slime {
if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) { if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) {
create_parsing_error("Only symbols and keywords " create_parsing_error("Only symbols and keywords "
"(with or without default args) " "(with or without default args) "
"can be parsed here, but found '%s'", "can be parsed here, but found '%{l_o_t}'",
lisp_object_type_to_string(arguments->value.pair.first->type)); arguments->value.pair.first->type);
return; return;
} }
@@ -349,208 +353,205 @@ namespace Slime {
current_action = nas->data[--nas->next_index]; current_action = nas->data[--nas->next_index];
switch (current_action) { switch (current_action) {
case NasAction::Pop: { case NasAction::Pop: {
--Current_Execution.cs.next_index; --Current_Execution.cs.next_index;
} break;
case NasAction::And_Then_Action: {
Current_Execution.ats.data[--Current_Execution.ats.next_index]();
} break;
case NasAction::Pop_Environment: {
pop_environment();
} break;
case NasAction::Eval: {
pc = Current_Execution.cs.data[Current_Execution.cs.next_index-1];
Lisp_Object_Type type = pc->type;
switch (type) {
case Lisp_Object_Type::Symbol: {
Current_Execution.cs.data[Current_Execution.cs.next_index-1]
= lookup_symbol(pc, get_current_environment());
} break; } break;
case Lisp_Object_Type::Pair: { case NasAction::And_Then_Action: {
Current_Execution.cs.data[Current_Execution.cs.next_index-1] = pc->value.pair.first; Current_Execution.ats.data[--Current_Execution.ats.next_index]();
Current_Execution.ams.append(Current_Execution.cs.next_index-1);
if_debug {
if (Current_Execution.ams.next_index >= 2) {
assert("invalid ams state",
Current_Execution.ams.data[Current_Execution.ams.next_index-2] <=
Current_Execution.ams.data[Current_Execution.ams.next_index-1]);
}
}
Current_Execution.pcs.append(pc->value.pair.rest);
Current_Execution.mes.append(pc);
nas->append(NasAction::TM);
nas->append(NasAction::Eval);
} break; } break;
default: { case NasAction::Pop_Environment: {
// NOTE(Felix): others are self evaluating pop_environment();
// so do nothing
}
}
} break;
case NasAction::Macro_Write_Back: {
*(Current_Execution.mes.data[--Current_Execution.mes.next_index])
= *Current_Execution.cs[Current_Execution.cs.next_index-1];
} break;
case NasAction::TM: {
pc = Current_Execution.cs.data[Current_Execution.cs.next_index-1];
Lisp_Object_Type type = pc->type;
switch (type) {
case Lisp_Object_Type::Function: {
if(pc->value.function->is_c) {
if (pc->value.function->type.c_function_type == C_Function_Type::cMacro) {
--Current_Execution.cs.next_index; // remove the macro call from cs
--Current_Execution.ams.next_index; // remove the apply marker for the macro
try pc->value.function->body.c_macro_body();
} else if (pc->value.function->type.c_function_type == C_Function_Type::cSpecial)
{
// QUESTION(Felix): Why not call the
// function right away, and instead push
// step, so that step calls it?
push_pc_on_cs();
nas->append(NasAction::Step);
} else {
nas->append(NasAction::Step);
}
--Current_Execution.mes.next_index;
} else {
if (pc->value.function->type.lisp_function_type ==
Lisp_Function_Type::Macro)
{
push_pc_on_cs();
nas->append(NasAction::Eval);
nas->append(NasAction::Macro_Write_Back);
nas->append(NasAction::Step);
} else {
--Current_Execution.mes.next_index;
nas->append(NasAction::Step);
}
}
} break; } break;
case Lisp_Object_Type::Continuation: { case NasAction::Eval: {
--Current_Execution.mes.next_index; pc = Current_Execution.cs.data[Current_Execution.cs.next_index-1];
--Current_Execution.ams.next_index; Lisp_Object_Type type = pc->type;
Lisp_Object* param = Current_Execution.pcs.data[--Current_Execution.pcs.next_index]; switch (type) {
try assert_list_length(param, 1); case Lisp_Object_Type::Symbol: {
param = param->value.pair.first; Current_Execution.cs.data[Current_Execution.cs.next_index-1]
// NOTE(Felix): we could first get value and eval = lookup_symbol(pc, get_current_environment());
// it and restore the cont on an and_then_action } break;
// OR we could restore the cont now and push the case Lisp_Object_Type::Pair: {
// new unevaluated val on the stack and leave a Current_Execution.cs.data[Current_Execution.cs.next_index-1] = pc->value.pair.first;
// NAS_Actoin::Eval behind. So that's what we Current_Execution.ams.append(Current_Execution.cs.next_index-1);
// gonna do.
Globals::Current_Execution.cs.clear(); if_debug {
Globals::Current_Execution.ams.clear(); if (Current_Execution.ams.next_index >= 2) {
Globals::Current_Execution.pcs.clear(); assert("invalid ams state",
Globals::Current_Execution.nass.clear(); Current_Execution.ams.data[Current_Execution.ams.next_index-2] <=
Globals::Current_Execution.envi_stack.clear(); Current_Execution.ams.data[Current_Execution.ams.next_index-1]);
Globals::Current_Execution.ats.clear(); }
Globals::Current_Execution.mes.clear();
// TODO(Felix): This seems super inefficient
for (auto it: pc->value.continuation->cs) {
Globals::Current_Execution.cs.append(it);
}
for (auto it: pc->value.continuation->ams) {
Globals::Current_Execution.ams.append(it);
}
for (auto it: pc->value.continuation->pcs) {
Globals::Current_Execution.pcs.append(it);
}
for (auto it: pc->value.continuation->envi_stack) {
Globals::Current_Execution.envi_stack.append(it);
}
for (auto it: pc->value.continuation->ats) {
Globals::Current_Execution.ats.append(it);
}
for (auto it: pc->value.continuation->mes) {
Globals::Current_Execution.mes.append(it);
}
{
Globals::Current_Execution.nass.reserve(pc->value.continuation->nass.next_index);
Globals::Current_Execution.nass.next_index = pc->value.continuation->nass.next_index;
for (u32 i = 0; i < pc->value.continuation->nass.next_index; ++i) {
Globals::Current_Execution.nass.data[i].alloc();
for (Globals::Current_Execution.nass.data[i].next_index = 0;
Globals::Current_Execution.nass.data[i].next_index < pc->value.continuation->nass.data[i].next_index;)
{
Globals::Current_Execution.nass.data[i].append(
pc->value.continuation->nass.data[i].data[Globals::Current_Execution.nass.data[i].next_index]);
} }
Current_Execution.pcs.append(pc->value.pair.rest);
Current_Execution.mes.append(pc);
nas->append(NasAction::TM);
nas->append(NasAction::Eval);
} break;
default: {
// NOTE(Felix): others are self evaluating
// so do nothing
}
}
} break;
case NasAction::Macro_Write_Back: {
*(Current_Execution.mes.data[--Current_Execution.mes.next_index])
= *Current_Execution.cs[Current_Execution.cs.next_index-1];
} break;
case NasAction::TM: {
pc = Current_Execution.cs.data[Current_Execution.cs.next_index-1];
Lisp_Object_Type type = pc->type;
switch (type) {
case Lisp_Object_Type::Function: {
if(pc->value.function->is_c) {
if (pc->value.function->type.c_function_type == C_Function_Type::cMacro) {
--Current_Execution.cs.next_index; // remove the macro call from cs
--Current_Execution.ams.next_index; // remove the apply marker for the macro
try pc->value.function->body.c_macro_body();
} else if (pc->value.function->type.c_function_type == C_Function_Type::cSpecial)
{
// QUESTION(Felix): Why not call the
// function right away, and instead push
// step, so that step calls it?
push_pc_on_cs();
nas->append(NasAction::Step);
} else {
nas->append(NasAction::Step);
}
--Current_Execution.mes.next_index;
} else {
if (pc->value.function->type.lisp_function_type ==
Lisp_Function_Type::Macro)
{
push_pc_on_cs();
nas->append(NasAction::Eval);
nas->append(NasAction::Macro_Write_Back);
nas->append(NasAction::Step);
} else {
--Current_Execution.mes.next_index;
nas->append(NasAction::Step);
}
}
} break;
case Lisp_Object_Type::Continuation: {
--Current_Execution.mes.next_index;
--Current_Execution.ams.next_index;
Lisp_Object* param = Current_Execution.pcs.data[--Current_Execution.pcs.next_index];
try assert_list_length(param, 1);
param = param->value.pair.first;
// NOTE(Felix): we could first get value and eval
// it and restore the cont on an and_then_action
// OR we could restore the cont now and push the
// new unevaluated val on the stack and leave a
// NAS_Actoin::Eval behind. So that's what we
// gonna do.
Globals::Current_Execution.cs.clear();
Globals::Current_Execution.ams.clear();
Globals::Current_Execution.pcs.clear();
Globals::Current_Execution.nass.clear();
Globals::Current_Execution.envi_stack.clear();
Globals::Current_Execution.ats.clear();
Globals::Current_Execution.mes.clear();
// TODO(Felix): This seems super inefficient
for (auto it: pc->value.continuation->cs) {
Globals::Current_Execution.cs.append(it);
}
for (auto it: pc->value.continuation->ams) {
Globals::Current_Execution.ams.append(it);
}
for (auto it: pc->value.continuation->pcs) {
Globals::Current_Execution.pcs.append(it);
}
for (auto it: pc->value.continuation->envi_stack) {
Globals::Current_Execution.envi_stack.append(it);
}
for (auto it: pc->value.continuation->ats) {
Globals::Current_Execution.ats.append(it);
}
for (auto it: pc->value.continuation->mes) {
Globals::Current_Execution.mes.append(it);
}
{
Globals::Current_Execution.nass.reserve(pc->value.continuation->nass.next_index);
Globals::Current_Execution.nass.next_index = pc->value.continuation->nass.next_index;
for (u32 i = 0; i < pc->value.continuation->nass.next_index; ++i) {
Globals::Current_Execution.nass.data[i].alloc();
for (Globals::Current_Execution.nass.data[i].next_index = 0;
Globals::Current_Execution.nass.data[i].next_index < pc->value.continuation->nass.data[i].next_index;)
{
Globals::Current_Execution.nass.data[i].append(
pc->value.continuation->nass.data[i].data[Globals::Current_Execution.nass.data[i].next_index]);
}
}
}
Globals::Current_Execution.cs.append(param);
(Current_Execution.nass.end()-1)->append(NasAction::Eval);
// debug_break();
} break;
default: {
create_generic_error("The first element of the pair was not a function but: %{l_o_t} in %{l_o}",
type, pc);
return nullptr;
} }
} }
Globals::Current_Execution.cs.append(param);
(Current_Execution.nass.end()-1)->append(NasAction::Eval);
// debug_break();
} break; } break;
default: { case NasAction::Step: {
char* t = lisp_object_to_string(pc); if (Current_Execution.pcs.data[Current_Execution.pcs.next_index-1] == Memory::nil) {
defer_free(t); --Current_Execution.pcs.next_index;
u32 am = Current_Execution.ams.data[--Current_Execution.ams.next_index];
Lisp_Object* function = Current_Execution.cs.data[am];
try assert_type(function, Lisp_Object_Type::Function);
create_generic_error("The first element of the pair was not a function but: %s in %s", Environment* extended_env;
lisp_object_type_to_string(type), t); try extended_env = create_extended_environment_for_function_application_nrc(
return nullptr; function, am+1, Current_Execution.cs.next_index);
} Current_Execution.cs.next_index = am;
} push_environment(extended_env);
if (function->value.function->is_c) {
} break; if (function->value.function->type.c_function_type == C_Function_Type::cMacro)
case NasAction::Step: { try function->value.function->body.c_macro_body();
if (Current_Execution.pcs.data[Current_Execution.pcs.next_index-1] == Memory::nil) { else
--Current_Execution.pcs.next_index; try Current_Execution.cs.append(function->value.function->body.c_body());
u32 am = Current_Execution.ams.data[--Current_Execution.ams.next_index]; pop_environment();
Lisp_Object* function = Current_Execution.cs.data[am]; } else {
try assert_type(function, Lisp_Object_Type::Function); nas->append(NasAction::Pop_Environment);
nas->append(NasAction::Eval);
Environment* extended_env; Current_Execution.cs.append(function->value.function->body.lisp_body);
try extended_env = create_extended_environment_for_function_application_nrc( }
function, am+1, Current_Execution.cs.next_index);
Current_Execution.cs.next_index = am;
push_environment(extended_env);
if (function->value.function->is_c) {
if (function->value.function->type.c_function_type == C_Function_Type::cMacro)
try function->value.function->body.c_macro_body();
else
try Current_Execution.cs.append(function->value.function->body.c_body());
pop_environment();
} else { } else {
nas->append(NasAction::Pop_Environment); Current_Execution.cs.append(Current_Execution.pcs.data[Current_Execution.pcs.next_index-1]->value.pair.first);
Current_Execution.pcs.data[Current_Execution.pcs.next_index-1] = Current_Execution.pcs.data[Current_Execution.pcs.next_index-1]->value.pair.rest;
nas->append(NasAction::Step);
nas->append(NasAction::Eval); nas->append(NasAction::Eval);
Current_Execution.cs.append(function->value.function->body.lisp_body);
} }
} else { } break;
Current_Execution.cs.append(Current_Execution.pcs.data[Current_Execution.pcs.next_index-1]->value.pair.first); case NasAction::If: {
Current_Execution.pcs.data[Current_Execution.pcs.next_index-1] = Current_Execution.pcs.data[Current_Execution.pcs.next_index-1]->value.pair.rest; /* | <cond> |
nas->append(NasAction::Step); | <then> |
nas->append(NasAction::Eval); | <else> |
| .... | */
Current_Execution.cs.next_index -= 2;
// NOTE(Felix): for false it is sufficent to pop 2 for
// true we have to copy the then part to the new top
// of the stack
if (Current_Execution.cs.data[Current_Execution.cs.next_index+1] != Memory::nil) {
Current_Execution.cs.data[Current_Execution.cs.next_index-1] = Current_Execution.cs.data[Current_Execution.cs.next_index];
}
} break;
case NasAction::Define_Var: {
/* | <thing> |
| <symbol> |
| .... | */
Current_Execution.cs.next_index -= 1;
try assert_type(Current_Execution.cs.data[Current_Execution.cs.next_index-1], Lisp_Object_Type::Symbol);
try define_symbol(Current_Execution.cs.data[Current_Execution.cs.next_index-1], Current_Execution.cs.data[Current_Execution.cs.next_index]);
Current_Execution.cs.data[Current_Execution.cs.next_index-1] = Memory::t;
} }
} break;
case NasAction::If: {
/* | <cond> |
| <then> |
| <else> |
| .... | */
Current_Execution.cs.next_index -= 2;
// NOTE(Felix): for false it is sufficent to pop 2 for
// true we have to copy the then part to the new top
// of the stack
if (Current_Execution.cs.data[Current_Execution.cs.next_index+1] != Memory::nil) {
Current_Execution.cs.data[Current_Execution.cs.next_index-1] = Current_Execution.cs.data[Current_Execution.cs.next_index];
}
} break;
case NasAction::Define_Var: {
/* | <thing> |
| <symbol> |
| .... | */
Current_Execution.cs.next_index -= 1;
try assert_type(Current_Execution.cs.data[Current_Execution.cs.next_index-1], Lisp_Object_Type::Symbol);
try define_symbol(Current_Execution.cs.data[Current_Execution.cs.next_index-1], Current_Execution.cs.data[Current_Execution.cs.next_index]);
Current_Execution.cs.data[Current_Execution.cs.next_index-1] = Memory::t;
}
} }
} }
@@ -612,7 +613,7 @@ namespace Slime {
continue; continue;
} }
if (evaluated && evaluated != Memory::nil) { if (evaluated && evaluated != Memory::nil) {
print(evaluated); print("%{l_o}", evaluated);
} }
fputs("\n", stdout); fputs("\n", stdout);
} }
src/forward_decls.cpp
+9 -5
View File
@@ -17,9 +17,15 @@ 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);
void define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env); void define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env);
char* lisp_object_to_string(Lisp_Object* node, bool print_repr = true); // 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*); // void print_lisp_object(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
int print_lisp_object(FILE*, Lisp_Object*);
int print_lisp_object_repr(FILE*, Lisp_Object*);
int print_lisp_object_type(FILE*, Lisp_Object_Type);
int print_environment(FILE*, Environment*);
inline char* duplicate_c_string(const char* str);
char* char_to_wchar(const wchar_t* c); char* char_to_wchar(const wchar_t* c);
wchar_t* char_to_wchar(const char* c); wchar_t* char_to_wchar(const char* c);
@@ -35,8 +41,6 @@ namespace Slime {
inline void push_environment(Environment*); inline void push_environment(Environment*);
inline void pop_environment(); inline void pop_environment();
const char* lisp_object_type_to_string(Lisp_Object_Type type);
void visualize_lisp_machine(); void visualize_lisp_machine();
void generate_docs(String path); void generate_docs(String path);
void log_error(); void log_error();
src/io.cpp
+94 -105
View File
@@ -337,84 +337,59 @@ namespace Slime {
return res; return res;
} }
proc lisp_object_to_string(Lisp_Object* node, bool print_repr) -> char* { proc print_lisp_object_optional(FILE* f, Lisp_Object* node, bool print_repr) -> int {
char* temp; int written = 0;
Array_List<char*> string_builder;
string_builder.alloc();
defer {
string_builder.dealloc();
};
if (!node) return duplicate_c_string("<nullptr>"); if (!node)
return print_to_file(f, "<nullptr>");
switch (node->type) { switch (node->type) {
case (Lisp_Object_Type::Nil): return duplicate_c_string("()"); case (Lisp_Object_Type::Nil): return print_to_file(f, "()");
case (Lisp_Object_Type::T): return duplicate_c_string("t"); case (Lisp_Object_Type::T): return print_to_file(f, "t");
case (Lisp_Object_Type::Continuation): return duplicate_c_string("[continuation]"); case (Lisp_Object_Type::Continuation): return print_to_file(f, "[continuation]");
case (Lisp_Object_Type::Pointer): return duplicate_c_string("[pointer]"); case (Lisp_Object_Type::Pointer): return print_to_file(f, "[pointer]");
case (Lisp_Object_Type::Keyword): return print_to_file(f, ":%s", Memory::get_c_str(node->value.symbol));
case (Lisp_Object_Type::Symbol): return print_to_file(f, ":%s", Memory::get_c_str(node->value.symbol));
case (Lisp_Object_Type::Number): { case (Lisp_Object_Type::Number): {
if (abs(node->value.number - (s32)node->value.number) < 0.000001f) if (abs(node->value.number - (s32)node->value.number) < 0.000001f)
asprintf(&temp, "%d", (s32)node->value.number); return print_to_file(f, "%d", (s32)node->value.number);
else else
asprintf(&temp, "%f", node->value.number); return print_to_file(f, "%f", node->value.number);
return temp;
}
case (Lisp_Object_Type::Keyword): {
asprintf(&temp, ":%s", Memory::get_c_str(node->value.symbol));
return temp;
}
case (Lisp_Object_Type::Symbol): {
asprintf(&temp, "%s", Memory::get_c_str(node->value.symbol));
return temp;
} }
case (Lisp_Object_Type::HashMap): { case (Lisp_Object_Type::HashMap): {
for_hash_map (*(node->value.hashMap)) { for_hash_map (*(node->value.hashMap)) {
char* k = lisp_object_to_string(key, true); written += fprintf(f, " ");
char* v = lisp_object_to_string((Lisp_Object*)value, true); written += print_lisp_object_optional(f, key, true);
asprintf(&temp, " %s -> %s\n", k, v); written += fprintf(f, " -> ");
string_builder.append(temp); written += print_lisp_object_optional(f, (Lisp_Object*)value, true);
free(v); written += fprintf(f, "\n");
free(k);
} }
return written;
temp = string_buider_to_string(string_builder);
// free all asprintfs
for (auto str : string_builder) {
free(str);
}
return temp;
} }
case (Lisp_Object_Type::String): { case (Lisp_Object_Type::String): {
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));
asprintf(&temp, "\"%s\"", escaped); written = fprintf(f, "\"%s\"", escaped);
free(escaped); free(escaped);
return temp; return written;
} else } else
return duplicate_c_string(Memory::get_c_str(node->value.string)); return print_to_file(f, "%s", Memory::get_c_str(node->value.string));
} break; } break;
case (Lisp_Object_Type::Vector): { case (Lisp_Object_Type::Vector): {
written += print_to_file(f, "[");
string_builder.append(duplicate_c_string("["));
if (node->value.vector.length > 0) if (node->value.vector.length > 0)
string_builder.append(lisp_object_to_string(node->value.vector.data, print_repr)); written += print_lisp_object_optional(f, node->value.vector.data, print_repr);
for (u32 i = 1; i < node->value.vector.length; ++i) { for (u32 i = 1; i < node->value.vector.length; ++i) {
string_builder.append(duplicate_c_string(" ")); written += print_to_file(f, " ");
string_builder.append(lisp_object_to_string(node->value.vector.data+i, print_repr)); written += print_lisp_object_optional(f, node->value.vector.data+i, print_repr);
} }
string_builder.append(duplicate_c_string("]")); written += print_to_file(f, "]");
temp = string_buider_to_string(string_builder); return written;
for (auto str : string_builder) {
free(str);
}
return temp;
} break; } break;
case (Lisp_Object_Type::Function): { case (Lisp_Object_Type::Function): {
if (Globals::user_types.key_exists(node)) { if (Globals::user_types.key_exists(node)) {
asprintf(&temp, "[%s]", return print_to_file(f, "[%s]", ((Lisp_Object*)Globals::user_types.key_exists(node)) ->value.symbol.data);
((Lisp_Object*)Globals::user_types.key_exists(node))
->value.symbol.data);
return temp;
} }
if (node->value.function->is_c) { if (node->value.function->is_c) {
@@ -423,36 +398,35 @@ namespace Slime {
Lisp_Object* name = (Lisp_Object*)(get_root_environment()->hm.search_key_to_object(node)); Lisp_Object* name = (Lisp_Object*)(get_root_environment()->hm.search_key_to_object(node));
if (name) { if (name) {
switch (node->value.function->type.c_function_type) { switch (node->value.function->type.c_function_type) {
case C_Function_Type::cFunction: asprintf(&temp, "[c-function %s]",name->value.symbol.data); break; case C_Function_Type::cFunction: return print_to_file(f, "[c-function %s]",name->value.symbol.data);
case C_Function_Type::cSpecial: asprintf(&temp, "[c-special %s]", name->value.symbol.data); break; case C_Function_Type::cSpecial: return print_to_file(f, "[c-special %s]", name->value.symbol.data);
case C_Function_Type::cMacro: asprintf(&temp, "[c-macro %s]", name->value.symbol.data); break; case C_Function_Type::cMacro: return print_to_file(f, "[c-macro %s]", name->value.symbol.data);
default: return duplicate_c_string("[c-??]"); default: return print_to_file(f, "[c-??]");
} }
} else { } else {
switch (node->value.function->type.c_function_type) { switch (node->value.function->type.c_function_type) {
case C_Function_Type::cFunction: asprintf(&temp, "[c-function]"); break; case C_Function_Type::cFunction: return print_to_file(f, "[c-function]");
case C_Function_Type::cSpecial: asprintf(&temp, "[c-special]"); break; case C_Function_Type::cSpecial: return print_to_file(f, "[c-special]");
case C_Function_Type::cMacro: asprintf(&temp, "[c-macro]"); break; case C_Function_Type::cMacro: return print_to_file(f, "[c-macro]");
default: return duplicate_c_string("[c-??]"); default: return print_to_file(f, "[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 duplicate_c_string("[lambda]"); case Lisp_Function_Type::Lambda: return print_to_file(f, "[lambda]");
case Lisp_Function_Type::Macro: return duplicate_c_string("[macro]"); case Lisp_Function_Type::Macro: return print_to_file(f, "[macro]");
default: return duplicate_c_string("[??]"); default: return print_to_file(f, "[??]");
} }
} }
} break; } break;
case (Lisp_Object_Type::Pair): { case (Lisp_Object_Type::Pair): {
Lisp_Object* head = node; Lisp_Object* head = node;
defer { // defer {
for (auto str : string_builder) { // for (auto str : string_builder) {
free(str); // free(str);
} // }
}; // };
// first check if it is a quotation form, in that case we want // first check if it is a quotation form, in that case we want
// to print it prettier // to print it prettier
if (head->value.pair.first->type == Lisp_Object_Type::Symbol) { if (head->value.pair.first->type == Lisp_Object_Type::Symbol) {
@@ -464,73 +438,91 @@ namespace Slime {
auto unquote_sym = Memory::get_symbol("unquote"); auto unquote_sym = Memory::get_symbol("unquote");
auto quasiquote_sym = Memory::get_symbol("quasiquote"); auto quasiquote_sym = Memory::get_symbol("quasiquote");
auto unquote_splicing_sym = Memory::get_symbol("unquote-splicing"); auto unquote_splicing_sym = Memory::get_symbol("unquote-splicing");
// TODO(Felix): Maybe combine if and else? They look kinda the same
if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym) if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym)
{ {
if (symbol == quote_sym) if (symbol == quote_sym)
string_builder.append(duplicate_c_string("\'")); written += print_to_file(f, "\'");
else if (symbol == unquote_sym) else if (symbol == unquote_sym)
string_builder.append(duplicate_c_string(",")); written += print_to_file(f, ",");
else if (symbol == unquote_splicing_sym) else if (symbol == unquote_splicing_sym)
string_builder.append(duplicate_c_string(",@")); written += print_to_file(f, ",@");
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
assert("The list must end here.", assert("The list must end here.",
head->value.pair.rest->value.pair.rest == Memory::nil); 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)); written += print_lisp_object_optional(f, head->value.pair.rest->value.pair.first, print_repr);
return string_buider_to_string(string_builder); return written;
} else if (symbol == quasiquote_sym) { } else if (symbol == quasiquote_sym) {
string_builder.append(duplicate_c_string("`")); written += print_to_file(f, "`");
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
string_builder.append(lisp_object_to_string(head->value.pair.rest->value.pair.first, print_repr));
return string_buider_to_string(string_builder);
written += print_lisp_object_optional(f, head->value.pair.rest->value.pair.first, print_repr);
return written;
} }
} }
string_builder.append(duplicate_c_string("(")); written += print_to_file(f, "(");
// NOTE(Felix): We could do a while true here, however in case // NOTE(Felix): We could do a while true here, however in case
// we want to print a broken list (for logging the error) we // we want to print a broken list (for logging the error) we
// should do more checks. // should do more checks.
while (head) { while (head) {
string_builder.append(lisp_object_to_string(head->value.pair.first, print_repr)); written += print_lisp_object_optional(f, head->value.pair.first, print_repr);
head = head->value.pair.rest; head = head->value.pair.rest;
if (!head) break; if (!head) break;
if (head->type != Lisp_Object_Type::Pair) break; if (head->type != Lisp_Object_Type::Pair) break;
string_builder.append(duplicate_c_string(" ")); written += print_to_file(f, " ");
} }
if (head && head != Memory::nil) { if (head && head != Memory::nil) {
string_builder.append(duplicate_c_string(" . ")); written += print_to_file(f, " . ");
string_builder.append(lisp_object_to_string(head, print_repr)); written += print_lisp_object_optional(f, head, print_repr);
} }
string_builder.append(duplicate_c_string(")")); written += print_to_file(f, ")");
return string_buider_to_string(string_builder); return written;
} }
default: default:
create_generic_error("A Lisp_Object of type-id %d cannot be converted to a string", create_generic_error("A Lisp_Object of type-id %d cannot be converted to a string",
(u8)(node->type)); (u8)(node->type));
return nullptr; return 0;
} }
} }
proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void { proc print_lisp_object(FILE* file, Lisp_Object* node) -> int {
char* string = nullptr; return print_lisp_object_optional(file, node, false);
defer {
free(string);
};
string = lisp_object_to_string(node, print_repr);
fputs(string, file);
} }
proc print_lisp_object_repr(FILE* file, Lisp_Object* node) -> int {
return print_lisp_object_optional(file, node, true);
}
proc print_lisp_object_type(FILE* file, Lisp_Object_Type type) -> int {
switch (type) {
case(Lisp_Object_Type::Nil): return print_to_file(file, "nil");
case(Lisp_Object_Type::T): return print_to_file(file, "t");
case(Lisp_Object_Type::Number): return print_to_file(file, "number");
case(Lisp_Object_Type::String): return print_to_file(file, "string");
case(Lisp_Object_Type::Symbol): return print_to_file(file, "symbol");
case(Lisp_Object_Type::Keyword): return print_to_file(file, "keyword");
case(Lisp_Object_Type::Function): return print_to_file(file, "function");
case(Lisp_Object_Type::Continuation): return print_to_file(file, "continuation");
case(Lisp_Object_Type::Pair): return print_to_file(file, "pair");
case(Lisp_Object_Type::Vector): return print_to_file(file, "vector");
case(Lisp_Object_Type::Pointer): return print_to_file(file, "pointer");
case(Lisp_Object_Type::HashMap): return print_to_file(file, "hashmap");
case(Lisp_Object_Type::Invalid_Garbage_Collected): return print_to_file(file, "Invalid: Garbage Collected");
case(Lisp_Object_Type::Invalid_Under_Construction): return print_to_file(file, "Invalid: Under Construction");
}
return print_to_file(file, "unknown");
}
proc print_single_call(Lisp_Object* obj) -> void { proc print_single_call(Lisp_Object* obj) -> void {
printf(console_cyan); print("%{cyan}%{l_o_r}%{normal}\n at ", obj);
print(obj, true);
printf(console_normal);
printf("\n at ");
// TODO(Felix): Enable again when we have a source code // TODO(Felix): Enable again when we have a source code
// location again // location again
@@ -550,14 +542,11 @@ namespace Slime {
printf("cs:\n "); printf("cs:\n ");
for (u32 i = 0; i < Current_Execution.cs.next_index; ++i) { for (u32 i = 0; i < Current_Execution.cs.next_index; ++i) {
char* t = lisp_object_to_string(Current_Execution.cs.data[i], true); print(" %d: %{l_o_r}\n ", i, Current_Execution.cs.data[i]);
defer_free(t);
printf(" %d: %s\n ", i, t);
} }
printf("\npcs:\n "); printf("\npcs:\n ");
for (auto lo : Current_Execution.pcs) { for (auto lo : Current_Execution.pcs) {
print(lo, true); print("%{l_o_r}\n",lo);
printf("\n ");
} }
printf("\nnnas:\n "); printf("\nnnas:\n ");
for (auto nas: Current_Execution.nass) { for (auto nas: Current_Execution.nass) {
@@ -589,7 +578,7 @@ namespace Slime {
proc log_error() -> void { proc log_error() -> void {
fputs("\n", stdout); fputs("\n", stdout);
fputs(console_red, stdout); fputs(console_red, stdout);
fputs(Memory::get_c_str(Globals::error->message), stdout); fputs(Globals::error->message, stdout);
puts(console_normal); puts(console_normal);
fputs(" in: ", stdout); fputs(" in: ", stdout);
src/libslime.cpp
+1 -22
View File
@@ -38,6 +38,7 @@ u32 hm_hash(Slime::Lisp_Object* obj);
#include "ftb/macros.hpp" #include "ftb/macros.hpp"
#include "ftb/profiler.hpp" #include "ftb/profiler.hpp"
#include "ftb/hooks.hpp" #include "ftb/hooks.hpp"
#include "ftb/print.hpp"
# include "defines.cpp" # include "defines.cpp"
# include "assert.hpp" # include "assert.hpp"
@@ -46,32 +47,10 @@ u32 hm_hash(Slime::Lisp_Object* obj);
# include "structs.cpp" # include "structs.cpp"
# include "forward_decls.cpp" # include "forward_decls.cpp"
inline bool hm_objects_match(char* a, char* b) {
return strcmp(a, b) == 0;
}
inline bool hm_objects_match(void* a, void* b) {
return a == b;
}
inline bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b) { inline bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b) {
return Slime::lisp_object_equal(a, b); return Slime::lisp_object_equal(a, b);
} }
u32 hm_hash(char* str) {
u32 value = str[0] << 7;
s32 i = 0;
while (str[i]) {
value = (10000003 * value) ^ str[i++];
}
return value ^ i;
}
u32 hm_hash(void* ptr) {
return ((u64)ptr * 2654435761) % 4294967296;
}
u32 hm_hash(Slime::Lisp_Object* obj) { u32 hm_hash(Slime::Lisp_Object* obj) {
using namespace Slime; using namespace Slime;
switch (obj->type) { switch (obj->type) {
src/lisp_object.cpp
-20
View File
@@ -10,24 +10,4 @@ namespace Slime {
return ret; return ret;
} }
proc lisp_object_type_to_string(Lisp_Object_Type type) -> const char* {
switch (type) {
case(Lisp_Object_Type::Nil): return "nil";
case(Lisp_Object_Type::T): return "t";
case(Lisp_Object_Type::Number): return "number";
case(Lisp_Object_Type::String): return "string";
case(Lisp_Object_Type::Symbol): return "symbol";
case(Lisp_Object_Type::Keyword): return "keyword";
case(Lisp_Object_Type::Function): return "function";
case(Lisp_Object_Type::Continuation): return "continuation";
case(Lisp_Object_Type::Pair): return "pair";
case(Lisp_Object_Type::Vector): return "vector";
case(Lisp_Object_Type::Pointer): return "pointer";
case(Lisp_Object_Type::HashMap): return "hashmap";
case(Lisp_Object_Type::Invalid_Garbage_Collected): return "Invalid: Garbage Collected";
case(Lisp_Object_Type::Invalid_Under_Construction): return "Invalid: Under Construction";
}
return "unknown";
}
} }
src/memory.cpp
+16 -6
View File
@@ -190,6 +190,12 @@ namespace Slime::Memory {
proc init() -> void { proc init() -> void {
profile_this(); profile_this();
init_printer();
register_printer("env", print_environment, Printer_Function_Type::_ptr);
register_printer("l_o", print_lisp_object, Printer_Function_Type::_ptr);
register_printer("l_o_r", print_lisp_object_repr, Printer_Function_Type::_ptr);
register_printer("l_o_t", print_lisp_object_type, Printer_Function_Type::_32b);
object_memory.alloc(1024, 8); object_memory.alloc(1024, 8);
environment_memory.alloc(1024, 8); environment_memory.alloc(1024, 8);
hashmap_memory.alloc(256, 8); hashmap_memory.alloc(256, 8);
@@ -297,16 +303,19 @@ namespace Slime::Memory {
proc allocate_vector(u32 size) -> Lisp_Object* { proc allocate_vector(u32 size) -> Lisp_Object* {
Lisp_Object* ret = object_memory.allocate(size); // Lisp_Object* ret = object_memory.allocate(size);
if (!ret) { // if (!ret) {
create_out_of_memory_error("The vector is too big to fit in a memory bucket."); // create_out_of_memory_error("The vector is too big to fit in a memory bucket.");
return nullptr; // return nullptr;
} // }
Lisp_Object* ret = (Lisp_Object*)malloc(size * sizeof(Lisp_Object));
return ret; return ret;
} }
proc create_lisp_object_vector(u32 length, Lisp_Object* element_list) -> Lisp_Object* { proc create_lisp_object_vector(u32 length, Lisp_Object* element_list) -> Lisp_Object* {
try assert_type(element_list, Lisp_Object_Type::Pair); try assert("element_list must be either a pair or nil",
(element_list->type == Lisp_Object_Type::Pair) ||
(element_list == Memory::nil));
Lisp_Object* node; Lisp_Object* node;
try node = create_lisp_object(); try node = create_lisp_object();
@@ -319,6 +328,7 @@ namespace Slime::Memory {
u32 i = 0; u32 i = 0;
while (head != Memory::nil) { while (head != Memory::nil) {
// BUG(Felix): We copy symbols here...
node->value.vector.data[i] = *head->value.pair.first; node->value.vector.data[i] = *head->value.pair.first;
head = head->value.pair.rest; head = head->value.pair.rest;
++i; ++i;
src/structs.cpp
+1 -1
View File
@@ -150,6 +150,6 @@ namespace Slime {
Lisp_Object* position; Lisp_Object* position;
// type has to be a keyword // type has to be a keyword
Lisp_Object* type; Lisp_Object* type;
String message; char* message;
}; };
} }
src/testing.cpp
+13 -14
View File
@@ -6,15 +6,15 @@ namespace Slime {
#define fail 0 #define fail 0
#define print_assert_equal_fail(variable, value, type, format) \ #define print_assert_equal_fail(variable, value, type, format) \
printf("\n%s:%d: Assertion failed\n\tfor '" #variable "'" \ print("\n%s:%d: Assertion failed\n\tfor '" #variable "'" \
"\n\texpected: " format \ "\n\texpected: " format \
"\n\tgot: " format "\n", \ "\n\tgot: " format "\n", \
__FILE__, __LINE__, (type)value, (type)variable) __FILE__, __LINE__, (type)value, (type)variable)
#define print_assert_not_equal_fail(variable, value, type, format) \ #define print_assert_not_equal_fail(variable, value, type, format) \
printf("\n%s:%d: Assertion failed\n\tfor '" #variable "'" \ print("\n%s:%d: Assertion failed\n\tfor '" #variable "'" \
"\n\texpected not: " format \ "\n\texpected not: " format \
"\n\tgot anyways: " format "\n", \ "\n\tgot anyways: " format "\n", \
__FILE__, __LINE__, (type)value, (type)variable) __FILE__, __LINE__, (type)value, (type)variable)
#define assert_equal_int(variable, value) \ #define assert_equal_int(variable, value) \
@@ -59,17 +59,16 @@ namespace Slime {
#define assert_equal_string(variable, value) \ #define assert_equal_string(variable, value) \
if (!string_equal(variable, value)) { \ if (!string_equal(variable, value)) { \
print_assert_equal_fail(variable.data, value, char*, "%s"); \ print_assert_equal_fail(variable.data, value, char*, "%s"); \
return fail; \ return fail; \
} }
#define assert_equal_type(node, _type) \ #define assert_equal_type(node, _type) \
if (node->type != _type) { \ if (node->type != _type) { \
print_assert_equal_fail( \ print_assert_equal_fail(node->type, _type, Lisp_Object_Type, \
lisp_object_type_to_string(node->type), \ "%{l_o_t}"); \
lisp_object_type_to_string(_type), char*, "%s"); \ return fail; \
return fail; \ } \
} \
#define assert_null(variable) \ #define assert_null(variable) \
assert_equal_int(variable, nullptr) assert_equal_int(variable, nullptr)