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
+4 -6
View File
@@ -24,7 +24,7 @@
#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
@@ -32,12 +32,10 @@
#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); \
defer_free(t); \
create_type_missmatch_error( \ create_type_missmatch_error( \
lisp_object_type_to_string(_type), \ _type, \
lisp_object_type_to_string(_node->type), \ _node->type, \
t); \ _node); \
} \ } \
} while(0) } while(0)
src/built_ins.cpp
+83 -38
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
@@ -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> |
| .... | | ...... | */ | .... | | ...... | */
@@ -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") {
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
+29 -29
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;
const proc print_environment_indent = [&](const auto & self, Environment* env, u32 indent) -> void {
proc print_indent = [&]() -> int{
for (u32 i = 0; i < indent; ++i) { for (u32 i = 0; i < indent; ++i) {
printf(" "); 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
+17 -16
View File
@@ -1,7 +1,7 @@
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*
{ {
@@ -20,15 +20,12 @@ 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);
@@ -128,6 +125,14 @@ namespace Slime {
} }
} }
/*c
plot_title('Sine Wave')
plot_function_samples(1000)
plot_xaxis(0,30)
plot_yaxis(-1.5,1.5)
plot(sin(t))
*/
kw_done: 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) {
@@ -180,8 +185,7 @@ 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;
} }
@@ -489,11 +493,8 @@ namespace Slime {
// debug_break(); // debug_break();
} break; } break;
default: { default: {
char* t = lisp_object_to_string(pc); create_generic_error("The first element of the pair was not a function but: %{l_o_t} in %{l_o}",
defer_free(t); type, pc);
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;
} }
} }
@@ -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
+93 -104
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
+4 -5
View File
@@ -6,13 +6,13 @@ 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)
@@ -65,9 +65,8 @@ namespace Slime {
#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; \
} \ } \