Fixed Memory Leaks. :)

3rd/ftb

@@ -1 +1 @@
-Subproject commit 43da71f8094e24c544c12352e02eb76c746e1c93
+Subproject commit abbd0b6280738332e195d5c37430feae1dbd0d5e

bin/pre.slime.expanded

@@ -4,35 +4,35 @@
 
 (define (hm/get-or-nil hm key) (mytry (hm/get hm key) ()))
 
-(define-syntax (pe expr) `(print ',expr "evaluates to" ,expr))
+(define-syntax (pe expr) (quasiquote (print (quote (unquote expr)) "evaluates to" (unquote expr))))
 
 (define the-empty-stream ())
 
 (define (stream-null? s) (if s t ()))
 
-(define-syntax (delay expr) `(,lambda () ,expr))
+(define-syntax (delay expr) (quasiquote ((unquote lambda) () (unquote expr))))
 
 (define (force promise) (promise))
 
-(define-syntax (when condition . body) :doc "Special form for when multiple actions should be done if a\ncondition is true.\n\n{{{example_start}}}\n(when (not ())\n  (print "Hello ")\n  (print "from ")\n  (print "when!"))\n\n(when ()\n  (print "Goodbye ")\n  (print "World!"))\n{{{example_end}}}\n" (if (= (rest body) ()) `(if ,condition (unquote-splicing body) nil) `(if ,condition (begin (unquote-splicing body)) nil)))
+(define-syntax (when condition . body) :doc "Special form for when multiple actions should be done if a\ncondition is true.\n\n{{{example_start}}}\n(when (not ())\n  (print "Hello ")\n  (print "from ")\n  (print "when!"))\n\n(when ()\n  (print "Goodbye ")\n  (print "World!"))\n{{{example_end}}}\n" (if (= (rest body) ()) (quasiquote (if (unquote condition) (unquote-splicing body) nil)) (quasiquote (if (unquote condition) (begin (unquote-splicing body)) nil))))
 
-(define-syntax (unless condition . body) :doc "Special form for when multiple actions should be done if a\ncondition is false." (if (= (rest body) ()) `(if ,condition nil (unquote-splicing body)) `(if ,condition nil (begin (unquote-splicing body)))))
+(define-syntax (unless condition . body) :doc "Special form for when multiple actions should be done if a\ncondition is false." (if (= (rest body) ()) (quasiquote (if (unquote condition) nil (unquote-splicing body))) (quasiquote (if (unquote condition) nil (begin (unquote-splicing body))))))
 
-(define-syntax (n-times times action) :doc "Executes action times times." (define (repeat times elem) (unless (> 1 times) (pair elem (repeat (- times 1) elem)))) `(begin (unquote-splicing (repeat times action))))
+(define-syntax (n-times times action) :doc "Executes action times times." (define (repeat times elem) (unless (> 1 times) (pair elem (repeat (- times 1) elem)))) (quasiquote (begin (unquote-splicing (repeat times action)))))
 
-(define-syntax (let bindings . body) (define (unzip lists) (when lists (define (iter lists l1 l2) (define elem (first lists)) (if elem (iter (rest lists) (pair (first elem) l1) (pair (first (rest elem)) l2)) (list l1 l2)))) (iter lists () ())) (define unzipped (unzip bindings)) `((,lambda ,(first unzipped) (unquote-splicing body)) (unquote-splicing (first (rest unzipped)))))
+(define-syntax (let bindings . body) (define (unzip lists) (when lists (define (iter lists l1 l2) (define elem (first lists)) (if elem (iter (rest lists) (pair (first elem) l1) (pair (first (rest elem)) l2)) (list l1 l2)))) (iter lists () ())) (define unzipped (unzip bindings)) (quasiquote (((unquote lambda) (unquote (first unzipped)) (unquote-splicing body)) (unquote-splicing (first (rest unzipped))))))
 
