felix
/
slime
1
0
Fork 0
Koodi Ongelmat 0 Pull-pyynnöt 0 Julkaisut 0 Wiki Toiminta
Selaa lähdekoodia

Cleanup and delete dead code

master
Felix Brendel 6 vuotta sitten
vanhempi
bb1cfcd3c3
commit
8dbff42bdf
14 muutettua tiedostoa jossa 156 lisäystä ja 260 poistoa
Jaettu näkymä
Diff Options
Show Stats Download Patch File Download Diff File
  1. +12
    -12
      bin/pre.slime.expanded
  2. +1
    -1
      bin/tests/class_macro.slime.expanded
  3. +9
    -37
      include/assert.hpp
  4. +4
    -1
      include/define_macros.hpp
  5. +9
    -37
      src/assert.hpp
  6. +8
    -26
      src/built_ins.cpp
  7. +4
    -1
      src/define_macros.hpp
  8. +11
    -11
      src/env.cpp
  9. +25
    -61
      src/error.cpp
  10. +7
    -11
      src/eval.cpp
  11. +33
    -33
      src/io.cpp
  12. +1
    -13
      src/lisp_object.cpp
  13. +0
    -16
      src/memory.cpp
  14. +32
    -0
      src/platform.cpp

+ 12
- 12
bin/pre.slime.expanded Näytä tiedosto

@@ -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 ()))



+ 1
- 1
bin/tests/class_macro.slime.expanded Näytä tiedosto

@@ -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)))


+ 9
- 37
include/assert.hpp Näytä tiedosto

@@ -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

+ 4
- 1
include/define_macros.hpp Näytä tiedosto

@@ -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()


+ 9
- 37
src/assert.hpp Näytä tiedosto

@@ -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

+ 8
- 26
src/built_ins.cpp Näytä tiedosto

@@ -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<Lisp_Object*>* 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;


+ 4
- 1
src/define_macros.hpp Näytä tiedosto

@@ -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()


+ 11
- 11
src/env.cpp Näytä tiedosto

@@ -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);


+ 25
- 61
src/error.cpp Näytä tiedosto

@@ -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(
// ""
// );
// }

+ 7
- 11
src/eval.cpp Näytä tiedosto

@@ -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<Lisp_Object*>;
// ::new (&result->keyword.keywords) Array_List<Lisp_Object*>;
// ::new (&result->keyword.values) Array_List<Lisp_Object*>;

// 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;
}


+ 33
- 33
src/io.cpp Näytä tiedosto

@@ -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;
}

+ 1
- 13
src/lisp_object.cpp Näytä tiedosto

@@ -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;


+ 0
- 16
src/memory.cpp Näytä tiedosto

@@ -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;


+ 32
- 0
src/platform.cpp Näytä tiedosto

@@ -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;


Kirjoita Esikatselu
Ladataan…
Peruuta
Tallenna