From 8dbff42bdfbb7adf401b4928c34eb6b4431fd166 Mon Sep 17 00:00:00 2001 From: Felix Brendel Date: Sun, 10 Nov 2019 15:29:21 +0100 Subject: [PATCH] Cleanup and delete dead code --- bin/pre.slime.expanded | 24 ++++---- bin/tests/class_macro.slime.expanded | 2 +- include/assert.hpp | 46 +++------------ include/define_macros.hpp | 5 +- src/assert.hpp | 46 +++------------ src/built_ins.cpp | 34 +++-------- src/define_macros.hpp | 5 +- src/env.cpp | 22 +++---- src/error.cpp | 86 ++++++++-------------------- src/eval.cpp | 18 +++--- src/io.cpp | 66 ++++++++++----------- src/lisp_object.cpp | 14 +---- src/memory.cpp | 16 ------ src/platform.cpp | 32 +++++++++++ 14 files changed, 156 insertions(+), 260 deletions(-) diff --git a/bin/pre.slime.expanded b/bin/pre.slime.expanded index 1d2ada9..8962548 100644 --- a/bin/pre.slime.expanded +++ b/bin/pre.slime.expanded @@ -4,35 +4,35 @@ (define (hm/get-or-nil hm key) (mytry (hm/get hm key) ())) -(define-syntax (pe expr) (quasiquote (print (quote (unquote expr)) "evaluates to" (unquote expr)))) +(define-syntax (pe expr) `(print ',expr "evaluates to" ,expr)) (define the-empty-stream ()) (define (stream-null? s) (if s t ())) -(define-syntax (delay expr) (quasiquote ((unquote lambda) () (unquote expr)))) +(define-syntax (delay expr) `(,lambda () ,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) ()) (quasiquote (if (unquote condition) (unquote-splicing body) nil)) (quasiquote (if (unquote 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) ()) `(if ,condition @body nil) `(if ,condition (begin @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) ()) (quasiquote (if (unquote condition) nil (unquote-splicing body))) (quasiquote (if (unquote 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) ()) `(if ,condition nil @body) `(if ,condition nil (begin @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)))) (quasiquote (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)))) `(begin @(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)) (quasiquote (((unquote lambda) (unquote (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)) `((,lambda ,(first unzipped) @body) @(first (rest unzipped)))) -(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 (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 @(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 (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 @(rest (first clauses))) ,(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)) (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 (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 (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-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 @arg-names) (assert-types= @lambda-list) @body))) -(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 (define-module module-name (:imports ()) :exports . body) (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) (eval `(begin @(map (lambda (x) `(,import ,x)) imports) @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 (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-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 @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 (null? x) :doc "Checks if the argument is =nil=." (= x ())) diff --git a/bin/tests/class_macro.slime.expanded b/bin/tests/class_macro.slime.expanded index 9d883fd..976cb0b 100644 --- a/bin/tests/class_macro.slime.expanded +++ b/bin/tests/class_macro.slime.expanded @@ -8,7 +8,7 @@ (assert (= (type v1) (type v2) :vector3)) -(assert (= (v1 (quote scalar-product) v2) 10)) +(assert (= (v1 'scalar-product v2) 10)) (assert (-> (-> v1 cross-product v2) equal? (make-vector3 -4 8 -4))) diff --git a/include/assert.hpp b/include/assert.hpp index 3900608..754d421 100644 --- a/include/assert.hpp +++ b/include/assert.hpp @@ -27,43 +27,7 @@ "Type missmatch: expected %s, got %s", \ expected, actual) -#define create_wrong_number_of_arguments_error(expected, actual) \ - __create_error("wrong-number-of-arguments", \ - "Wrong number of arguments: expected %d, got %d", \ - expected, actual) - -#define create_too_many_arguments_error(expected, actual) \ - __create_error("wrong-number-of-arguments", \ - "Wrong number of arguments: expected less or equal to %d, got %d", \ - expected, actual) - -#define create_too_few_arguments_error(expected, actual) \ - __create_error("wrong-number-of-arguments", \ - "Wrong number of arguments: expected greater or equal to %d, got %d", \ - expected, actual) - - -#define assert_arguments_length(expected, actual) \ - do { \ - if (expected != actual) { \ - create_wrong_number_of_arguments_error(expected, actual); \ - } \ - } while(0) - -#define assert_arguments_length_less_equal(expected, actual) \ - do { \ - if (expected < actual) { \ - create_too_many_arguments_error(expected, actual); \ - } \ - } while(0) - -#define assert_arguments_length_greater_equal(expected, actual) \ - do { \ - if (expected > actual) { \ - create_too_few_arguments_error(expected, actual); \ - } \ - } while(0) - +#ifdef _DEBUG #define assert_type(_node, _type) \ do { \ @@ -80,3 +44,11 @@ create_generic_error("Assertion-error."); \ } \ } while(0) + +#else +# define assert_arguments_length(expected, actual) do {} while (0) +# define assert_arguments_length_less_equal(expected, actual) do {} while (0) +# define assert_arguments_length_greater_equal(expected, actual) do {} while (0) +# define assert_type(_node, _type) do {} while (0) +# define assert(condition) do {} while (0) +#endif diff --git a/include/define_macros.hpp b/include/define_macros.hpp index 1428d61..33f1767 100644 --- a/include/define_macros.hpp +++ b/include/define_macros.hpp @@ -22,7 +22,7 @@ } \ } while(0) - +#ifdef _DEBUG #define try_or_else_return(val) \ if (1) \ goto label(body,__LINE__); \ @@ -37,6 +37,9 @@ } \ else label(body,__LINE__): ; +#else +#define try_or_else_return(val) +#endif #define try_struct try_or_else_return({}) #define try_void try_or_else_return() diff --git a/src/assert.hpp b/src/assert.hpp index 3900608..754d421 100644 --- a/src/assert.hpp +++ b/src/assert.hpp @@ -27,43 +27,7 @@ "Type missmatch: expected %s, got %s", \ expected, actual) -#define create_wrong_number_of_arguments_error(expected, actual) \ - __create_error("wrong-number-of-arguments", \ - "Wrong number of arguments: expected %d, got %d", \ - expected, actual) - -#define create_too_many_arguments_error(expected, actual) \ - __create_error("wrong-number-of-arguments", \ - "Wrong number of arguments: expected less or equal to %d, got %d", \ - expected, actual) - -#define create_too_few_arguments_error(expected, actual) \ - __create_error("wrong-number-of-arguments", \ - "Wrong number of arguments: expected greater or equal to %d, got %d", \ - expected, actual) - - -#define assert_arguments_length(expected, actual) \ - do { \ - if (expected != actual) { \ - create_wrong_number_of_arguments_error(expected, actual); \ - } \ - } while(0) - -#define assert_arguments_length_less_equal(expected, actual) \ - do { \ - if (expected < actual) { \ - create_too_many_arguments_error(expected, actual); \ - } \ - } while(0) - -#define assert_arguments_length_greater_equal(expected, actual) \ - do { \ - if (expected > actual) { \ - create_too_few_arguments_error(expected, actual); \ - } \ - } while(0) - +#ifdef _DEBUG #define assert_type(_node, _type) \ do { \ @@ -80,3 +44,11 @@ create_generic_error("Assertion-error."); \ } \ } while(0) + +#else +# define assert_arguments_length(expected, actual) do {} while (0) +# define assert_arguments_length_less_equal(expected, actual) do {} while (0) +# define assert_arguments_length_greater_equal(expected, actual) do {} while (0) +# define assert_type(_node, _type) do {} while (0) +# define assert(condition) do {} while (0) +#endif diff --git a/src/built_ins.cpp b/src/built_ins.cpp index fbdcfd7..bd151cd 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -14,17 +14,15 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool { switch (Memory::get_type(n1)) { - case Lisp_Object_Type::T: // code for t and nil should never be - // reached since they are memory unique + case Lisp_Object_Type::T: case Lisp_Object_Type::Nil: case Lisp_Object_Type::Symbol: case Lisp_Object_Type::Keyword: - case Lisp_Object_Type::CFunction: // if they have the same - // pointer, true is returned a - // few lines above + case Lisp_Object_Type::CFunction: case Lisp_Object_Type::Function: - case Lisp_Object_Type::Pointer: // TODO(Felix): should a pointer - // object compare the pointer? + // TODO(Felix): should a pointer + // object compare the pointer? + case Lisp_Object_Type::Pointer: case Lisp_Object_Type::Continuation: return false; case Lisp_Object_Type::Number: return n1->value.number == n2->value.number; case Lisp_Object_Type::String: return string_equal(n1->value.string, n2->value.string); @@ -48,7 +46,6 @@ proc add_to_load_path(const char* path) -> void { } proc built_in_load(String* file_name) -> Lisp_Object* { - // char* full_file_name = find_slime_file(file_name); char* file_content; char fullpath[4096]; sprintf(fullpath, "%s", Memory::get_c_str(file_name)); @@ -79,9 +76,10 @@ proc built_in_load(String* file_name) -> Lisp_Object* { Array_List* program; try program = Parser::parse_program(Memory::create_string(fullpath), file_content); - for (int i = 0; i < program->next_index; ++i) { - try result = eval_expr(program->data[i]); + for (auto expr : *program) { + try result = eval_expr(expr); } + delete program; free(file_content); @@ -687,22 +685,6 @@ proc load_built_ins_into_environment() -> void { func->value.function->body = maybe_wrap_body_in_begin(body); return func; }; - // define_special((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::Special_Lambda; - - // in_caller_env { - // 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); - // return fun; - // }; define((apply fun args), "TODO") { fetch(fun, args); Lisp_Object* result; diff --git a/src/define_macros.hpp b/src/define_macros.hpp index dcc8ea5..48fcc22 100644 --- a/src/define_macros.hpp +++ b/src/define_macros.hpp @@ -22,7 +22,7 @@ } \ } while(0) - +#ifdef _DEBUG #define try_or_else_return(val) \ if (1) \ goto label(body,__LINE__); \ @@ -37,6 +37,9 @@ } \ else label(body,__LINE__): ; +#else +#define try_or_else_return(val) +#endif #define try_struct try_or_else_return({}) #define try_void try_or_else_return() diff --git a/src/env.cpp b/src/env.cpp index 3794943..f16c363 100644 --- a/src/env.cpp +++ b/src/env.cpp @@ -85,18 +85,18 @@ proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { } -proc print_indent(int indent) -> void { - for (int i = 0; i < indent; ++i) { - printf(" "); - } -} - proc print_environment_indent(Environment* env, int indent) -> void { - // if(env == get_root_environment()) { - // print_indent(indent); - // printf("[built-ins]-Environment (%lld)\n", (long long)env); - // return; - // } + proc print_indent = [](int indent) { + for (int i = 0; i < indent; ++i) { + printf(" "); + } + }; + + if(env == get_root_environment()) { + print_indent(indent); + printf("[built-ins]-Environment (%lld)\n", (long long)env); + return; + } for_hash_map (env->hm) { print_indent(indent); diff --git a/src/error.cpp b/src/error.cpp index 421a496..e98511b 100644 --- a/src/error.cpp +++ b/src/error.cpp @@ -1,44 +1,42 @@ proc delete_error() -> void { using Globals::error; - if (error) { - free(error); - error = nullptr; - } + free(error); + error = nullptr; } proc create_error(const char* c_func_name,const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void { - if (Globals::log_level > Log_Level::None) { - for (int i = 0; i < 10+strlen(Memory::get_c_str(message));++i) - printf("-"); - printf("\n Error - %s\n", Memory::get_c_str(message)); - for (int i = 0; i < 10+strlen(Memory::get_c_str(message));++i) - printf("-"); - - printf("\nin"); - int spacing = 30-((int)strlen(c_file_name) - (int)log10(c_file_line)); - if (spacing < 1) spacing = 1; - for (int i = 0; i < spacing; ++i) - printf(" "); - printf("%s (%d) ", c_file_name, c_file_line); - printf("-> %s\n", c_func_name); - } - delete_error(); if (Globals::breaking_on_errors) { debug_break(); } + + if (Globals::log_level > Log_Level::None) { + // pretty error sign + for (int i = 0; i < 10+strlen(Memory::get_c_str(message));++i) + printf("-"); + printf("\n Error - %s\n", Memory::get_c_str(message)); + for (int i = 0; i < 10+strlen(Memory::get_c_str(message));++i) + printf("-"); + + // c error location + printf("\nin"); + int spacing = 30-((int)strlen(c_file_name) - (int)log10(c_file_line)); + if (spacing < 1) spacing = 1; + for (int i = 0; i < spacing; ++i) + printf(" "); + printf("%s (%d) ", c_file_name, c_file_line); + printf("-> %s\n", c_func_name); + } + // visualize_lisp_machine(); using Globals::error; error = (Error*)malloc(sizeof(Error)) ; error->type = type; error->message = message; - } - proc create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void { - // HACK(Felix): the length of all error strings is 200!!!!!!!!!! using Globals::error; int length = 200; @@ -49,47 +47,13 @@ proc create_error(const char* c_func_name, const char* c_file_name, int c_file_l } int written_length; va_list args; + char* out_msg; va_start(args, format); - written_length = vsnprintf(&formatted_string->data, length, format, args); + written_length = vasprintf(&out_msg, format, args); va_end(args); formatted_string->length = written_length; - + strcpy(&formatted_string->data, out_msg); + free(out_msg); create_error(c_func_name, c_file_name, c_file_line, type, formatted_string); } - -// proc Error_Type_to_string(Error_Type type) -> const char* { -// switch (type) { -// case Error_Type::Assertion_Error: return "Assertion failed"; -// case Error_Type::File_Not_Found: return "File not found"; -// case Error_Type::Ill_Formed_Arguments: return "Evaluation-error: Ill formed arguments"; -// case Error_Type::Ill_Formed_Lambda_List: return "Evaluation-error: Ill formed lambda list"; -// case Error_Type::Ill_Formed_List: return "Evaluation-error: Ill formed list"; -// case Error_Type::Not_A_Function: return "Evaluation-error: Not a function"; -// case Error_Type::Not_Yet_Implemented: return "Evaluation-error: Not yet implemented"; -// case Error_Type::Symbol_Not_Defined: return "Evaluation-error: Symbol not defined"; -// case Error_Type::Syntax_Error: return "Syntax Error"; -// case Error_Type::Trailing_Garbage: return "Evaluation-error: Trailing garbage following expression"; -// case Error_Type::Type_Missmatch: return "Evaluation-error: Type Missmatch"; -// case Error_Type::Unbalanced_Parenthesis: return "Parsing-error: Unbalanced parenthesis"; -// case Error_Type::Unexpected_Eof: return "Parsing-error: Unexpected EOF"; -// case Error_Type::Unknown_Keyword_Argument: return "Evaluation-error: Unknown keyword argument"; -// case Error_Type::Wrong_Number_Of_Arguments: return "Evaluation-error: Wrong number of arguments"; -// case Error_Type::Out_Of_Memory: return "Runtime-error: Out of memory"; -// default: return "this error type doesn't have a desciption.."; -// } -// } - -// proc assert_type(Lisp_Object* node, Lisp_Object_Type type) -> void { -// if (!node) { -// create_generic_error( -// "The node where the type should have" -// "been checked was nullptr."); -// return; -// } - -// if (node->type != type) -// create_type_missmatch_error( -// "" -// ); -// } diff --git a/src/eval.cpp b/src/eval.cpp index 99159b2..7f00359 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -45,7 +45,7 @@ proc create_extended_environment_for_function_application( proc read_positional_args = [&]() -> void { for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) { if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { - create_wrong_number_of_arguments_error(arg_spec->positional.symbols.next_index, i); + create_parsing_error("Wrong number of arguments."); return; } // NOTE(Felix): We have to copy all the arguments, @@ -259,11 +259,7 @@ proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_O result = &function->value.function->args; } - // ::new (&result->positional.symbols) Array_List; - // ::new (&result->keyword.keywords) Array_List; - // ::new (&result->keyword.values) Array_List; - - // first init the fields + // first init the fields result->rest = nullptr; // okay let's try to read some positional arguments @@ -286,9 +282,7 @@ proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_O } // okay we found an actual symbol - append_to_positional_argument_list( - &result->positional, - arguments->value.pair.first); + result->positional.symbols.append(arguments->value.pair.first); arguments = arguments->value.pair.rest; } @@ -299,7 +293,8 @@ proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_O if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) { // if we are on a actual keyword (with no default arg) auto keyword = arguments->value.pair.first; - append_to_keyword_argument_list(&result->keyword, keyword, nullptr); + result->keyword.keywords.append(keyword); + result->keyword.values.append(nullptr); } else if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Pair) { // if we are on a keyword with a default value @@ -318,7 +313,8 @@ proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_O create_parsing_error("Default args must be a list of 2."); } - append_to_keyword_argument_list(&result->keyword, keyword, value); + result->keyword.keywords.append(keyword); + result->keyword.values.append(value); } arguments = arguments->value.pair.rest; } diff --git a/src/io.cpp b/src/io.cpp index d94ed6c..781c7b6 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -260,11 +260,6 @@ proc log_message(Log_Level type, const char* message) -> void { printf("%s: %s\n",prefix, message); } -proc panic(char* message) -> void { - log_message(Log_Level::Critical, message); - exit(1); -} - char* wchar_to_char(const wchar_t* pwchar) { // get the number of characters in the string. int currentCharIndex = 0; @@ -369,37 +364,41 @@ 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"); + auto unquote_splicing_sym = Memory::get_or_create_lisp_object_symbol("unquote-splicing"); + if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym) + { + if (symbol == quote_sym) + putc('\'', file); + else if (symbol == unquote_sym) + putc(',', file); + else if (symbol == unquote_splicing_sym) + putc('@', 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); - // NOTE(Felix): We cuold do a while true here, however in case + // NOTE(Felix): We could do a while true here, however in case // we want to print a broken list (for logging the error) we // should do more checks. while (head) { @@ -458,5 +457,6 @@ proc log_error() -> void { print_call_stack(); puts(console_normal); + // HACK(Felix): we should control the stack size in eval_expr not here Globals::Current_Execution::call_stack.next_index = 0; } diff --git a/src/lisp_object.cpp b/src/lisp_object.cpp index 302da62..efacfa5 100644 --- a/src/lisp_object.cpp +++ b/src/lisp_object.cpp @@ -2,7 +2,7 @@ proc create_source_code_location(String* file, int line, int col) -> Source_Code if (!file) return nullptr; - Source_Code_Location* ret = new(Source_Code_Location); + Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location)); ret->file = file; ret->line = line; ret->column = col; @@ -28,18 +28,6 @@ proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* { return "unknown"; } -proc append_to_positional_argument_list(Positional_Arguments* args, Lisp_Object* sym) -> void { - args->symbols.append(sym); -} - -proc append_to_keyword_argument_list(Keyword_Arguments* args, - Lisp_Object* keyword, - Lisp_Object* default_value) -> void -{ - args->keywords.append(keyword); - args->values.append(default_value); -} - Lisp_Object::~Lisp_Object() { free(sourceCodeLocation); sourceCodeLocation = 0; diff --git a/src/memory.cpp b/src/memory.cpp index 1bb9d77..5f218d4 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -119,22 +119,6 @@ namespace Memory { return create_string(str, (int)strlen(str)); } - // proc create_string_formatted (const char* format, ...) -> String* { - // // HACK(Felix): the length of all strings is 200!!!!!!!!!! - // // HACK(Felix): the length of all strings is 200!!!!!!!!!! - // int length = 200; - // String* ret = create_string("", length); - - // int written_length; - // va_list args; - // va_start(args, format); - // written_length = vsnprintf(&ret->data, length, format, args); - // va_end(args); - - // ret->length = written_length; - // return ret; - // } - proc create_lisp_object() -> Lisp_Object* { Lisp_Object* object = object_memory.allocate(); object->flags = 0; diff --git a/src/platform.cpp b/src/platform.cpp index 70b7da5..8cbd74c 100644 --- a/src/platform.cpp +++ b/src/platform.cpp @@ -19,6 +19,38 @@ inline proc change_cwd(char* dir) -> void { #endif } + +#ifdef _MSC_VER +int vasprintf(char **strp, const char *fmt, va_list ap) { + // _vscprintf tells you how big the buffer needs to be + int len = _vscprintf(fmt, ap); + if (len == -1) { + return -1; + } + size_t size = (size_t)len + 1; + char *str = malloc(size); + if (!str) { + return -1; + } + // _vsprintf_s is the "secure" version of vsprintf + int r = _vsprintf_s(str, len + 1, fmt, ap); + if (r == -1) { + free(str); + return -1; + } + *strp = str; + return r; +} + +int asprintf(char **strp, const char *fmt, ...) { + va_list ap; + va_start(ap, fmt); + int r = vasprintf(strp, fmt, ap); + va_end(ap); + return r; +} +#endif + proc get_exe_dir() -> char* { #ifdef _MSC_VER DWORD last_error;