Using ftb print and updated the doc generation

.gitignore

@@ -26,3 +26,5 @@ todo.html
 /bin/slime_d
 /bin/slime_p
 *.json
+/bin/manual.pdf
+/bin/manual.tex

3rd/ftb

@@ -1 +1 @@
-Subproject commit a77b1393050001991382a9bac3f395cf9c463f32
+Subproject commit dc98c61901fe01da4e3f1df4325d3f2d041f3700

bin/pre.slime

@@ -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 first car)
 (define rest cdr)
@@ -117,7 +110,25 @@ condition is false."
   (define unzipped (unzip bindings))
   `((,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)
+  "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)
     (if (= () clauses)
         ()

build.bat

@@ -7,25 +7,31 @@ set exeName=slime.exe
 taskkill /F /IM %exeName% > NUL 2> NUL
 
 echo ---------- Compiling ----------
-call cl  ^
+call ..\timecmd cl  ^
      ../src/main.cpp^
      /I../3rd/ ^
      /D_PROFILING /D_DEBUG /D_DONT_BREAK_ON_ERRORS ^
      /Zi /std:c++latest /Fe%exeName% /W3 /wd4003 /wd4996 /nologo /EHsc
 
+
 rem call ..\timecmd cl  ^
      rem ../src/main.cpp^
      rem /I../3rd/ ^
      rem /O2 /D_DONT_BREAK_ON_ERRORS ^
      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 (
    echo.
    echo -------- Running Tests --------
    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 (
   echo.
   echo Fuckin' ell

manual/build.bat

@@ -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/manual.org

@@ -956,6 +956,7 @@ embedded scripting language.
 #+latex_header: \usepackage[german]{babel}
 #+latex_header: \usepackage{xcolor}
 #+latex_header: \usepackage{listings}
+#+latex_header: \usepackage{inconsolata}
 #+latex_header: \usepackage[pageanchor=false]{hyperref}
 
 #+latex_header: \definecolor{slimeKeyword}{HTML}{B58900}

src/assert.hpp

@@ -22,23 +22,21 @@
 #define create_symbol_undefined_error(...)              \
     __create_error("symbol-undefined", __VA_ARGS__)
 
-#define create_type_missmatch_error(expected, actual, exp)            \
-    __create_error("type-missmatch",                                  \
-                   "Type missmatch: expected %s, got %s in %s",       \
+#define create_type_missmatch_error(expected, actual, exp)                            \
+    __create_error("type-missmatch",                                                  \
+                   "Type missmatch: expected %{l_o_t}, got %{l_o_t} in %{l_o_r}",       \
                    expected, actual, exp)
 
 #ifdef _DEBUG
 
-#define assert_type(_node, _type)                                       \
-    do {                                                                \
-        if (_node->type != _type) {                                     \
-            char* t = lisp_object_to_string(_node);                     \
-            defer_free(t);                                              \
-            create_type_missmatch_error(                                \
-                lisp_object_type_to_string(_type),                      \
-                lisp_object_type_to_string(_node->type),                \
-                t);                                                     \
-        }                                                               \
+#define assert_type(_node, _type)                                           \
+    do {                                                                    \
+        if (_node->type != _type) {                                         \
+            create_type_missmatch_error(                                    \
+                _type,                                                      \
+                _node->type,                                                \
+                _node);                                                     \
+        }                                                                   \
     } while(0)
 
 #define assert_list_length(_node, _len) assert("List length assertion", list_length(_node) == _len)

src/built_ins.cpp

@@ -203,7 +203,11 @@ namespace Slime {
             (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,
             // but because of call/cc, it cannot be anymore because
             // 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];
 
                 Environment* target_env = find_binding_environment(sym, get_current_environment());
-                    if (!target_env)
-                        target_env = get_root_environment();
+                if (!target_env)
+                    target_env = get_root_environment();
                 define_symbol(sym, val, target_env);
             });
             (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);
@@ -354,7 +358,8 @@ namespace Slime {
         {
             profile_with_name("(if)");
             using Globals::Current_Execution;
-            /* |          |    |   <test>  |
+            /*
+|          |    |   <test>  |
                |          | -> |   <then>  |
                |   <if>   |    |   <else>  |
                |   ....   |    |   ......  | */
@@ -397,51 +402,51 @@ namespace Slime {
             form = form->value.pair.rest;
             Lisp_Object_Type type = definee->type;
             switch (type) {
-            case Lisp_Object_Type::Symbol: {
-                if (form != Memory::nil) {
-                    Lisp_Object* doc = thing;
-                    try_void assert_type(doc,  Lisp_Object_Type::String);
-                    try_void assert_type(form, Lisp_Object_Type::Pair);
-                    thing = form->value.pair.first;
-                    try_void assert("list must end here.", form->value.pair.rest == Memory::nil);
-                    // TODO docs (maybe with hooks) we have to attach
-                    // the docs to the result of evaluating
-                }
-                Current_Execution.cs.append(definee);
-                Current_Execution.cs.append(thing);
-                (Current_Execution.nass.end()-1)->append(NasAction::Define_Var);
-                (Current_Execution.nass.end()-1)->append(NasAction::Eval);
-            } break;
-            case Lisp_Object_Type::Pair: {
-                try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol);
-                Lisp_Object* func;
-                try_void func =  Memory::create_lisp_object_function(Lisp_Function_Type::Lambda);
-                func->value.function->parent_environment = get_current_environment();
-                create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func);
-
-                if (thing_cons->type == Lisp_Object_Type::Pair &&
-                    // if there is stuff in the function body
-                    thing_cons->value.pair.first->type == Lisp_Object_Type::String &&
-                    // if the first is a string
-                    thing_cons->value.pair.rest != Memory::nil
-                    // if it is not the last
-                    ) {
-                    // we found docs
-                    Globals::docs.set_object(
-                        func,
-                        Memory::duplicate_string(
-                            thing_cons->value.pair.first->value.string).data);
-                    thing_cons = thing_cons->value.pair.rest;
+                case Lisp_Object_Type::Symbol: {
+                    if (form != Memory::nil) {
+                        Lisp_Object* doc = thing;
+                        try_void assert_type(doc,  Lisp_Object_Type::String);
+                        try_void assert_type(form, Lisp_Object_Type::Pair);
+                        thing = form->value.pair.first;
+                        try_void assert("list must end here.", form->value.pair.rest == Memory::nil);
+                        // TODO docs (maybe with hooks) we have to attach
+                        // the docs to the result of evaluating
+                    }
+                    Current_Execution.cs.append(definee);
+                    Current_Execution.cs.append(thing);
+                    (Current_Execution.nass.end()-1)->append(NasAction::Define_Var);
+                    (Current_Execution.nass.end()-1)->append(NasAction::Eval);
+                } break;
+                case Lisp_Object_Type::Pair: {
+                    try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol);
+                    Lisp_Object* func;
+                    try_void func =  Memory::create_lisp_object_function(Lisp_Function_Type::Lambda);
+                    func->value.function->parent_environment = get_current_environment();
+                    create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func);
+
+                    if (thing_cons->type == Lisp_Object_Type::Pair &&
+                        // if there is stuff in the function body
+                        thing_cons->value.pair.first->type == Lisp_Object_Type::String &&
+                        // if the first is a string
+                        thing_cons->value.pair.rest != Memory::nil
+                        // if it is not the last
+                        ) {
+                        // we found docs
+                        Globals::docs.set_object(
+                                                 func,
+                                                 Memory::duplicate_string(
+                                                                          thing_cons->value.pair.first->value.string).data);
+                        thing_cons = thing_cons->value.pair.rest;
+                    }
+                    func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons);
+
+                    define_symbol(definee->value.pair.first, func);
+                    Current_Execution.cs.append(definee->value.pair.first);
+                } break;
+                default: {
+                    create_generic_error("you can only define symbols");
+                    return;
                 }
-                func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons);
-
-                define_symbol(definee->value.pair.first, func);
-                Current_Execution.cs.append(definee->value.pair.first);
-            } break;
-            default: {
-                create_generic_error("you can only define symbols");
-                return;
-            }
             }
         };
         define((helper), "") {
@@ -458,7 +463,7 @@ namespace Slime {
             Globals::debug_log = false;
             return Memory::t;
         };
-        define_special((with-debug-log . rest), "") {
+        define_special((with-debug-log . rest), "TODO") {
             profile_with_name("(enable-debug-log)");
             fetch(rest);
             Lisp_Object* result = Memory::nil;
@@ -694,10 +699,8 @@ namespace Slime {
                 if (is_truthy(res))
                     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;
         };
         define_special((define-macro form . body), "TODO") {
@@ -748,6 +751,24 @@ namespace Slime {
             *target = *source;
             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") {
             profile_with_name("(vector-length)");
             fetch(v);
@@ -768,6 +789,39 @@ namespace Slime {
 
             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") {
             profile_with_name("(vector-set!)");
             fetch(vec, idx, val);
@@ -998,14 +1052,6 @@ namespace Slime {
             hm->value.hashMap->delete_object(key);
             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") {
             profile_with_name("(cons)");
             fetch(car, cdr);
@@ -1097,7 +1143,7 @@ namespace Slime {
             // // the global keyword
             profile_with_name("(info)");
             fetch(n);
-            print(n);
+            print("%{l_o}", n);
 
             Lisp_Object* type;
             Lisp_Object* val;
@@ -1106,11 +1152,9 @@ namespace Slime {
                 try val = eval_expr(n);
             }
 
-            printf(" is of type ");
-            print(type);
-            printf(" (internal: %s)", lisp_object_type_to_string(val->type));
-            printf("\nand is printed as: ");
-            print(val);
+            print(" is of type %{l_o}", n);
+            print(" (internal: %{l_o_t})",val->type);
+            print("\nand is printed as: %{l_o_r}", val);
             printf("\n\ndocs:\n=====\n  %s\n\n",
                    (Globals::docs.get_object(val))
                    ? Globals::docs.get_object(val)
@@ -1137,17 +1181,13 @@ namespace Slime {
                     printf("%s",
                            Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol));
                     if (args->keyword.values.data[0]) {
-                        printf(" (");
-                        print(args->keyword.values.data[0], true);
-                        printf(")");
+                        print(" (%{l_o_r})", args->keyword.values.data[0]);
                     }
                     for (u32 i = 1; i < args->keyword.values.next_index; ++i) {
                         printf(", %s",
                                Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol));
                         if (args->keyword.values.data[i]) {
-                            printf(" (");
-                            print(args->keyword.values.data[i], true);
-                            printf(")");
+                            print(" (%{l_o_r})", args->keyword.values.data[i]);
                         }
                     }
                 }
@@ -1166,10 +1206,8 @@ namespace Slime {
             fetch(n);
             try assert_type(n, Lisp_Object_Type::Function);
             try assert("c-functoins cannot be shown", !n->value.function->is_c);
-            puts("body:\n");
-            print(n->value.function->body.lisp_body);
-            puts("\n");
-            printf("parent_env: %p\n",
+            print("body:\n%{l_o}\n", n->value.function->body.lisp_body);
+            print("parent_env: %{ptr}\n",
                    n->value.function->parent_environment);
 
             return Memory::nil;
@@ -1194,21 +1232,28 @@ namespace Slime {
 
             if (things != 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) {
-                    print(sep);
-                    print(it, print_repr);
+                    if (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;
         };
         define((read (:prompt ">")), "TODO") {
             profile_with_name("(read)");
             fetch(prompt);
-            print(prompt);
+            print("%{l_o}", prompt);
 
             // TODO(Felix): make read_line return a String*
             char* line = read_line();
@@ -1227,7 +1272,7 @@ namespace Slime {
         define((show-environment), "TODO") {
             profile_with_name("(show-environment)");
             in_caller_env {
-                print_environment(get_current_environment());
+                print("%{env}", get_current_environment());
             }
             return Memory::nil;
         };
@@ -1293,9 +1338,9 @@ namespace Slime {
             using Globals::error;
             error = new(Error);
             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;
         };
         define((symbol->keyword sym), "TODO") {
@@ -1310,7 +1355,7 @@ namespace Slime {
 
             try assert_type(sym, Lisp_Object_Type::Symbol);
             return Memory::create_lisp_object(
-                Memory::duplicate_string(sym->value.symbol));
+                                              Memory::duplicate_string(sym->value.symbol));
         };
         define((string->symbol str), "TODO") {
             profile_with_name("(string->symbol)");

src/docgeneration.cpp

@@ -1,5 +1,6 @@
 namespace Slime {
     proc generate_docs(String path) -> void {
+        print("Generating Docs...");
         FILE *f = fopen(Memory::get_c_str(path), "w");
         if (!f) {
             create_generic_error("The file for writing the documentation (%s) "
@@ -11,6 +12,10 @@ namespace Slime {
         };
 
         Array_List<Environment*> visited;
+        visited.alloc();
+        defer {
+            visited.dealloc();
+        };
 
         const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void {
             bool we_already_printed = false;
@@ -22,8 +27,7 @@ namespace Slime {
                 }
             }
             if (!we_already_printed) {
-                // printf("Working on env::::");
-                // print_environment(env);
+                // print("Working on env::::%{env}",env);
                 // printf("\n--------------------------------\n");
                 visited.append(env);
 
@@ -34,7 +38,9 @@ namespace Slime {
 
                 for_hash_map(env->hm) {
                     try_void fprintf(f,
+                                     "#+latex: \\vspace{0.5cm}\n"
                                      "#+latex: \\hrule\n"
+                                     // "#+latex: \\hspace{0.5cm}\n"
                                      "#+html: <hr/>\n"
                                      "* =%s%s= \n"
                                      "  :PROPERTIES:\n"
@@ -60,10 +66,8 @@ namespace Slime {
                     Lisp_Object* type_expr = Memory::create_list(Memory::get_symbol("type"), value);
                     try_void LOtype = eval_expr(type_expr);
 
-                    fprintf(f, "\n - type :: =");
-                    print(LOtype, true, f);
-                    fprintf(f, "=");
-
+                    fprintf(f, "\n*type*\\newline\\indent\n");
+                    print_to_file(f, "=%{l_o_r}=\\newline\\noindent", LOtype);
 
                     /*
                      * if printable value -> print it
@@ -76,9 +80,7 @@ namespace Slime {
                     case(Lisp_Object_Type::Pair):
                     case(Lisp_Object_Type::Symbol):
                     case(Lisp_Object_Type::Keyword): {
-                        fprintf(f, "\n - value :: =");
-                        print(value, true, f);
-                        fprintf(f, "=");
+                        print_to_file(f, "\n*value*\\newline\\indent =%{l_o_r}=\\newline\\noindent", value);
                     } break;
                     default: break;
                     }
@@ -88,50 +90,48 @@ namespace Slime {
                     if (type == Lisp_Object_Type::Function)
                     {
                         Arguments* args = &value->value.function->args;
-                        fprintf(f, "\n - arguments :: ");
-                        // if no args at all
-                        if (args->positional.symbols.next_index == 0 &&
-                            args->keyword.values.next_index    == 0 &&
-                            !args->rest)
+                        fprintf(f, "\n*signature*\n");
+
+                        fprintf(f,
+                                "#+BEGIN:\n"
+                                "#+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) {
-                                fprintf(f, "\n    - postitional :: ");
-                                fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol));
-                                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));
+                                for (auto lo: args->positional.symbols) {
+                                    fprintf(f, " %s", lo->value.symbol.data);
                                 }
                             }
                             if (args->keyword.values.next_index != 0) {
-                                fprintf(f, "\n    - keyword :: ");
-                                fprintf(f, "=%s=", Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol));
-                                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));
+                                for (u32 i = 0; i < args->keyword.values.next_index; ++i) {
+                                    // if has default value
                                     if (args->keyword.values.data[i]) {
-                                        fprintf(f, " =(");
-                                        print(args->keyword.values.data[i], true, f);
-                                        fprintf(f, ")=");
+                                        print_to_file(f, " (:%s %{l_o})",
+                                                      args->keyword.keywords.data[i]->value.symbol.data,
+                                                      args->keyword.values.data[i]);
+                                    } else {
+                                        fprintf(f, " :%s", args->keyword.keywords.data[i]->value.symbol.data);
                                     }
                                 }
                             }
                             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 :: ");
-                    // TODO(Felix): make docsting a hashmap lookup
-                    // if (value->docstring)
-                    //     fprintf(f, "\n  #+BEGIN:\n%s\n  #+END:\n",
-                    //             Memory::get_c_str(value->docstring));
-                    // else
-                        fprintf(f, "none\n");
+                    fprintf(f, "\n\\noindent\n*docu*\n");
+                    char* docs = Globals::docs.get_object(value);
+                    fprintf(f, "\n  #+BEGIN:\n%s\n  #+END:\n",
+                            docs ? docs : "none");
                 }
             }
 
@@ -141,5 +141,6 @@ namespace Slime {
         };
 
         print_this_env(print_this_env, get_current_environment(), (char*)"");
+        print("Done!\n");
     }
 }

src/env.cpp

@@ -84,44 +84,44 @@ namespace Slime {
             return result;
 
         String identifier = node->value.symbol;
-        print_environment(env);
-        printf("\n");
+        print("%{env}\n", env);
         create_symbol_undefined_error("The symbol '%s' is not defined.", identifier.data);
         return nullptr;
     }
 
 
-    proc print_environment_indent(Environment* env, u32 indent) -> void {
-        proc print_indent = [indent]() {
-            for (u32 i = 0; i < indent; ++i) {
-                printf(" ");
+    proc print_environment(FILE* file, Environment* env) -> int {
+        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) {
+                    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;
             }
-        };
 
-        // if(env == get_root_environment()) {
-            // print_indent();
-            // printf("[built-ins]-Environment (0x%p)\n", env);
-            // 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);
-        }
-    }
+            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);
+            }
+        };
 
-    proc print_environment(Environment* env) -> void {
-        printf("\n=== Environment === (0x%p)\n", env);
-        print_environment_indent(env, 0);
+        written = print_to_file(file, "\n=== Environment === %{ptr}\n", env);
+        print_environment_indent(print_environment_indent, env, 0);
+        return written;
     }
 
 }

src/error.cpp

@@ -8,7 +8,7 @@ namespace Slime {
     }
 
     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;
         delete_error();
@@ -42,14 +42,14 @@ namespace Slime {
             error = new(Error);
             error->type = type;
         }
-        // contents will be filled in
-        String formatted_string = Memory::create_string("", 0);
+
+        char* msg;
 
         va_list args;
         va_start(args, format);
-        formatted_string.length = vasprintf(&formatted_string.data, format, args);
+        print_va_args_to_string(&msg, format, &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

@@ -1,9 +1,9 @@
+
 namespace Slime {
 
-    proc create_extended_environment_for_function_application_nrc(
-        Lisp_Object* function,
-        u32 arg_start,
-        u32 arg_end) -> Environment*
+    proc create_extended_environment_for_function_application_nrc(Lisp_Object* function,
+                                                                  u32 arg_start,
+                                                                  u32 arg_end) -> Environment*
     {
         profile_this();
         using Globals::Current_Execution;
@@ -20,18 +20,15 @@ namespace Slime {
         };
         u32 obligatory_keywords_count = 0;
         u32 read_obligatory_keywords_count = 0;
-
         Lisp_Object* sym;
         Lisp_Object* val;
-
         // read positionals
         for (u32 i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
             if (index_of_next_arg == arg_end) {
-                create_parsing_error(
-                    "Not enough positional args supplied. Needed: %d suppied, %d.\n"
-                    "Next missing arg is '%s'",
-                    arg_spec->positional.symbols.next_index, arg_end-index_of_next_arg,
-                    arg_spec->positional.symbols.data[i]->value.symbol.data);
+                create_parsing_error("Not enough positional args supplied. Needed: %d suppied, %d.\n"
+                                     "Next missing arg is '%s'",
+                                     arg_spec->positional.symbols.next_index, arg_end-index_of_next_arg,
+                                     arg_spec->positional.symbols.data[i]->value.symbol.data);
                 return nullptr;
             }
             // NOTE(Felix): We have to copy all the arguments,
@@ -72,10 +69,10 @@ namespace Slime {
                     // otherwise we would have to read more but there
                     // was a not accepted kwarg, so signal the error
                     create_generic_error(
-                        "The function does not take the keyword argument ':%s'\n"
-                        "and not all required keyword arguments have been read\n"
-                        "in to potentially count it as the rest argument.",
-                        Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
+                                         "The function does not take the keyword argument ':%s'\n"
+                                         "and not all required keyword arguments have been read\n"
+                                         "in to potentially count it as the rest argument.",
+                                         Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
                     return nullptr;
                 }
                 // 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
                         // in, it is an error
                         create_generic_error(
-                            "The function already read the keyword argument ':%s'",
-                            Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
+                                             "The function already read the keyword argument ':%s'",
+                                             Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
                         return nullptr;
                     }
                 }
@@ -101,8 +98,8 @@ namespace Slime {
                 // set it to?
                 if (index_of_next_arg+1 == arg_end) {
                     create_generic_error(
-                        "Attempting to set the keyword argument ':%s', but no value was supplied.",
-                        Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
+                                         "Attempting to set the keyword argument ':%s', but no value was supplied.",
+                                         Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
                     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
         for (u32 i = 0; i < arg_spec->keyword.values.next_index; ++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 (!was_set) {
                     create_generic_error(
-                        "There was no value supplied for the required "
-                        "keyword argument ':%s'.",
-                        defined_keyword->value.symbol.data);
+                                         "There was no value supplied for the required "
+                                         "keyword argument ':%s'.",
+                                         defined_keyword->value.symbol.data);
                     return nullptr;
                 }
             } else {
@@ -180,9 +185,8 @@ namespace Slime {
                 define_symbol(arg_spec->rest, list, env);
             } else {
                 // rest was not declared but additional arguments were found
-                create_generic_error(
-                    "A rest argument was not declared "
-                    "but the function was called with additional arguments.");
+                create_generic_error("A rest argument was not declared "
+                                     "but the function was called with additional arguments.");
                 return nullptr;
             }
         }
@@ -215,8 +219,8 @@ namespace Slime {
             if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) {
                 create_parsing_error("Only symbols and keywords "
                                      "(with or without default args) "
-                                     "can be parsed here, but found '%s'",
-                                     lisp_object_type_to_string(arguments->value.pair.first->type));
+                                     "can be parsed here, but found '%{l_o_t}'",
+                                     arguments->value.pair.first->type);
                 return;
             }
 
@@ -349,208 +353,205 @@ namespace Slime {
 
             current_action = nas->data[--nas->next_index];
             switch (current_action) {
-            case NasAction::Pop: {
-                --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());
+                case NasAction::Pop: {
+                    --Current_Execution.cs.next_index;
                 } break;
-                case Lisp_Object_Type::Pair: {
-                    Current_Execution.cs.data[Current_Execution.cs.next_index-1] = pc->value.pair.first;
-                    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);
+                case NasAction::And_Then_Action: {
+                    Current_Execution.ats.data[--Current_Execution.ats.next_index]();
                 } 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();
+                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;
+                        case Lisp_Object_Type::Pair: {
+                            Current_Execution.cs.data[Current_Execution.cs.next_index-1] = pc->value.pair.first;
+                            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);
-                            nas->append(NasAction::Macro_Write_Back);
-                            nas->append(NasAction::Step);
-                        } else {
-                            --Current_Execution.mes.next_index;
-                            nas->append(NasAction::Step);
+                        } break;
+                        default: {
+                            // NOTE(Felix): others are self evaluating
+                            // so do nothing
                         }
                     }
                 } 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;)
+                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.data[i].append(
-                                    pc->value.continuation->nass.data[i].data[Globals::Current_Execution.nass.data[i].next_index]);
+                                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;
-                default: {
-                    char* t = lisp_object_to_string(pc);
-                    defer_free(t);
-
-                    create_generic_error("The first element of the pair was not a function but: %s in %s",
-                                         lisp_object_type_to_string(type), t);
-                    return nullptr;
-                }
-                }
-
-            } break;
-            case NasAction::Step: {
-                if (Current_Execution.pcs.data[Current_Execution.pcs.next_index-1] == Memory::nil) {
-                    --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);
-
-                    Environment* extended_env;
-                    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();
+                case NasAction::Step: {
+                    if (Current_Execution.pcs.data[Current_Execution.pcs.next_index-1] == Memory::nil) {
+                        --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);
+
+                        Environment* extended_env;
+                        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 {
+                            nas->append(NasAction::Pop_Environment);
+                            nas->append(NasAction::Eval);
+                            Current_Execution.cs.append(function->value.function->body.lisp_body);
+                        }
                     } 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);
-                        Current_Execution.cs.append(function->value.function->body.lisp_body);
                     }
-                } else {
-                    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);
-                }
-            } 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::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;
                 }
-            } 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;
             }
             if (evaluated && evaluated != Memory::nil) {
-                print(evaluated);
+                print("%{l_o}", evaluated);
             }
             fputs("\n", stdout);
         }

src/forward_decls.cpp

@@ -17,9 +17,15 @@ namespace Slime {
     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, Environment* env);
-    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*);
+    // char* lisp_object_to_string(Lisp_Object* node, bool print_repr = true);
+
+    // 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);
     wchar_t* char_to_wchar(const char* c);
@@ -35,8 +41,6 @@ namespace Slime {
     inline void push_environment(Environment*);
     inline void pop_environment();
 
-    const char* lisp_object_type_to_string(Lisp_Object_Type type);
-
     void visualize_lisp_machine();
     void generate_docs(String path);
     void log_error();

src/io.cpp

@@ -337,84 +337,59 @@ namespace Slime {
         return res;
     }
 
-    proc lisp_object_to_string(Lisp_Object* node, bool print_repr) -> char* {
-        char* temp;
-        Array_List<char*> string_builder;
-        string_builder.alloc();
-        defer {
-            string_builder.dealloc();
-        };
+    proc print_lisp_object_optional(FILE* f, Lisp_Object* node, bool print_repr) -> int {
+        int written = 0;
 
-        if (!node) return duplicate_c_string("<nullptr>");
+        if (!node)
+            return print_to_file(f, "<nullptr>");
 
         switch (node->type) {
-        case (Lisp_Object_Type::Nil):          return duplicate_c_string("()");
-        case (Lisp_Object_Type::T):            return duplicate_c_string("t");
-        case (Lisp_Object_Type::Continuation): return duplicate_c_string("[continuation]");
-        case (Lisp_Object_Type::Pointer):      return duplicate_c_string("[pointer]");
+        case (Lisp_Object_Type::Nil):          return print_to_file(f, "()");
+        case (Lisp_Object_Type::T):            return print_to_file(f, "t");
+        case (Lisp_Object_Type::Continuation): return print_to_file(f, "[continuation]");
+        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): {
             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
-                asprintf(&temp, "%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;
+                return print_to_file(f, "%f", node->value.number);
         }
         case (Lisp_Object_Type::HashMap): {
             for_hash_map (*(node->value.hashMap)) {
-                char* k = lisp_object_to_string(key, true);
-                char* v = lisp_object_to_string((Lisp_Object*)value, true);
-                asprintf(&temp, " %s -> %s\n", k, v);
-                string_builder.append(temp);
-                free(v);
-                free(k);
-            }
-
-            temp = string_buider_to_string(string_builder);
-            // free all asprintfs
-            for (auto str : string_builder) {
-                free(str);
+                written += fprintf(f, " ");
+                written += print_lisp_object_optional(f, key, true);
+                written += fprintf(f, " -> ");
+                written += print_lisp_object_optional(f, (Lisp_Object*)value, true);
+                written += fprintf(f, "\n");
             }
-            return temp;
+            return written;
         }
         case (Lisp_Object_Type::String): {
             if (print_repr) {
                 char* escaped = escape_string(Memory::get_c_str(node->value.string));
-                asprintf(&temp, "\"%s\"", escaped);
+                written = fprintf(f, "\"%s\"", escaped);
                 free(escaped);
-                return temp;
+                return written;
             } 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;
         case (Lisp_Object_Type::Vector): {
-
-            string_builder.append(duplicate_c_string("["));
+            written += print_to_file(f, "[");
             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) {
-                string_builder.append(duplicate_c_string(" "));
-                string_builder.append(lisp_object_to_string(node->value.vector.data+i, print_repr));
+                written += print_to_file(f, " ");
+                written += print_lisp_object_optional(f, node->value.vector.data+i, print_repr);
             }
-            string_builder.append(duplicate_c_string("]"));
-            temp = string_buider_to_string(string_builder);
-            for (auto str : string_builder) {
-                free(str);
-            }
-            return temp;
+            written += print_to_file(f, "]");
+            return written;
         } break;
         case (Lisp_Object_Type::Function): {
             if (Globals::user_types.key_exists(node)) {
-                asprintf(&temp, "[%s]",
-                         ((Lisp_Object*)Globals::user_types.key_exists(node))
-                         ->value.symbol.data);
-                return temp;
+                return print_to_file(f, "[%s]", ((Lisp_Object*)Globals::user_types.key_exists(node)) ->value.symbol.data);
             }
 
             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));
                 if (name) {
                     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::cSpecial:  asprintf(&temp, "[c-special %s]", name->value.symbol.data); break;
-                    case C_Function_Type::cMacro:    asprintf(&temp, "[c-macro %s]",   name->value.symbol.data); break;
-                    default:                         return duplicate_c_string("[c-??]");
+                    case C_Function_Type::cFunction: return print_to_file(f, "[c-function %s]",name->value.symbol.data);
+                    case C_Function_Type::cSpecial:  return print_to_file(f, "[c-special %s]", name->value.symbol.data);
+                    case C_Function_Type::cMacro:    return print_to_file(f, "[c-macro %s]",   name->value.symbol.data);
+                    default:                         return print_to_file(f, "[c-??]");
                     }
                 } else {
                     switch (node->value.function->type.c_function_type) {
-                    case C_Function_Type::cFunction: asprintf(&temp, "[c-function]"); break;
-                    case C_Function_Type::cSpecial:  asprintf(&temp, "[c-special]"); break;
-                    case C_Function_Type::cMacro:    asprintf(&temp, "[c-macro]"); break;
-                    default:                         return duplicate_c_string("[c-??]");
+                    case C_Function_Type::cFunction: return print_to_file(f, "[c-function]");
+                    case C_Function_Type::cSpecial:  return print_to_file(f, "[c-special]");
+                    case C_Function_Type::cMacro:    return print_to_file(f, "[c-macro]");
+                    default:                         return print_to_file(f, "[c-??]");
                     }
                 }
-                return temp;
             } else {
                 switch (node->value.function->type.lisp_function_type) {
-                case Lisp_Function_Type::Lambda: return duplicate_c_string("[lambda]");
-                case Lisp_Function_Type::Macro:  return duplicate_c_string("[macro]");
-                default:                         return duplicate_c_string("[??]");
+                case Lisp_Function_Type::Lambda: return print_to_file(f, "[lambda]");
+                case Lisp_Function_Type::Macro:  return print_to_file(f, "[macro]");
+                default:                         return print_to_file(f, "[??]");
                 }
             }
         } break;
         case (Lisp_Object_Type::Pair): {
             Lisp_Object* head = node;
 
-            defer {
-                for (auto str : string_builder) {
-                    free(str);
-                }
-            };
+            // defer {
+                // for (auto str : string_builder) {
+                    // free(str);
+                // }
+            // };
             // first check if it is a quotation form, in that case we want
             // to print it prettier
             if (head->value.pair.first->type == Lisp_Object_Type::Symbol) {
@@ -464,73 +438,91 @@ namespace Slime {
                 auto unquote_sym          = Memory::get_symbol("unquote");
                 auto quasiquote_sym       = Memory::get_symbol("quasiquote");
                 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)
-                        string_builder.append(duplicate_c_string("\'"));
+                        written += print_to_file(f, "\'");
                     else if (symbol == unquote_sym)
-                        string_builder.append(duplicate_c_string(","));
+                        written += print_to_file(f, ",");
                     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("The list must end here.",
                            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));
-                    return string_buider_to_string(string_builder);
+                    written += print_lisp_object_optional(f, head->value.pair.rest->value.pair.first, print_repr);
+                    return written;
                 } 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);
-                    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
             // we want to print a broken list (for logging the error) we
             // should do more checks.
             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;
-                if (!head)                                            break;
+                if (!head)                                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) {
-                string_builder.append(duplicate_c_string(" . "));
-                string_builder.append(lisp_object_to_string(head, print_repr));
+                written += print_to_file(f, " . ");
+                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:
             create_generic_error("A Lisp_Object of type-id %d cannot be converted to a string",
                                  (u8)(node->type));
-            return nullptr;
+            return 0;
         }
     }
 
-    proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
-        char* string = nullptr;
-        defer {
-            free(string);
-        };
-        string = lisp_object_to_string(node, print_repr);
-        fputs(string, file);
+    proc print_lisp_object(FILE* file, Lisp_Object* node) -> int {
+        return print_lisp_object_optional(file, node, false);
+    }
+
+    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 {
-        printf(console_cyan);
-        print(obj, true);
-        printf(console_normal);
-        printf("\n   at ");
+        print("%{cyan}%{l_o_r}%{normal}\n   at ", obj);
         // TODO(Felix): Enable again when we have a source code
         // location again
 
@@ -550,14 +542,11 @@ namespace Slime {
 
         printf("cs:\n ");
         for (u32 i = 0; i < Current_Execution.cs.next_index; ++i)  {
-            char* t = lisp_object_to_string(Current_Execution.cs.data[i], true);
-            defer_free(t);
-            printf(" %d: %s\n ", i, t);
+            print(" %d: %{l_o_r}\n ", i, Current_Execution.cs.data[i]);
         }
         printf("\npcs:\n ");
         for (auto lo : Current_Execution.pcs)  {
-            print(lo, true);
-            printf("\n ");
+            print("%{l_o_r}\n",lo);
         }
         printf("\nnnas:\n ");
         for (auto nas: Current_Execution.nass) {
@@ -589,7 +578,7 @@ namespace Slime {
     proc log_error() -> void {
         fputs("\n", stdout);
         fputs(console_red,    stdout);
-        fputs(Memory::get_c_str(Globals::error->message), stdout);
+        fputs(Globals::error->message, stdout);
         puts(console_normal);
 
         fputs("  in: ", stdout);

src/libslime.cpp

@@ -38,6 +38,7 @@ u32 hm_hash(Slime::Lisp_Object* obj);
 #include "ftb/macros.hpp"
 #include "ftb/profiler.hpp"
 #include "ftb/hooks.hpp"
+#include "ftb/print.hpp"
 
 #    include "defines.cpp"
 #    include "assert.hpp"
@@ -46,32 +47,10 @@ u32 hm_hash(Slime::Lisp_Object* obj);
 #    include "structs.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) {
     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) {
     using namespace Slime;
     switch (obj->type) {

src/lisp_object.cpp

@@ -10,24 +10,4 @@ namespace Slime {
         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

@@ -190,6 +190,12 @@ namespace Slime::Memory {
     proc init() -> void {
         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);
         environment_memory.alloc(1024, 8);
         hashmap_memory.alloc(256, 8);
@@ -297,16 +303,19 @@ namespace Slime::Memory {
 
 
     proc allocate_vector(u32 size) -> Lisp_Object* {
-        Lisp_Object* ret = object_memory.allocate(size);
-        if (!ret) {
-            create_out_of_memory_error("The vector is too big to fit in a memory bucket.");
-            return nullptr;
-        }
+        // Lisp_Object* ret = object_memory.allocate(size);
+        // if (!ret) {
+            // create_out_of_memory_error("The vector is too big to fit in a memory bucket.");
+            // return nullptr;
+        // }
+        Lisp_Object* ret = (Lisp_Object*)malloc(size * sizeof(Lisp_Object));
         return ret;
     }
 
     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;
         try node = create_lisp_object();
@@ -319,6 +328,7 @@ namespace Slime::Memory {
 
         u32 i = 0;
         while (head != Memory::nil) {
+            // BUG(Felix): We copy symbols here...
             node->value.vector.data[i] = *head->value.pair.first;
             head = head->value.pair.rest;
             ++i;

src/structs.cpp

@@ -150,6 +150,6 @@ namespace Slime {
         Lisp_Object* position;
         // type has to be a keyword
         Lisp_Object* type;
-        String       message;
+        char*        message;
     };
 }

src/testing.cpp

@@ -6,15 +6,15 @@ namespace Slime {
 #define fail 0
 
 #define print_assert_equal_fail(variable, value, type, format)  \
-    printf("\n%s:%d: Assertion failed\n\tfor '" #variable "'"   \
-           "\n\texpected: " format                              \
-           "\n\tgot:      " format "\n",                        \
+    print("\n%s:%d: Assertion failed\n\tfor '" #variable "'"    \
+          "\n\texpected: " format                               \
+          "\n\tgot:      " format "\n",                         \
            __FILE__, __LINE__, (type)value, (type)variable)
 
 #define print_assert_not_equal_fail(variable, value, type, format)      \
-    printf("\n%s:%d: Assertion failed\n\tfor '" #variable "'"           \
-           "\n\texpected not: " format                                  \
-           "\n\tgot anyways:  " format "\n",                            \
+    print("\n%s:%d: Assertion failed\n\tfor '" #variable "'"            \
+          "\n\texpected not: " format                                   \
+          "\n\tgot anyways:  " format "\n",                             \
            __FILE__, __LINE__, (type)value, (type)variable)
 
 #define assert_equal_int(variable, value)                               \
@@ -59,17 +59,16 @@ namespace Slime {
 
 #define assert_equal_string(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;                                                    \
     }
 
-#define assert_equal_type(node, _type)                          \
-    if (node->type != _type) {                                  \
-        print_assert_equal_fail(                                \
-            lisp_object_type_to_string(node->type),             \
-            lisp_object_type_to_string(_type), char*, "%s");    \
-        return fail;                                            \
-    }                                                           \
+#define assert_equal_type(node, _type)                                \
+    if (node->type != _type) {                                        \
+        print_assert_equal_fail(node->type, _type, Lisp_Object_Type,  \
+                                "%{l_o_t}");                          \
+        return fail;                                                  \
+    }                                                                 \
 
 #define assert_null(variable)                   \
     assert_equal_int(variable, nullptr)