-(define-syntax (cond . clauses) (define (rec clauses) (if (= nil clauses) nil (if (= (first (first clauses)) 'else) (begin (if (not (= (rest clauses) ())) (error :syntax-error "There are additional clauses after the else clause!") (pair 'begin (rest (first clauses))))) `(if ,(first (first clauses)) (begin (unquote-splicing (rest (first clauses)))) ,(rec (rest clauses)))))) (rec clauses))
+(define-syntax (cond . clauses) (define (rec clauses) (if (= nil clauses) nil (if (= (first (first clauses)) (quote else)) (begin (if (not (= (rest clauses) ())) (error :syntax-error "There are additional clauses after the else clause!") (pair (quote begin) (rest (first clauses))))) (quasiquote (if (unquote (first (first clauses))) (begin (unquote-splicing (rest (first clauses)))) (unquote (rec (rest clauses)))))))) (rec clauses))
 
-(define-syntax (case var . clauses) (define (rec clauses) (if (= nil clauses) nil (if (= (first (first clauses)) 'else) (begin (if (not (= (rest clauses) ())) (error :syntax-error "There are additional clauses after the else clause!") (pair 'begin (rest (first clauses))))) `(if (member? ,var ',(first (first clauses))) (begin (unquote-splicing (rest (first clauses)))) ,(rec (rest clauses)))))) (rec clauses))
+(define-syntax (case var . clauses) (define (rec clauses) (if (= nil clauses) nil (if (= (first (first clauses)) (quote else)) (begin (if (not (= (rest clauses) ())) (error :syntax-error "There are additional clauses after the else clause!") (pair (quote begin) (rest (first clauses))))) (quasiquote (if (member? (unquote var) (quote (unquote (first (first clauses))))) (begin (unquote-splicing (rest (first clauses)))) (unquote (rec (rest clauses)))))))) (rec clauses))
 
-(define-syntax (construct-list . body) :doc "\n{{{example_start}}}\n(construct-list\n  i <- '(1 2 3 4 5)\n  yield (* i i))\n{{{example_end}}}\n\n(construct-list\n  i <- '(1 2 3 4)\n  j <- '(A B)\n  yield (pair i j))\n\n(construct-list\n  i <- '(1 2 3 4 5 6 7 8)\n  if (= 0 (% i 2))\n  yield i)\n" (define (append-map f ll) (unless (= ll ()) (define val (f (first ll))) (if (= (first val) ()) (append-map f (rest ll)) (extend val (append-map f (rest ll)))))) (define (rec body) (cond ((= () body) ()) ((= () (rest body)) (first body)) ((= (first (rest body)) '<-) `(,append-map (lambda (,(first body)) (list ,(rec (rest (rest (rest body)))))) ,(first (rest (rest body))))) ((= (first body) 'if) `(when ,(first (rest body)) ,(rec (rest (rest body))))) ((= (first (rest body)) 'yield) (first (rest body))) (else (error :syntax-error "Not a do-able expression")))) (rec body))
+(define-syntax (construct-list . body) :doc "\n{{{example_start}}}\n(construct-list\n  i <- '(1 2 3 4 5)\n  yield (* i i))\n{{{example_end}}}\n\n(construct-list\n  i <- '(1 2 3 4)\n  j <- '(A B)\n  yield (pair i j))\n\n(construct-list\n  i <- '(1 2 3 4 5 6 7 8)\n  if (= 0 (% i 2))\n  yield i)\n" (define (append-map f ll) (unless (= ll ()) (define val (f (first ll))) (if (= (first val) ()) (append-map f (rest ll)) (extend val (append-map f (rest ll)))))) (define (rec body) (cond ((= () body) ()) ((= () (rest body)) (first body)) ((= (first (rest body)) (quote <-)) (quasiquote ((unquote append-map) (lambda ((unquote (first body))) (list (unquote (rec (rest (rest (rest body))))))) (unquote (first (rest (rest body))))))) ((= (first body) (quote if)) (quasiquote (when (unquote (first (rest body))) (unquote (rec (rest (rest body))))))) ((= (first (rest body)) (quote yield)) (first (rest body))) (else (error :syntax-error "Not a do-able expression")))) (rec body))
 
-(define-syntax (define-typed args . body) (define (get-arg-names args) (when args (pair (first args) (get-arg-names (rest (rest args)))))) (let ((name (first args)) (lambda-list (rest args)) (arg-names (get-arg-names (rest args)))) `(define (,name (unquote-splicing arg-names)) (assert-types= (unquote-splicing lambda-list)) (unquote-splicing body))))
+(define-syntax (define-typed args . body) (define (get-arg-names args) (when args (pair (first args) (get-arg-names (rest (rest args)))))) (let ((name (first args)) (lambda-list (rest args)) (arg-names (get-arg-names (rest args)))) (quasiquote (define ((unquote name) (unquote-splicing arg-names)) (assert-types= (unquote-splicing lambda-list)) (unquote-splicing body)))))
 
-(define-syntax (define-module module-name (:imports ()) :exports . body) (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) (eval `(begin (unquote-splicing (map (lambda (x) `(,import ,x)) imports)) (unquote-splicing body))) (pair 'begin (map (lambda (orig-export-name) (let ((export-name (string->symbol (concat-strings module-prefix (symbol->string orig-export-name))))) `(define ,export-name ,(mytry (eval orig-export-name) (error :module-error "The module does not contain a key it tries to export"))))) exports))))
+(define-syntax (define-module module-name (:imports ()) :exports . body) (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) (eval (quasiquote (begin (unquote-splicing (map (lambda (x) (quasiquote ((unquote import) (unquote x)))) imports)) (unquote-splicing body)))) (pair (quote begin) (map (lambda (orig-export-name) (let ((export-name (string->symbol (concat-strings module-prefix (symbol->string orig-export-name))))) (quasiquote (define (unquote export-name) (unquote (mytry (eval orig-export-name) (error :module-error "The module does not contain a key it tries to export"))))))) exports))))
 
-(define-syntax (generic-extend args . body) (let ((fun-name (first args)) (params (rest args)) (types ()) (names ())) (define (process-params params) (when params (let ((_name (first params)) (_type (first (rest params)))) (assert (symbol? _name)) (assert (keyword? _type)) (set! types (append types _type)) (set! names (append names _name)) (process-params (rest (rest params)))))) (process-params params) (let ((generic-map-name (string->symbol (concat-strings "generic-" (symbol->string fun-name) "-map")))) (unless (bound? generic-map-name) (define generic-map-name (create-hash-map))) (hm/set! generic-map-name types (eval `(,lambda ,names (unquote-splicing body)))) (if (bound? fun-name) (let ((exisiting-fun (eval fun-name))) (unless (type=? exisiting-fun :generic-procedure) (unless (procedure? exisiting-fun) (error :macro-expand-error "can only generic-extend procedures.")) (define orig-proc exisiting-fun) (define fun-name (eval `(,lambda args (let ((fun (hm/get (map type args)))) (if (procedure? fun) (fun . args) (,orig-proc . args))))))))))))
+(define-syntax (generic-extend args . body) (let ((fun-name (first args)) (params (rest args)) (types ()) (names ())) (define (process-params params) (when params (let ((_name (first params)) (_type (first (rest params)))) (assert (symbol? _name)) (assert (keyword? _type)) (set! types (append types _type)) (set! names (append names _name)) (process-params (rest (rest params)))))) (process-params params) (let ((generic-map-name (string->symbol (concat-strings "generic-" (symbol->string fun-name) "-map")))) (unless (bound? generic-map-name) (define generic-map-name (create-hash-map))) (hm/set! generic-map-name types (eval (quasiquote ((unquote lambda) (unquote names) (unquote-splicing body))))) (if (bound? fun-name) (let ((exisiting-fun (eval fun-name))) (unless (type=? exisiting-fun :generic-procedure) (unless (procedure? exisiting-fun) (error :macro-expand-error "can only generic-extend procedures.")) (define orig-proc exisiting-fun) (define fun-name (eval (quasiquote ((unquote lambda) args (let ((fun (hm/get (map type args)))) (if (procedure? fun) (fun . args) ((unquote orig-proc) . args)))))))))))))
 
 (define (null? x) :doc "Checks if the argument is =nil=." (= x ()))
 

