瀏覽代碼

we have a new parser and can parse [] and {} for vectors and hm's

master
FelixBrendel 6 年之前
父節點
當前提交
72bd30bf4c
共有 13 個檔案被更改,包括 303 行新增74 行删除
  1. +1
    -1
      bin/emoji.slime
  2. +3
    -3
      bin/oo.slime
  3. +14
    -14
      bin/pre.slime
  4. 二進制
     
  5. +3
    -3
      bin/tests/hashmaps.slime
  6. +7
    -1
      build.bat
  7. +10
    -1
      src/built_ins.cpp
  8. +1
    -0
      src/forward_decls.cpp
  9. +1
    -1
      src/io.cpp
  10. +1
    -1
      src/libslime.cpp
  11. +3
    -1
      src/main.cpp
  12. +2
    -2
      src/memory.cpp
  13. +257
    -46
      src/parse2.cpp

+ 1
- 1
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 '😄)


+ 3
- 3
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))

+ 14
- 14
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)))


二進制
查看文件


+ 3
- 3
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)



+ 7
- 1
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 (


+ 10
- 1
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") {


+ 1
- 0
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);
}


+ 1
- 1
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);


+ 1
- 1
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"


+ 3
- 1
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;
}



+ 2
- 2
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;



+ 257
- 46
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<Lisp_Object*>* {
parser_file = file_name;
parser_line = 1;
parser_col = 0;

Array_List<Lisp_Object*>* program = new Array_List<Lisp_Object*>;

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

}

Loading…
取消
儲存