diff --git a/bin/emoji.slime b/bin/emoji.slime index ace2a65..16cb6f2 100644 --- a/bin/emoji.slime +++ b/bin/emoji.slime @@ -1,7 +1,7 @@ (define-module emoji :exports (get) - (define emoji-map (create-hash-map)) + (define emoji-map (hash-map)) (hm/set! emoji-map :grinning-face '😀) (hm/set! emoji-map :grinning-face-with-big-eyes '😃) (hm/set! emoji-map :grinning-face-with-smiling-eyes '😄) diff --git a/bin/oo.slime b/bin/oo.slime index c35b866..d122bd9 100644 --- a/bin/oo.slime +++ b/bin/oo.slime @@ -5,11 +5,11 @@ `(set-type! (define ;; The function definition - (,(string->symbol (concat-strings "make-" (symbol->string name))) @members) + (,(string->symbol (concat-strings "make-" (symbol->string name))) ,@members) ;; The docstring ,(concat-strings "This is the handle to an object of the class " (symbol->string name)) ;; the body - @body + ,@body (let ,(zip members members) (set-type! (lambda args @@ -22,4 +22,4 @@ :constructor))) (define-syntax (-> obj meth . args) - `(,obj ',meth @args)) + `(,obj ',meth ,@args)) diff --git a/bin/pre.slime b/bin/pre.slime index 7c94752..7ac5e01 100644 --- a/bin/pre.slime +++ b/bin/pre.slime @@ -33,22 +33,22 @@ condition is true. {{{example_end}}} " (if (= (rest body) ()) - `(if ,condition @body nil) - `(if ,condition (begin @body) nil))) + `(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 condition is false." (if (= (rest body) ()) - `(if ,condition nil @body) - `(if ,condition nil (begin @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)))) - `(begin @(repeat times action))) + `(begin ,@(repeat times action))) (define-syntax (let bindings . body) (define (unzip lists) @@ -64,7 +64,7 @@ condition is false." (define unzipped (unzip bindings)) - `((,lambda ,(first unzipped) @body) @(first (rest unzipped)))) + `((,lambda ,(first unzipped) ,@body) ,@(first (rest unzipped)))) (define-syntax (cond . clauses) (define (rec clauses) @@ -76,7 +76,7 @@ condition is false." (error :syntax-error "There are additional clauses after the else clause!") (pair 'begin (rest (first clauses))))) `(if ,(first (first clauses)) - (begin @(rest (first clauses))) + (begin ,@(rest (first clauses))) ,(rec (rest clauses)))))) (rec clauses)) @@ -91,7 +91,7 @@ condition is false." (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))) + (begin ,@(rest (first clauses))) ,(rec (rest clauses)))))) (rec clauses)) @@ -149,14 +149,14 @@ condition is false." (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 (,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 `(begin @(map (lambda (x) `(,import ,x)) imports) @body)) + (eval `(begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body)) (pair 'begin (map (lambda (orig-export-name) (let ((export-name (string->symbol @@ -189,8 +189,8 @@ condition is false." (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))) + (define generic-map-name (hash-map))) + (hm/set! generic-map-name types (eval `(,lambda ,names ,@body))) ;; now check if the generic procedure already exists (if (bound? fun-name) (let ((exisiting-fun (eval fun-name))) diff --git a/bin/slime.rdbg b/bin/slime.rdbg index 84ccd66..6c57b4c 100644 Binary files a/bin/slime.rdbg and b/bin/slime.rdbg differ diff --git a/bin/tests/hashmaps.slime b/bin/tests/hashmaps.slime index 8b45882..e548c5f 100644 --- a/bin/tests/hashmaps.slime +++ b/bin/tests/hashmaps.slime @@ -1,12 +1,12 @@ -(define hm1 (create-hash-map)) +(define hm1 (hash-map)) (hm/set! hm1 1 "a") (hm/set! hm1 "a" (lambda (x) (+ x 1))) (assert (= ((hm/get hm1 (hm/get hm1 1)) 2) 3)) -(define hm2 (create-hash-map)) +(define hm2 (hash-map)) (hm/set! hm2 'yes :yes) (hm/set! hm2 :yes 'yes) @@ -17,7 +17,7 @@ (assert (= (hm/get hm2 (hm/get hm2 (hm/get hm2 'yes))) :yes)) (assert (= (hm/get hm2 (hm/get hm2 (hm/get hm2 :yes))) 'yes)) -(define hm3 (create-hash-map)) +(define hm3 (hash-map)) (hm/set! hm3 + 'plus) (hm/set! hm3 - 'minus) diff --git a/build.bat b/build.bat index 9ce9d43..ccba429 100644 --- a/build.bat +++ b/build.bat @@ -10,9 +10,15 @@ echo ---------- Compiling ---------- call ..\timecmd cl ^ ../src/main.cpp^ /I../3rd/ ^ - /D_PROFILING /D_DEBUG /D_DONT_BREAK_ON_ERRORS ^ + /D_PROFILING /D_DEBUG ^ /Zi /std:c++latest /Fe%exeName% /W3 /wd4003 /nologo /EHsc +rem call ..\timecmd cl ^ + rem ../src/main.cpp^ + rem /I../3rd/ ^ + rem /O2 /D_DONT_BREAK_ON_ERRORS ^ + rem /std:c++latest /Fe%exeName% /W3 /wd4003 /nologo /EHsc + rem call ..\timecmd clang-cl ../src/main.cpp -o %exeName% /O2 /std:c++latest /W3 /Zi /EHsc if %errorlevel% == 0 ( diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 7a253b0..36395a2 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -77,6 +77,8 @@ proc built_in_load(String* file_name) -> Lisp_Object* { try program = Parser::parse_program(Memory::create_string(fullpath), file_content); for (auto expr : *program) { + // print(expr); + // puts(""); try result = eval_expr(expr); } @@ -717,9 +719,16 @@ proc load_built_ins_into_environment() -> void* { fetch(args); return args; }; - define((create-hash-map), "TODO") { + define((hash-map . args), "TODO") { + fetch(args); Lisp_Object* ret; try ret = Memory::create_lisp_object_hash_map(); + for_lisp_list (args) { + try assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); + head = head->value.pair.rest; + ret->value.hashMap->set_object(it, head->value.pair.first); + } + return ret; }; define((hash-map-get hm key), "TODO") { diff --git a/src/forward_decls.cpp b/src/forward_decls.cpp index e643f2b..6a41b3c 100644 --- a/src/forward_decls.cpp +++ b/src/forward_decls.cpp @@ -66,6 +66,7 @@ namespace Parser { extern int parser_line; extern int parser_col; + Lisp_Object* parse_expression(char* text, int* index_in_text); Lisp_Object* parse_single_expression(char* text); Lisp_Object* parse_single_expression(wchar_t* text); } diff --git a/src/io.cpp b/src/io.cpp index 97054f7..5847ecc 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -380,7 +380,7 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void { else if (symbol == unquote_sym) putc(',', file); else if (symbol == unquote_splicing_sym) - putc('@', file); + fputs(",@", file); assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); assert(head->value.pair.rest->value.pair.rest == Memory::nil); diff --git a/src/libslime.cpp b/src/libslime.cpp index 4e69e72..2e514be 100644 --- a/src/libslime.cpp +++ b/src/libslime.cpp @@ -115,7 +115,7 @@ namespace Slime { # include "error.cpp" # include "io.cpp" # include "env.cpp" -# include "parse.cpp" +# include "parse2.cpp" # include "eval.cpp" # include "visualization.cpp" # include "docgeneration.cpp" diff --git a/src/main.cpp b/src/main.cpp index e65672d..8618219 100644 --- a/src/main.cpp +++ b/src/main.cpp @@ -5,7 +5,9 @@ int main(int argc, char* argv[]) { if (Slime::string_equal(argv[1], "--run-tests")) { int res = Slime::run_all_tests(); Slime::built_in_load(Slime::Memory::create_string("generate-docs.slime")); - Slime::Memory::free_everything(); + if_debug { + Slime::Memory::free_everything(); + } return res ? 0 : 1; } diff --git a/src/memory.cpp b/src/memory.cpp index 2a079a1..bb327d6 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -162,12 +162,12 @@ namespace Memory { proc init(int sms) -> void { char* exe_path = get_exe_dir(); - defer {free(exe_path);}; + // don't free exe path because it will be used until end of time add_to_load_path(exe_path); add_to_load_path("../bin/"); string_memory_size = sms; - string_memory = (String*)malloc(string_memory_size * sizeof(char)); + string_memory = (String*)malloc(string_memory_size * sizeof(char)); next_free_spot_in_string_memory = string_memory; diff --git a/src/parse2.cpp b/src/parse2.cpp index 4aa0e76..a9f72bc 100644 --- a/src/parse2.cpp +++ b/src/parse2.cpp @@ -1,5 +1,8 @@ namespace Parser { - + String* standard_in; + String* parser_file; + int parser_line; + int parser_col; proc eat_comment_line(char* text, int* index_in_text) -> void { // safety check if we are actually starting a comment here @@ -15,6 +18,17 @@ namespace Parser { text[(*index_in_text)] != '\0'); } + proc step_char(char* text, int* index_in_text, int steps = 1) { + for (int i = 0; i < steps; ++i) { + if (text[(*index_in_text)] == '\n') { + ++parser_line; + parser_col = 0; + } + ++parser_col; + ++(*index_in_text); + } + } + proc eat_whitespace(char* text, int* index_in_text) -> void { // skip whitespaces while (text[(*index_in_text)] == ' ' || @@ -22,12 +36,7 @@ namespace Parser { text[(*index_in_text)] == '\n' || text[(*index_in_text)] == '\r') { - if (text[(*index_in_text)] == '\n') { - ++parser_line; - parser_col = 0; - } - ++parser_col; - ++(*index_in_text); + step_char(text, index_in_text); } } @@ -40,13 +49,8 @@ namespace Parser { } while (position_before != *index_in_text); } - proc step_char(int* index_in_text) { - ++(*index_in_text); - ++parser_col; - } - proc step_char_and_eat_until_code(char* text, int* index_in_text) { - step_char(index_in_text); + step_char(text, index_in_text); eat_until_code(text, index_in_text); } @@ -56,57 +60,225 @@ namespace Parser { return nullptr; } - Lisp_Objcet* ret; - Lisp_Objcet* head; + Lisp_Object* ret; + Lisp_Object* head; try ret = Memory::create_lisp_object_pair(first_elem, Memory::nil); head = ret; - step_char(index_in_text); + step_char(text, index_in_text); + eat_until_code(text, index_in_text); while (text[*index_in_text] != r_delimiter) { - eat_until_code(text, index_in_text); Lisp_Object* element; try element = parse_expression(text, index_in_text); - try head.value.pair.rest = Memory::create_lisp_object_pair(element, Memory::nil); - head = head.value.pair.rest; + try head->value.pair.rest = Memory::create_lisp_object_pair(element, Memory::nil); + head = head->value.pair.rest; + eat_until_code(text, index_in_text); + } + + step_char(text, index_in_text); + + return ret; + } + + proc get_atom_text_length(char* text, int* index_in_text) -> int { + int atom_length = 0; + while (text[*index_in_text+atom_length] != ' ' && + text[*index_in_text+atom_length] != ')' && + text[*index_in_text+atom_length] != '(' && + text[*index_in_text+atom_length] != '[' && + text[*index_in_text+atom_length] != ']' && + text[*index_in_text+atom_length] != '{' && + text[*index_in_text+atom_length] != '}' && + text[*index_in_text+atom_length] != '\0' && + text[*index_in_text+atom_length] != '\n' && + text[*index_in_text+atom_length] != '\r' && + text[*index_in_text+atom_length] != '\t') + { + ++atom_length; + } + return atom_length; + } + + proc parse_number(char* text, int* index_in_text) -> Lisp_Object* { + Lisp_Object* ret; + try ret = Memory::create_lisp_object_number(0); + + sscanf(text+*index_in_text, "%lf", &ret->value.number); + + int atom_length = get_atom_text_length(text, index_in_text); + step_char(text, index_in_text, atom_length); + + return ret; + } + + proc parse_symbol_or_keyword(char* text, int* index_in_text) -> Lisp_Object* { + bool keyword = false; + if (text[*index_in_text] == ':') { + keyword = true; + step_char(text, index_in_text); + } + + int atom_length = get_atom_text_length(text, index_in_text); + char orig = text[*index_in_text+atom_length]; + text[*index_in_text+atom_length] = '\0'; + + + String* str_keyword; + Lisp_Object* ret; + try str_keyword = Memory::create_string("", atom_length); + strcpy(&str_keyword->data, text+*index_in_text); + + if (keyword) { + try ret = Memory::get_or_create_lisp_object_keyword(str_keyword); + } else { + try ret = Memory::get_or_create_lisp_object_symbol(str_keyword); } - ++*index_in_text; + + text[*index_in_text+atom_length] = orig; + step_char(text, index_in_text, atom_length); return ret; } + proc parse_string(char* text, int* index_in_text) -> Lisp_Object* { + // the first character is the '"' + step_char(text, index_in_text); + + // now we are at the first letter, if this is the closing '"' then + // it's easy + if (text[*index_in_text] == '"') { + Lisp_Object* ret; + try ret = Memory::create_lisp_object_string( + Memory::create_string("", 0)); + // inject_scl(ret); + + // plus one because we want to go after the quotes + step_char(text, index_in_text); + + return ret; + } + + // okay so the first letter was not actually closing the string... + int string_length = 0; + bool escaping = false; + while (escaping || text[*index_in_text+string_length] != '"') { + if (escaping) { + escaping = false; + } + else + if (text[*index_in_text+string_length] == '\\') + escaping = true; + + ++string_length; + } + + // we found the end of the string + text[*index_in_text+string_length] = '\0'; + + // 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. + int new_len; + try new_len = unescape_string(text+(*index_in_text)); + + String* string = Memory::create_string("", new_len); + + strcpy(&string->data, text+(*index_in_text)); + // printf("------ %s\n", &string->data); + + text[*index_in_text+string_length] = '"'; + + // plus one because we want to go after the quotes + step_char(text, index_in_text, string_length+1); + + Lisp_Object* ret; + try ret = Memory::create_lisp_object_string(string); + + // inject_scl(ret); + return ret; + } + + proc parse_atom(char* text, int* index_in_text) -> Lisp_Object* { + Lisp_Object* ret; + // numbers + if ((text[*index_in_text] <= 57 && // if number + text[*index_in_text] >= 48) + || + ((text[*index_in_text] == '+' || // or if sign and then number + text[*index_in_text] == '-') + && + (text[*index_in_text +1] <= 57 && + text[*index_in_text +1] >= 48)) + || + ((text[*index_in_text] == '.') // or if . and then number + && + (text[*index_in_text +1] <= 57 && + text[*index_in_text +1] >= 48))) + { + try ret = parse_number(text, index_in_text); + } + + else if (text[*index_in_text] == '"') + try ret = parse_string(text, index_in_text); + else + try ret = parse_symbol_or_keyword(text, index_in_text); + + return ret; + } + + + proc parse_list(char* text, int* index_in_text) -> Lisp_Object* { if (text[*index_in_text] != '(') { create_parsing_error("a list cannot be parsed here"); return nullptr; } - step_char_and_eat_until_code(); + step_char_and_eat_until_code(text, index_in_text); if (text[*index_in_text] == ')') { - return meory::nil; + step_char(text, index_in_text); + return Memory::nil; } Lisp_Object* first_elem; - Lisp_Objcet* ret; - Lisp_Objcet* head; + Lisp_Object* ret; + Lisp_Object* head; + - - try first_elem = parse_epression(text, index_in_text); + try first_elem = parse_expression(text, index_in_text); try ret = Memory::create_lisp_object_pair(first_elem, Memory::nil); head = ret; - while (text[*index_in_text] != r_delimiter) { - eat_until_code(text, index_in_text); + eat_until_code(text, index_in_text); + while (text[*index_in_text] != ')') { Lisp_Object* element; - try element = parse_expression(text, index_in_text); - try head.value.pair.rest = Memory::create_lisp_object_pair(element, Memory::nil); - head = head.value.pair.rest; - } + if (text[*index_in_text+0] == '.' && + text[*index_in_text+1] == ' ') + { + step_char(text, index_in_text, 2); + try element = parse_expression(text, index_in_text); + head->value.pair.rest = element; + eat_until_code(text, index_in_text); + if (text[*index_in_text] != ')') { + create_parsing_error("expected the list to end after the dotted end."); + return nullptr; + } + step_char(text, index_in_text); + return ret; + } + try element = parse_expression(text, index_in_text); + try head->value.pair.rest = Memory::create_lisp_object_pair(element, Memory::nil); + head = head->value.pair.rest; + eat_until_code(text, index_in_text); + } + step_char(text, index_in_text); + return ret; } proc maybe_expand_short_form(char* text, int* index_in_text) -> Lisp_Object* { @@ -118,34 +290,37 @@ namespace Parser { 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"); - Lisp_Object* ret; + Lisp_Object* ret = nullptr; Lisp_Object* expr; switch (text[*index_in_text]) { case '\'': { // quote step_char_and_eat_until_code(text, index_in_text); - expr = parse_expresion(text, index_in_text); - try ret = Memory::create_lisp_object_pair(quote_sym, expr); + try expr = parse_expression(text, index_in_text); + try ret = Memory::create_lisp_object_pair(expr, Memory::nil); + try ret = Memory::create_lisp_object_pair(quote_sym, ret); } break; case '`': { // quasiquote step_char_and_eat_until_code(text, index_in_text); - expr = parse_expresion(text, index_in_text); - try ret = Memory::create_lisp_object_pair(quasiquote_sym, expr); + try expr = parse_expression(text, index_in_text); + try ret = Memory::create_lisp_object_pair(expr, Memory::nil); + try ret = Memory::create_lisp_object_pair(quasiquote_sym, ret); } break; case ',': { - if (text[*index_in_text+1] == '@') { + step_char_and_eat_until_code(text, index_in_text); + if (text[*index_in_text] == '@') { // unquote-splicing - step_char(text, index_in_text); - step_char_and_eat_until_code(itext, index_in_text); - expr = parse_expresion(text, index_in_text); - try ret = Memory::create_lisp_object_pair(unquote_splicing_sym, expr); + step_char_and_eat_until_code(text, index_in_text); + try expr = parse_expression(text, index_in_text); + try ret = Memory::create_lisp_object_pair(expr, Memory::nil); + try ret = Memory::create_lisp_object_pair(unquote_splicing_sym, ret); } else { // unquote - expr = parse_expresion(text, index_in_text); - try ret = Memory::create_lisp_object_pair(unquote_sym, expr); - step_char_and_eat_until_code(text, index_in_text); + try expr = parse_expression(text, index_in_text); + try ret = Memory::create_lisp_object_pair(expr, Memory::nil); + try ret = Memory::create_lisp_object_pair(unquote_sym, ret); } } break; case '[': { @@ -155,7 +330,6 @@ namespace Parser { case '{': { // hashmap try ret = parse_fancy_delimiter(text, index_in_text, '{', '}', hash_map_sym); - try parse_hash_map(text, index_in_text); } break; default: break; } @@ -165,13 +339,50 @@ namespace Parser { proc parse_expression(char* text, int* index_in_text) -> Lisp_Object* { Lisp_Object* ret; + eat_until_code(text, index_in_text); try ret = maybe_expand_short_form(text, index_in_text); if (ret) return ret; if (text[*index_in_text] == '(') { try ret = parse_list(text, index_in_text); + } else { + try ret = parse_atom(text, index_in_text); } + return ret; } + + + proc parse_single_expression(char* text) -> Lisp_Object* { + parser_file = standard_in; + parser_line = 1; + parser_col = 1; + + int index_in_text = 0; + Lisp_Object* ret; + try ret = parse_expression(text, &index_in_text); + return ret; + } + + + proc parse_program(String* file_name, char* text) -> Array_List* { + parser_file = file_name; + parser_line = 1; + parser_col = 0; + + Array_List* program = new Array_List; + + int index_in_text = 0; + Lisp_Object* parsed; + + eat_until_code(text, &index_in_text); + while (text[index_in_text] != '\0') { + try parsed = parse_expression(text, &index_in_text); + program->append(parsed); + eat_until_code(text, &index_in_text); + } + return program; + } + }