bin/tests/class_macro.slime.expanded

@@ -8,7 +8,7 @@
 
 (assert (= (type v1) (type v2) :vector3))
 
-(assert (= (v1 'scalar-product v2) 10))
+(assert (= (v1 (quote scalar-product) v2) 10))
 
 (assert (-> (-> v1 cross-product v2) equal? (make-vector3 -4 8 -4)))
 

build.sh

@@ -19,17 +19,17 @@ echo "----------------------"
 echo ""
 
 # time g++ -fpermissive src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1
-time clang++ -D_DEBUG -D_PROFILING -D_DONT_BREAK_ON_ERRORS \
+time clang++ -D_DEBUG -D_DONT_BREAK_ON_ERRORS \
      src/main.cpp -g -o ./bin/slime --std=c++17 \
      -I3rd/ || exit 1
 # time clang++ -O3 -D_DONT_BREAK_ON_ERRORS \
      # src/main.cpp -g -o ./bin/slime --std=c++17 \
      # -I3rd/ || exit 1
 
-
 echo ""
 pushd ./bin > /dev/null
-time ./slime --run-tests
+time valgrind --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime --run-tests
+# time ./slime --run-tests
 
 popd > /dev/null
 popd > /dev/null

include/define_macros.hpp

@@ -101,11 +101,14 @@
         )(__VA_ARGS__)
 #endif
 
-// NOTE(Felix): we have to copy the string because we need
-// it to be mutable for the parser to work, because the
-// parser relys on being able to temporaily put in markers
-// in the code
+// NOTE(Felix): we have to copy the string because we need it to be
+// mutable for the parser to work, because the parser relys on being
+// able to temporaily put in markers in the code and also it will fill
+// out the source code location
 #define _define_helper(def, docs, special)                                                         \
+    Parser::parser_file = file_name_built_ins;                                                     \
+    Parser::parser_line = __LINE__;                                                                \
+    Parser::parser_col = 0;                                                                        \
     auto label(params,__LINE__) = Parser::parse_single_expression(                                 \
         Memory::get_c_str(Memory::create_string(#def)));                                           \
     if_error_log_location_and_return();                                                            \
@@ -115,13 +118,9 @@
     auto label(sfun,__LINE__) = Memory::create_lisp_object_cfunction(special);                     \
     create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \
     if_error_log_location_and_return();                                                            \
-    label(sfun,__LINE__)->sourceCodeLocation =  new(Source_Code_Location);                         \
-    label(sfun,__LINE__)->sourceCodeLocation->file   = file_name_built_ins;                        \
-    label(sfun,__LINE__)->sourceCodeLocation->line   = __LINE__;                                   \
-    label(sfun,__LINE__)->sourceCodeLocation->column = 0;                                          \
     label(sfun,__LINE__)->docstring = Memory::create_string(docs);                                 \
     define_symbol(label(sym,__LINE__), label(sfun,__LINE__));                                      \
-    label(sfun,__LINE__)->value.cFunction->body = (std::function<Lisp_Object* ()>)[&]() -> Lisp_Object*
+    label(sfun,__LINE__)->value.cFunction->body = []() -> Lisp_Object*
 
 #define define(def, docs)         _define_helper(def, docs, false)
 #define define_special(def, docs) _define_helper(def, docs, true)

include/libslime.h

@@ -1,6 +1,6 @@
 #pragma once
 
-#include <functional>
+// #include <functional>
 #include "ftb/arraylist.hpp"
 #include "ftb/hashmap.hpp"
 

src/built_ins.cpp

@@ -83,6 +83,7 @@ proc built_in_load(String* file_name) -> Lisp_Object* {
         try result = eval_expr(program->data[i]);
     }
     delete program;
+    free(file_content);
 
     return result;
 }
@@ -315,18 +316,6 @@ proc load_built_ins_into_environment() -> void {
     define_special((define-syntax form (:doc "") . body), "TODO") {
         fetch(form, doc, body);
 
-        // static Lisp_Object *form_symbol = Memory::get_or_create_lisp_object_symbol("form");
-        // static Lisp_Object *doc_symbol = Memory::get_or_create_lisp_object_symbol("doc");
-        // static Lisp_Object *body_symbol = Memory::get_or_create_lisp_object_symbol("body");
-
-        // printf("\n\nin define-syntax:: envi stack depth: %d\n",
-               // Globals::Current_Execution::envi_stack.next_index);
-        // print_environment(get_current_environment());
-
-        // Lisp_Object *form = lookup_symbol(form_symbol, get_current_environment());
-        // Lisp_Object *doc  = lookup_symbol(doc_symbol, get_current_environment());
-        // Lisp_Object *body = lookup_symbol(body_symbol, get_current_environment());
-
         try assert_type(doc, Lisp_Object_Type::String);
         // if no doc string, we dont have to store it
         if (Memory::get_c_str(doc)[0] == '\0') {
@@ -343,20 +332,19 @@ proc load_built_ins_into_environment() -> void {
 
         // creating new lisp object and setting type
         Lisp_Object* func;
-        try func = Memory::create_lisp_object();
-        Memory::set_type(func, Lisp_Object_Type::Function);
-        func->value.function.type = Function_Type::Macro;
-        new((&func->value.function.args.positional.symbols)) Array_List<Environment*>(16);
-        new((&func->value.function.args.keyword.keywords))   Array_List<Environment*>(16);
-        new((&func->value.function.args.keyword.values))     Array_List<Environment*>(16);
+        try func = Memory::create_lisp_object_function(Function_Type::Macro);
 
+        // Lisp_Object* func;
+        // try func = Memory::create_lisp_object();
+        // Memory::set_type(func, Lisp_Object_Type::Function);
+        // func->value.function->type = Function_Type::Macro;
         if (doc) func->docstring = doc->value.string;
 
         in_caller_env {
             // setting parent env
-            func->value.function.parent_environment = get_current_environment();
+            func->value.function->parent_environment = get_current_environment();
             create_arguments_from_lambda_list_and_inject(lambdalist, func);
-            func->value.function.body = maybe_wrap_body_in_begin(body);
+            func->value.function->body = maybe_wrap_body_in_begin(body);
             define_symbol(symbol, func);
         }
         return Memory::nil;
@@ -394,21 +382,16 @@ proc load_built_ins_into_environment() -> void {
 
             // creating new lisp object and setting type
             Lisp_Object* func;
-            try func = Memory::create_lisp_object();
-            Memory::set_type(func, Lisp_Object_Type::Function);
-            func->value.function.type = Function_Type::Lambda;
-                        new((&func->value.function.args.positional.symbols)) Array_List<Environment*>(16);
-                        new((&func->value.function.args.keyword.keywords))   Array_List<Environment*>(16);
-                        new((&func->value.function.args.keyword.values))     Array_List<Environment*>(16);
+            try func =  Memory::create_lisp_object_function(Function_Type::Lambda);
 
             if (doc)
                 func->docstring = doc->value.string;
 
             in_caller_env {
                 // setting parent env
-                func->value.function.parent_environment = get_current_environment();
+                func->value.function->parent_environment = get_current_environment();
                 create_arguments_from_lambda_list_and_inject(lambdalist, func);
-                func->value.function.body = maybe_wrap_body_in_begin(body);
+                func->value.function->body = maybe_wrap_body_in_begin(body);
                 define_symbol(symbol, func);
             }
 
@@ -536,12 +519,10 @@ proc load_built_ins_into_environment() -> void {
         Lisp_Object* quasiquote_sym       = Memory::get_or_create_lisp_object_symbol("quasiquote");
         Lisp_Object* unquote_sym          = Memory::get_or_create_lisp_object_symbol("unquote");
         Lisp_Object* unquote_splicing_sym = Memory::get_or_create_lisp_object_symbol("unquote-splicing");
-        /* recursive lambdas in lambdas yay!! */
         // NOTE(Felix): first we have to initialize the variable
         // with a garbage lambda, so that we can then overwrite it
         // a recursive lambda
-        std::function<Lisp_Object*(Lisp_Object*)> unquoteSomeExpressions; // = [] (Lisp_Object* expr) -> Lisp_Object* {return nullptr;};
-        unquoteSomeExpressions = [&] (Lisp_Object* expr) -> Lisp_Object* {
+        const auto unquoteSomeExpressions = [&] (const auto & self, Lisp_Object* expr) -> Lisp_Object* {
             // if it is an atom, return it
             if (Memory::get_type(expr) != Lisp_Object_Type::Pair)
                 return Memory::copy_lisp_object(expr);
@@ -584,7 +565,7 @@ proc load_built_ins_into_environment() -> void {
                 if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Pair &&
                     head->value.pair.first->value.pair.first == unquote_splicing_sym)
                 {
-                    Lisp_Object* spliced = unquoteSomeExpressions(head->value.pair.first);
+                    Lisp_Object* spliced = self(self, head->value.pair.first);
 
                     if (spliced == Memory::nil) {
                         head = head->value.pair.rest;
@@ -615,7 +596,7 @@ proc load_built_ins_into_environment() -> void {
                         try newPairHead->value.pair.rest  = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
                         newPairHead = newPairHead->value.pair.rest;
                     }
-                    newPairHead->value.pair.first = unquoteSomeExpressions(head->value.pair.first);
+                    newPairHead->value.pair.first = self(self, head->value.pair.first);
                 }
 
                 // if (Memory::get_type(head->value.pair.rest) != Lisp_Object_Type::Pair) {
@@ -630,7 +611,7 @@ proc load_built_ins_into_environment() -> void {
             return newPair;
         };
 
-        expr = unquoteSomeExpressions(expr);
+        expr = unquoteSomeExpressions(unquoteSomeExpressions, expr);
         return expr;
     };
     define_special((and . args), "TODO") {
@@ -694,18 +675,17 @@ proc load_built_ins_into_environment() -> void {
     define_special((lambda args . body), "TODO") {
         fetch(args, body);
 
-        Lisp_Object* fun;
-        try fun = Memory::create_lisp_object();
-        Memory::set_type(fun, Lisp_Object_Type::Function);
-        fun->value.function.type = Function_Type::Lambda;
+        // creating new lisp object and setting type
+        Lisp_Object* func;
+        try func =  Memory::create_lisp_object_function(Function_Type::Lambda);
 
         in_caller_env {
-            fun->value.function.parent_environment = get_current_environment();
+            func->value.function->parent_environment = get_current_environment();
         }
 
-        try create_arguments_from_lambda_list_and_inject(args, fun);
-        fun->value.function.body = maybe_wrap_body_in_begin(body);
-        return fun;
+        try create_arguments_from_lambda_list_and_inject(args, func);
+        func->value.function->body = maybe_wrap_body_in_begin(body);
+        return func;
     };
     // define_special((special-lambda args . body), "TODO") {
     //     fetch(args, body);
@@ -713,14 +693,14 @@ proc load_built_ins_into_environment() -> void {
     //     Lisp_Object* fun;
     //     try fun = Memory::create_lisp_object();
     //     Memory::set_type(fun, Lisp_Object_Type::Function);
-    //     fun->value.function.type = Function_Type::Special_Lambda;
+    //     fun->value.function->type = Function_Type::Special_Lambda;
 
     //     in_caller_env {
-    //         fun->value.function.parent_environment = get_current_environment();
+    //         fun->value.function->parent_environment = get_current_environment();
     //     }
 
     //     try create_arguments_from_lambda_list_and_inject(args, fun);
-    //     fun->value.function.body = maybe_wrap_body_in_begin(body);
+    //     fun->value.function->body = maybe_wrap_body_in_begin(body);
     //     return fun;
     // };
     define((apply fun args), "TODO") {
@@ -834,7 +814,7 @@ proc load_built_ins_into_environment() -> void {
         case Lisp_Object_Type::Continuation: return Memory::get_or_create_lisp_object_keyword("continuation");
         case Lisp_Object_Type::CFunction: return Memory::get_or_create_lisp_object_keyword("cfunction");
         case Lisp_Object_Type::Function: {
-            Function* fun = &n->value.function;
+            Function* fun = n->value.function;
             if (fun->type == Function_Type::Lambda)
                 return Memory::get_or_create_lisp_object_keyword("lambda");
             // else if (fun->type == Function_Type::Special_Lambda)
@@ -892,7 +872,7 @@ proc load_built_ins_into_environment() -> void {
         {
             Arguments* args;
             if (Memory::get_type(val) == Lisp_Object_Type::Function)
-                args = &val->value.function.args;
+                args = &val->value.function->args;
             else
                 args = &val->value.cFunction->args;
 
@@ -941,10 +921,10 @@ proc load_built_ins_into_environment() -> void {
         try assert_type(n, Lisp_Object_Type::Function);
 
         puts("body:\n");
-        print(n->value.function.body);
+        print(n->value.function->body);
         puts("\n");
         printf("parent_env: %lld\n",
-               (long long)n->value.function.parent_environment);
+               (long long)n->value.function->parent_environment);
 
         return Memory::nil;
     };

src/define_macros.hpp

@@ -101,11 +101,14 @@
         )(__VA_ARGS__)
 #endif
 
-// NOTE(Felix): we have to copy the string because we need
-// it to be mutable for the parser to work, because the
-// parser relys on being able to temporaily put in markers
-// in the code
+// NOTE(Felix): we have to copy the string because we need it to be
+// mutable for the parser to work, because the parser relys on being
+// able to temporaily put in markers in the code and also it will fill
+// out the source code location
 #define _define_helper(def, docs, special)                                                         \
+    Parser::parser_file = file_name_built_ins;                                                     \
+    Parser::parser_line = __LINE__;                                                                \
+    Parser::parser_col = 0;                                                                        \
     auto label(params,__LINE__) = Parser::parse_single_expression(                                 \
         Memory::get_c_str(Memory::create_string(#def)));                                           \
     if_error_log_location_and_return();                                                            \
@@ -115,13 +118,9 @@
     auto label(sfun,__LINE__) = Memory::create_lisp_object_cfunction(special);                     \
     create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \
     if_error_log_location_and_return();                                                            \
-    label(sfun,__LINE__)->sourceCodeLocation =  new(Source_Code_Location);                         \
-    label(sfun,__LINE__)->sourceCodeLocation->file   = file_name_built_ins;                        \
-    label(sfun,__LINE__)->sourceCodeLocation->line   = __LINE__;                                   \
-    label(sfun,__LINE__)->sourceCodeLocation->column = 0;                                          \
     label(sfun,__LINE__)->docstring = Memory::create_string(docs);                                 \
     define_symbol(label(sym,__LINE__), label(sfun,__LINE__));                                      \
-    label(sfun,__LINE__)->value.cFunction->body = (std::function<Lisp_Object* ()>)[&]() -> Lisp_Object*
+    label(sfun,__LINE__)->value.cFunction->body = []() -> Lisp_Object*
 
 #define define(def, docs)         _define_helper(def, docs, false)
 #define define_special(def, docs) _define_helper(def, docs, true)

src/error.cpp

@@ -30,7 +30,7 @@ proc create_error(const char* c_func_name,const char* c_file_name, int c_file_li
     }
     // visualize_lisp_machine();
     using Globals::error;
-    error = new(Error);
+    error = (Error*)malloc(sizeof(Error)) ;
     error->type = type;
     error->message = message;
 

src/eval.cpp

@@ -17,8 +17,8 @@ proc create_extended_environment_for_function_application(
         new_env = Memory::create_child_environment(get_root_environment());
         arg_spec = &function->value.cFunction->args;
     } else {
-        new_env = Memory::create_child_environment(function->value.function.parent_environment);
-        arg_spec = &function->value.function.args;
+        new_env = Memory::create_child_environment(function->value.function->parent_environment);
+        arg_spec = &function->value.function->args;
     }
     if (should_evaluate) {
         try arguments = eval_arguments(arguments);
@@ -51,7 +51,7 @@ proc create_extended_environment_for_function_application(
             // NOTE(Felix): We have to copy all the arguments,
             // otherwise we change the program code. XXX(Felix): T C
             // functions we pass by reference...
-            try_void sym = arg_spec->positional.symbols.data[i];
+            sym = arg_spec->positional.symbols.data[i];
             if (is_c_function) {
                 define_symbol(sym, arguments->value.pair.first);
             } else {
@@ -240,7 +240,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function,
     if (Memory::get_type(function) == Lisp_Object_Type::CFunction)
         try result = function->value.cFunction->body();
     else // if lisp function
-        try result = eval_expr(function->value.function.body);
+        try result = eval_expr(function->value.function->body);
 
     return result;
 }
@@ -256,16 +256,14 @@ proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_O
     if (Memory::get_type(function) == Lisp_Object_Type::CFunction) {
         result = &function->value.cFunction->args;
     } else {
-        result = &function->value.function.args;
+        result = &function->value.function->args;
     }
 
-    ::new (&result->positional.symbols) Array_List<Lisp_Object*>;
-    ::new (&result->keyword.keywords)   Array_List<Lisp_Object*>;
-    ::new (&result->keyword.values)     Array_List<Lisp_Object*>;
+    // ::new (&result->positional.symbols) Array_List<Lisp_Object*>;
+    // ::new (&result->keyword.keywords)   Array_List<Lisp_Object*>;
+    // ::new (&result->keyword.values)     Array_List<Lisp_Object*>;
 
     // first init the fields
-    // result->positional = create_positional_argument_list(16);
-    // result->keyword    = create_keyword_argument_list(16);
     result->rest       = nullptr;
 
     // okay let's try to read some positional arguments
@@ -357,6 +355,11 @@ proc list_length(Lisp_Object* node) -> int {
     return 0;
 }
 
+proc copy_scl(Source_Code_Location*) -> Source_Code_Location* {
+    // TODO(Felix):
+    return nullptr;
+}
+
 proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* {
     profile_this;
     // int my_out_arguments_length = 0;
@@ -374,7 +377,8 @@ proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* {
     while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
         try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first);
 
-        evaluated_arguments_head->value.pair.first->sourceCodeLocation = current_head->value.pair.first->sourceCodeLocation;
+        evaluated_arguments_head->value.pair.first->sourceCodeLocation =
+            copy_scl(current_head->value.pair.first->sourceCodeLocation);
         current_head = current_head->value.pair.rest;
 
         if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
@@ -451,7 +455,7 @@ proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
             try result = apply_arguments_to_function(
                 arguments,
                 lispOperator,
-                lispOperator->value.function.type == Function_Type::Lambda);
+                lispOperator->value.function->type == Function_Type::Lambda);
 
             // NOTE(Felix): The parser does not understnad (import ..)
             // so it cannot expand imported macros at read time
@@ -460,15 +464,20 @@ proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
             // stray macros fying around, in that case, we expand them
             // and bake them in, so they do not have to be expanded
             // later again. We will call this "lazy macro expansion"
-            if (lispOperator->value.function.type == Function_Type::Macro) {
+            if (lispOperator->value.function->type == Function_Type::Macro) {
                 // bake in the macro expansion:
-                *node = *result;
+                *node = *Memory::copy_lisp_object(result);
+                result->sourceCodeLocation = copy_scl(result->sourceCodeLocation);
                 // eval again because macro
                 try result = eval_expr(result);
             }
 
             return result;
         }
+
+        create_generic_error("The first element of the pair was not a function but: %s",
+                             Lisp_Object_Type_to_string(Memory::get_type(lispOperator)));
+        return nullptr;
     }
     default: {
         create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node)));

src/gc.cpp

@@ -46,10 +46,10 @@ namespace GC {
             // NOTE(Felix): We dont have to mark the symbols, keywords
             // for parameter names, as symbols and keywords are never
             // garbage collected
-            maybe_mark(node->value.function.parent_environment);
-            maybe_mark(node->value.function.body);
+            maybe_mark(node->value.function->parent_environment);
+            maybe_mark(node->value.function->body);
             // mark the default arguemnt values:
-            for (auto it : node->value.function.args.keyword.values) {
+            for (auto it : node->value.function->args.keyword.values) {
                 if (it)
                     maybe_mark(it);
             }

src/io.cpp

@@ -64,9 +64,8 @@ proc escape_string(char* in) -> char* {
     return ret;
 }
 
-proc unescape_string(char* in) -> bool {
-    if (!in)
-        return true;
+proc unescape_string(char* in) -> int {
+    if (!in) return 0;
 
     char *out = in, *p = in;
     const char *int_err = nullptr;
@@ -117,9 +116,7 @@ proc unescape_string(char* in) -> bool {
 
     /* Set the end of string. */
     *out = '\0';
-    if (int_err)
-        return false;
-    return true;
+    return out - in;
 }
 
 proc read_entire_file(char* filename) -> char* {
@@ -358,11 +355,11 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
             fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol.identifier));
             break;
         }
-        if (node->value.function.type == Function_Type::Lambda)
+        if (node->value.function->type == Function_Type::Lambda)
             fputs("[lambda]", file);
-        // else if (node->value.function.type == Function_Type::Special_Lambda)
+        // else if (node->value.function->type == Function_Type::Special_Lambda)
             // fputs("[special-lambda]", file);
-        else if (node->value.function.type == Function_Type::Macro)
+        else if (node->value.function->type == Function_Type::Macro)
             fputs("[macro]", file);
         else
             assert(false);
@@ -372,33 +369,33 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
 
         // first check if it is a quotation form, in that case we want
         // to print it prettier
-        if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) {
-            String* identifier = head->value.pair.first->value.symbol.identifier;
-
-
-            auto symbol = head->value.pair.first;
-            auto quote_sym      = Memory::get_or_create_lisp_object_symbol("quote");
-            auto unquote_sym    = Memory::get_or_create_lisp_object_symbol("unquote");
-            auto quasiquote_sym = Memory::get_or_create_lisp_object_symbol("quasiquote");
-            if (symbol == quote_sym || symbol == unquote_sym)
-            {
-                putc(symbol == quote_sym
-                     ? '\''
-                     : ',', file);
-
-                assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
-                assert(head->value.pair.rest->value.pair.rest == Memory::nil);
-
-                print(head->value.pair.rest->value.pair.first, print_repr, file);
-                break;
-            }
-            else if (symbol == quasiquote_sym) {
-                putc('`', file);
-                assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
-                print(head->value.pair.rest->value.pair.first, print_repr, file);
-                break;
-            }
-        }
+        // if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) {
+        //     String* identifier = head->value.pair.first->value.symbol.identifier;
+
+
+        //     auto symbol = head->value.pair.first;
+        //     auto quote_sym      = Memory::get_or_create_lisp_object_symbol("quote");
+        //     auto unquote_sym    = Memory::get_or_create_lisp_object_symbol("unquote");
+        //     auto quasiquote_sym = Memory::get_or_create_lisp_object_symbol("quasiquote");
+        //     if (symbol == quote_sym || symbol == unquote_sym)
+        //     {
+        //         putc(symbol == quote_sym
+        //              ? '\''
+        //              : ',', file);
+
+        //         assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
+        //         assert(head->value.pair.rest->value.pair.rest == Memory::nil);
+
+        //         print(head->value.pair.rest->value.pair.first, print_repr, file);
+        //         break;
+        //     }
+        //     else if (symbol == quasiquote_sym) {
+        //         putc('`', file);
+        //         assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
+        //         print(head->value.pair.rest->value.pair.first, print_repr, file);
+        //         break;
+        //     }
+        // }
 
         putc('(', file);
 

src/libslime.cpp

@@ -3,7 +3,6 @@
 
 #define _CRTDBG_MAP_ALLOC
 #include <stdlib.h>
-#include <crtdbg.h>
 
 #include <stdio.h>
 #include <time.h>
@@ -11,12 +10,14 @@
 #include <cmath>
 #include <ctype.h>
 #include <stdarg.h>
-#include <functional>
+#include <errno.h>
+#include <new>
+// #include <functional>
 
 #ifdef _MSC_VER
+#  include <crtdbg.h>
 #  include <direct.h>
 #  include <windows.h>
-
 #else
 #  include <unistd.h>
 #  include <signal.h>

src/lisp_object.cpp

@@ -41,7 +41,25 @@ proc append_to_keyword_argument_list(Keyword_Arguments* args,
 }
 
 Lisp_Object::~Lisp_Object() {
-    if (Memory::get_type(this) == Lisp_Object_Type::HashMap) {
+    free(sourceCodeLocation);
+    sourceCodeLocation = 0;
+
+    switch (Memory::get_type(this)) {
+    case Lisp_Object_Type::HashMap: {
         this->value.hashMap.~Hash_Map();
+    } break;
+    case Lisp_Object_Type::CFunction: {
+        this->value.cFunction->args.positional.symbols.~Array_List();
+        this->value.cFunction->args.keyword.keywords.~Array_List();
+        this->value.cFunction->args.keyword.values.~Array_List();
+        delete this->value.cFunction;
+    } break;
+    case Lisp_Object_Type::Function:{
+        this->value.function->args.positional.symbols.~Array_List();
+        this->value.function->args.keyword.keywords.~Array_List();
+        this->value.function->args.keyword.values.~Array_List();
+        delete this->value.function;
+    } break;
+    default: break;
     }
 }

src/main.cpp

@@ -1,13 +1,14 @@
 #include "libslime.cpp"
 
-
 int main(int argc, char* argv[]) {
     if (argc > 1) {
         if (Slime::string_equal(argv[1], "--run-tests")) {
             int res = Slime::run_all_tests();
+            Slime::Memory::free_everything();
             // Slime::interprete_file((char*)"generate-docs.slime");
-
+#ifdef _MSC_VER
             _CrtDumpMemoryLeaks();
+#endif
             return res ? 0 : 1;
         }
 

src/memory.cpp

@@ -11,12 +11,12 @@ namespace Memory {
     // ------------------
     //   lisp_objects
     // ------------------
-    Bucket_Allocator<Lisp_Object, 1024> object_memory;
+    Bucket_Allocator<Lisp_Object> object_memory(1024, 8);
 
     // ------------------
     //   environments
     // ------------------
-    Bucket_Allocator<Environment, 1024> environment_memory;
+    Bucket_Allocator<Environment> environment_memory(1024, 8);
 
     // ------------------
     //   strings
@@ -146,6 +146,12 @@ namespace Memory {
 
     proc free_everything() -> void {
         free(string_memory);
+        object_memory.for_each([](Lisp_Object* lo){
+            lo->~Lisp_Object();
+        });
+        environment_memory.for_each([](Environment* env){
+            env->~Environment();
+        });
     }
 
     proc init(int sms) -> void {
@@ -183,18 +189,24 @@ namespace Memory {
         global_keyword_table.~Hash_Map();
         file_to_env_map.~Hash_Map();
 
-        ::new(&global_symbol_table)  Hash_Map<char*, Lisp_Object*>;
-        ::new(&global_keyword_table) Hash_Map<char*, Lisp_Object*>;
-        ::new(&file_to_env_map)      Hash_Map<char*, Lisp_Object*>;
+        new(&global_symbol_table)  Hash_Map<char*, Lisp_Object*>;
+        new(&global_keyword_table) Hash_Map<char*, Lisp_Object*>;
+        new(&file_to_env_map)      Hash_Map<char*, Lisp_Object*>;
 
         try_void Parser::standard_in = create_string("stdin");
 
+        object_memory.for_each([](Lisp_Object* lo){
+            lo->~Lisp_Object();
+        });
+        environment_memory.for_each([](Environment* env){
+            env->~Environment();
+        });
 
         object_memory.~Bucket_Allocator();
-        // environment_memory.~Bucket_Allocator();
+        environment_memory.~Bucket_Allocator();
 
-        ::new(&object_memory)      Bucket_Allocator<Lisp_Object, 1024>;
-        ::new(&environment_memory) Bucket_Allocator<Environment, 1024>;
+        ::new(&object_memory)      Bucket_Allocator<Lisp_Object>(1024, 8);
+        ::new(&environment_memory) Bucket_Allocator<Environment>(1024, 8);
 
         next_free_spot_in_string_memory  = string_memory;
 
@@ -342,16 +354,20 @@ namespace Memory {
         Lisp_Object* node;
         try node = create_lisp_object();
         set_type(node, Lisp_Object_Type::CFunction);
-        // node->value.lambdaWrapper = new Lambda_Wrapper(function);
-        node->value.cFunction = new(cFunction);
-        node->value.cFunction->args = {};
-        new((&node->value.cFunction->args.positional.symbols)) Array_List<Environment*>(16);
-        new((&node->value.cFunction->args.keyword.keywords))   Array_List<Environment*>(16);
-        new((&node->value.cFunction->args.keyword.values))     Array_List<Environment*>(16);
+        node->value.cFunction = new cFunction;
         node->value.cFunction->is_special_form = is_special;
         return node;
     }
 
+    proc create_lisp_object_function(Function_Type ft) -> Lisp_Object* {
+        Lisp_Object* func;
+        try func = Memory::create_lisp_object();
+        Memory::set_type(func, Lisp_Object_Type::Function);
+        func->value.function = new Function;
+        func->value.function->type = ft;
+        return func;
+    }
+
     proc create_lisp_object_pair(Lisp_Object* first, Lisp_Object* rest) -> Lisp_Object* {
         Lisp_Object* node;
         try node = create_lisp_object();
@@ -368,7 +384,9 @@ namespace Memory {
         // we don't copy singleton objects
         if (n == Memory::nil || n == Memory::t ||
             Memory::get_type(n) == Lisp_Object_Type::Symbol ||
-            Memory::get_type(n) == Lisp_Object_Type::Keyword)
+            Memory::get_type(n) == Lisp_Object_Type::Keyword ||
+            Memory::get_type(n) == Lisp_Object_Type::Function ||
+            Memory::get_type(n) == Lisp_Object_Type::CFunction)
         {
             return n;
         }
@@ -376,6 +394,7 @@ namespace Memory {
         Lisp_Object* target;
         try target = create_lisp_object();
         *target = *n;
+
         return target;
     }
 

src/parse.cpp

@@ -31,7 +31,7 @@ namespace Parser {
     }
 
     proc inject_scl(Lisp_Object* lo) -> void {
-        lo->sourceCodeLocation = new(Source_Code_Location);
+        lo->sourceCodeLocation = (Source_Code_Location*)malloc(sizeof(Source_Code_Location));
         lo->sourceCodeLocation->file   = parser_file;
         lo->sourceCodeLocation->line   = parser_line;
         lo->sourceCodeLocation->column = parser_col;
@@ -65,7 +65,6 @@ namespace Parser {
             ++parser_col;
             ++(*index_in_text);
         }
-
     }
 
     proc eat_until_code(char* text, int* index_in_text) -> void {
@@ -120,7 +119,7 @@ namespace Parser {
         Lisp_Object* ret;
         try ret = Memory::create_lisp_object_number(number);
 
-        inject_scl(ret);
+        // inject_scl(ret);
         return ret;
     }
 
@@ -132,7 +131,7 @@ namespace Parser {
         Lisp_Object* ret;
         try ret = Memory::get_or_create_lisp_object_keyword(str_keyword);
 
-        inject_scl(ret);
+        // inject_scl(ret);
         return ret;
     }
 
@@ -142,7 +141,7 @@ namespace Parser {
         Lisp_Object* ret;
         try ret = Memory::get_or_create_lisp_object_symbol(str_symbol);
 
-        inject_scl(ret);
+        // inject_scl(ret);
         return ret;
     }
 
@@ -157,7 +156,7 @@ namespace Parser {
             Lisp_Object* ret;
             try ret = Memory::create_lisp_object_string(
                 Memory::create_string("", 0));
-            inject_scl(ret);
+            // inject_scl(ret);
 
             // plus one because we want to go after the quotes
             *index_in_text += 1;
@@ -169,10 +168,10 @@ namespace Parser {
         // okay so the first letter was not actually closing the string...
         int string_length = 0;
         bool escaping = false;
-        while (!(text[*index_in_text+string_length] == '"' && !escaping))
-        {
-            if (escaping)
+        while (escaping || text[*index_in_text+string_length] != '"') {
+            if (escaping) {
                 escaping = false;
+            }
             else
                 if (text[*index_in_text+string_length] == '\\')
                     escaping = true;
@@ -186,9 +185,10 @@ namespace Parser {
         // NOTE(Felix): Tactic: Through unescaping the string will
         // only get shorter, so we replace it inplace and later jump
         // to the original end of the string.
-        try unescape_string(text+(*index_in_text));
+        int new_len;
+        try new_len = unescape_string(text+(*index_in_text));
 
-        String* string = Memory::create_string("", string_length);
+        String* string = Memory::create_string("", new_len);
 
         // TODO(Felix): manually copy to parse control sequences
         // correctly without the need to unescape the string, also
@@ -196,6 +196,7 @@ namespace Parser {
         // characters since last new line so we can update the parser
         // location more easily
         strcpy(&string->data, text+(*index_in_text));
+        // printf("------ %s\n", &string->data);
 
         text[*index_in_text+string_length] = '"';
 
@@ -218,7 +219,7 @@ namespace Parser {
         Lisp_Object* ret;
         try ret = Memory::create_lisp_object_string(string);
 
-        inject_scl(ret);
+        // inject_scl(ret);
         return ret;
     }
 
@@ -285,7 +286,8 @@ namespace Parser {
                 try ret = Memory::create_list(Memory::get_or_create_lisp_object_symbol("unquote-splicing"), result);
             }
 
-            if (ret) inject_scl(ret);
+            // if (ret && ret != Memory::nil && ret != Memory::t)
+                // inject_scl(ret);
 
             return ret;
         }
@@ -313,7 +315,7 @@ namespace Parser {
         Lisp_Object* expression = head;
 
         while (true) {
-            inject_scl(head);
+            // inject_scl(head);
             if (text[*index_in_text] == '(' ||
                 text[*index_in_text] == '\''||
                 text[*index_in_text] == '`' ||
@@ -363,6 +365,7 @@ namespace Parser {
             } else {
                 try head->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
                 head = head->value.pair.rest;
+                // inject_scl(head);
             }
         }
         return expression;

src/structs.cpp

@@ -118,7 +118,7 @@ struct Function {
 };
 
 struct cFunction {
-    std::function<Lisp_Object* ()> body;
+    Lisp_Object* (*body)();
     Arguments args;
     bool is_special_form;
 };
@@ -134,7 +134,7 @@ struct Lisp_Object {
         String*             string;
         Pair                pair;
         Vector              vector;
-        Function            function;
+        Function*           function;
         cFunction*          cFunction;
         void*               pointer;
         Continuation        continuation;

src/testing.cpp

@@ -656,7 +656,7 @@ proc run_all_tests() -> bool {
     invoke_test_script("hashmaps");
     invoke_test_script("singular_imports");
 
-    // Memory::print_status();
+    // // Memory::print_status();
 
     return result;
 }