diff --git a/Makefile b/Makefile index 728f3d3c..d5a76608 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ CFLAGS=-I/usr/local/opt/libffi/lib/libffi-3.0.13/include LDFLAGS=-L/usr/local/opt/libffi/lib/ LDLIBS=-lffi -SOURCE_FILES=src/main.c src/obj.c src/gc.c src/obj_string.c src/reader.c src/eval.c src/env.c src/primops.c src/repl.c +SOURCE_FILES=src/main.c src/obj.c src/gc.c src/obj_string.c src/reader.c src/eval.c src/env.c src/primops.c src/repl.c src/obj_array.c all: src/main.o clang $(SOURCE_FILES) -g -O2 -rdynamic -o ./bin/carp-repl -ldl $(CFLAGS) $(LDFLAGS) $(LDLIBS) diff --git a/TODO.md b/TODO.md index e5477099..9d9cecfc 100644 --- a/TODO.md +++ b/TODO.md @@ -29,8 +29,10 @@ # Dynamic Runtime + - make line numbers and position be actually correct + - add one stack frame to the printout that's actually at the location of the error, if possible - call stack isn't properly popped when errors occur inside (load-lisp ...) at startup! - - add array as its own tag for Obj, [] syntax, etc + - print lambdas/ffi with their name if it is set - use [] in parameter list for function definitions - register/register-builtin should use the lisp name, not the C name - jump table in evaluator, use a 'dispatch' member with a label adress in Obj diff --git a/lisp/ast.carp b/lisp/ast.carp index ccf0584e..eedff32a 100644 --- a/lisp/ast.carp +++ b/lisp/ast.carp @@ -12,7 +12,7 @@ (def typevar-counter 0) (defn gen-typevar () - (let (typevar (str "t" typevar-counter)) + (let [typevar (str "t" typevar-counter)] (do (swap! typevar-counter inc) typevar))) @@ -82,12 +82,12 @@ (defn bindings-to-ast (bindings) (match bindings - (name value & rest-bindings) (cons {:node :binding - :type (gen-typevar) - :name name - :value (form-to-ast value)} - (bindings-to-ast rest-bindings)) - _ ())) + [name value & rest-bindings] (cons {:node :binding + :type (gen-typevar) + :name name + :value (form-to-ast value)} + (bindings-to-ast rest-bindings)) + _ ())) (defn let-to-ast (bindings body) {:node :let diff --git a/lisp/core.carp b/lisp/core.carp index 1eeedc91..eb584b7d 100644 --- a/lisp/core.carp +++ b/lisp/core.carp @@ -14,7 +14,7 @@ nil)) (defmacro assert-error (error-code form) - (list 'let (list 'result (list 'catch-error form)) + (list 'let ['result (list 'catch-error form)] (list 'if (list 'nil? 'result) (list 'error (list 'str "No error!\n" (str form) "\n=>\n" 'result)) (list 'if-not (list '= error-code (list :error 'result)) @@ -47,7 +47,7 @@ (dict-set-in! dict key-path (f (get-in dict key-path)))) (defn update-in (dict key-path f) - (let (new (copy dict)) + (let [new (copy dict)] (do (update-in! new key-path f) new))) @@ -191,7 +191,7 @@ (defmacro for (b body) (match b - (sym start limit) (list 'let (list sym start) + (sym start limit) (list 'let [sym start] (list 'while (list '< sym limit) (list 'do body diff --git a/lisp/core_tests.carp b/lisp/core_tests.carp index 022c509d..77598ccb 100644 --- a/lisp/core_tests.carp +++ b/lisp/core_tests.carp @@ -340,6 +340,13 @@ (do (dict-set-in! xs '(1) "hejsan") (assert-eq '(1 "hejsan" 3) xs))))) +(defn test-match-array () + (assert-eq (match [3 4 5] + (x y z) :fail + [a b c] (* a (+ b c)) + _ :also-fail) + 27)) + (defn run-core-tests () (do (test-keyword-in-list-in-match) @@ -380,7 +387,8 @@ (test-intersection) (test-catch-error) (test-for-macro) - (test-match-with-nil) + (test-match-with-nil) + (test-match-array) )) (run-core-tests) diff --git a/lisp/string_array.carp b/lisp/string_array.carp index 877ad5b1..5444c717 100644 --- a/lisp/string_array.carp +++ b/lisp/string_array.carp @@ -137,13 +137,13 @@ (do (assert-eq "yo" (string-array-last s1)))))) (test-string-array-last) -(defn fill-array-recursive [a pos value] +(defn fill-array-recursive (a pos value) (let [count (string-array-count (ref a))] (if (< pos count) (fill-array-recursive (string-array-set a pos value) (+ pos 1) value) a))) -(defn fill-array [a value] +(defn fill-array (a value) (let [count (string-array-count (ref a))] (do (for [i 0 count] (string-array-set a i value)) diff --git a/src/eval.c b/src/eval.c index 75136146..897bbcd9 100644 --- a/src/eval.c +++ b/src/eval.c @@ -133,6 +133,43 @@ bool obj_match_lists(Obj *env, Obj *attempt, Obj *value) { } } +bool obj_match_arrays(Obj *env, Obj *attempt, Obj *value) { + //printf("Matching arrays %s with %s\n", obj_to_string(attempt)->s, obj_to_string(value)->s); + int i; + for(i = 0; i < attempt->count; i++) { + Obj *o = attempt->array[i]; + if(obj_eq(o, ampersand) && ((i + 1) < attempt->count)) { + int rest_count = value->count - i; + //printf("rest_count: %d\n", rest_count); + Obj *rest = obj_new_array(rest_count); + for(int j = 0; j < rest_count; j++) { + rest->array[j] = value->array[i + j]; // copy the rest of the objects to a smaller array + } + //printf("rest: %s\n", obj_to_string(rest)->s); + Obj *symbol_after_ampersand = attempt->array[i + 1]; + //printf("symbol_after_ampersand: %s\n", obj_to_string(symbol_after_ampersand)->s); + bool matched_rest = obj_match(env, symbol_after_ampersand, rest); + //printf("%s\n", matched_rest ? "match" : "no match"); + return matched_rest; + } + else if(i >= value->count) { + return false; + } + bool result = obj_match(env, o, value->array[i]); + if(!result) { + return false; + } + } + if(i < value->count) { + //printf("The value list is too long.\n"); + return false; + } + else { + //printf("Found end of list, it's a match.\n"); + return true; + } +} + bool obj_match(Obj *env, Obj *attempt, Obj *value) { //printf("Matching %s with %s\n", obj_to_string(attempt)->s, obj_to_string(value)->s); @@ -154,6 +191,9 @@ bool obj_match(Obj *env, Obj *attempt, Obj *value) { else if(attempt->tag == 'C' && value->tag == 'C') { return obj_match_lists(env, attempt, value); } + else if(attempt->tag == 'A' && value->tag == 'A') { + return obj_match_arrays(env, attempt, value); + } else if(obj_eq(attempt, value)) { return true; } @@ -409,16 +449,17 @@ void eval_list(Obj *env, Obj *o) { Obj *let_env = obj_new_environment(env); shadow_stack_push(let_env); Obj *p = o->cdr->car; - assert_or_set_error(o->cdr->car, "No bindings in 'let' form.", o); - while(p && p->car) { - if(!p->cdr) { - set_error("Uneven nr of forms in let: ", o); + assert_or_set_error(o->cdr->car, "No bindings in 'let' form: ", o); + assert_or_set_error(o->cdr->car->tag == 'A', "Bindings in 'let' form must be an array: ", o); + Obj *a = o->cdr->car; + for(int i = 0; i < a->count; i += 2) { + if(i + 1 == a->count) { + set_error("Uneven nr of forms in let: ", o); // TODO: add error code for this kind of error, return error map instead } - assert_or_set_error(p->car->tag == 'Y', "Must bind to symbol in let form: ", p->car); - eval_internal(let_env, p->cdr->car); + assert_or_set_error(a->array[i]->tag == 'Y', "Must bind to symbol in let form: ", p->car); + eval_internal(let_env, a->array[i + 1]); if(eval_error) { return; } - env_extend(let_env, p->car, stack_pop()); - p = p->cdr->cdr; + env_extend(let_env, a->array[i], stack_pop()); } assert_or_set_error(o->cdr->cdr->car, "No body in 'let' form.", o); assert_or_set_error(o->cdr->cdr->cdr->car == NULL, "Too many body forms in 'let' form (use explicit 'do').", o); @@ -767,6 +808,16 @@ void eval_internal(Obj *env, Obj *o) { stack_push(new_env); shadow_stack_pop(); // new_env } + else if(o->tag == 'A') { + Obj *new_array = obj_new_array(o->count); + shadow_stack_push(new_array); + for(int i = 0; i < o->count; i++) { + eval_internal(env, o->array[i]); + new_array->array[i] = stack_pop(); + } + stack_push(new_array); + shadow_stack_pop(); // new_array + } else if(o->tag == 'Y') { Obj *result = env_lookup(env, o); if(!result) { diff --git a/src/gc.c b/src/gc.c index d8266ed5..fc9b1886 100644 --- a/src/gc.c +++ b/src/gc.c @@ -17,6 +17,11 @@ void obj_mark_alive(Obj *o) { obj_mark_alive(o->car); obj_mark_alive(o->cdr); } + else if(o->tag == 'A') { + for(int i = 0; i < o->count; i++) { + obj_mark_alive(o->array[i]); + } + } else if(o->tag == 'L' || o->tag == 'M') { obj_mark_alive(o->params); obj_mark_alive(o->body); diff --git a/src/obj.c b/src/obj.c index 7fcbec80..cfa0a911 100644 --- a/src/obj.c +++ b/src/obj.c @@ -133,6 +133,13 @@ Obj *obj_new_char(char b) { return o; } +Obj *obj_new_array(int count) { + Obj *o = obj_new('A'); + o->array = malloc(sizeof(Obj*) * count); + o->count = count; + return o; +} + Obj *obj_copy(Obj *o) { assert(o); if(o->tag == 'C') { @@ -154,6 +161,13 @@ Obj *obj_copy(Obj *o) { } return list; } + else if(o->tag == 'A') { + Obj *copy = obj_new_array(o->count); + for(int i = 0; i < o->count; i++) { + copy->array[i] = obj_copy(o->array[i]); + } + return copy; + } else if(o->tag == 'E') { //printf("Making a copy of the env: %s\n", obj_to_string(o)->s); Obj *new_env = obj_new_environment(NULL); @@ -264,6 +278,19 @@ bool obj_eq(Obj *a, Obj *b) { } } } + else if(a->tag == 'A') { + if(a->count != b->count) { + return false; + } + else { + for(int i = 0; i < a->count; i++) { + if(!obj_eq(a->array[i], b->array[i])) { + return false; + } + } + return true; + } + } else if(a->tag == 'E') { if(!obj_eq(a->parent, b->parent)) { return false; } //printf("WARNING! Can't reliably compare dicts.\n"); diff --git a/src/obj.h b/src/obj.h index 1712f89e..e7d0d48a 100644 --- a/src/obj.h +++ b/src/obj.h @@ -24,7 +24,7 @@ typedef void (*VoidFn)(void); D = Dylib V = Float W = Double (not implemented yet) - A = Array (not implemented yet) + A = Array Q = Void pointer B = Char */ @@ -61,6 +61,10 @@ typedef struct Obj { struct Obj *arg_types; struct Obj *return_type; }; + struct { + struct Obj **array; + int count; + }; // Dylib void *dylib; // Void pointer @@ -95,6 +99,7 @@ Obj *obj_new_lambda(Obj *params, Obj *body, Obj *env, Obj *code); Obj *obj_new_macro(Obj *params, Obj *body, Obj *env, Obj *code); Obj *obj_new_environment(Obj *parent); Obj *obj_new_char(char b); +Obj *obj_new_array(int count); Obj *obj_copy(Obj *o); @@ -139,3 +144,4 @@ Obj *type_float; Obj *type_ptr; Obj *type_ref; Obj *type_char; +Obj *type_array; diff --git a/src/obj_array.c b/src/obj_array.c new file mode 100644 index 00000000..5b7115da --- /dev/null +++ b/src/obj_array.c @@ -0,0 +1,2 @@ +#include "obj_array.h" + diff --git a/src/obj_array.h b/src/obj_array.h new file mode 100644 index 00000000..3f59c932 --- /dev/null +++ b/src/obj_array.h @@ -0,0 +1,2 @@ +#pragma once + diff --git a/src/obj_string.c b/src/obj_string.c index 5253ba91..c8af8804 100644 --- a/src/obj_string.c +++ b/src/obj_string.c @@ -57,6 +57,16 @@ void obj_to_string_internal(Obj *total, const Obj *o, bool prn, int indent) { obj_string_mut_append(total, ")"); x++; } + else if(o->tag == 'A') { + obj_string_mut_append(total, "["); + for(int i = 0; i < o->count; i++) { + obj_to_string_internal(total, o->array[i], true, x); + if(i < o->count - 1) { + obj_string_mut_append(total, " "); + } + } + obj_string_mut_append(total, "]"); + } else if(o->tag == 'E') { obj_string_mut_append(total, "{"); x++; diff --git a/src/primops.c b/src/primops.c index d955deb0..db5bfabb 100644 --- a/src/primops.c +++ b/src/primops.c @@ -881,6 +881,9 @@ Obj *p_type(Obj** args, int arg_count) { else if(args[0]->tag == 'B') { return type_char; } + else if(args[0]->tag == 'A') { + return type_array; + } else { printf("Unknown type tag: %c\n", args[0]->tag); //eval_error = obj_new_string("Unknown type."); diff --git a/src/reader.c b/src/reader.c index 5ac44470..8a3b9bb6 100644 --- a/src/reader.c +++ b/src/reader.c @@ -63,7 +63,7 @@ Obj *read_internal(Obj *env, char *s, Obj *filename) { print_read_pos(); return nil; } - else if(CURRENT == '(' || CURRENT == '[') { + else if(CURRENT == '(') { Obj *list = obj_new_cons(NULL, NULL); obj_set_line_info(list, read_line_nr, read_line_pos, filename); Obj *prev = list; @@ -87,6 +87,37 @@ Obj *read_internal(Obj *env, char *s, Obj *filename) { } return list; } + else if(CURRENT == '[') { + const int max_count = 512; + Obj *temp[max_count]; + int count = 0; + + read_pos++; + while(1) { + skip_whitespace(s); + if(CURRENT == '\0') { + printf("Missing ']' at the end of array.\n"); + print_read_pos(); + return nil; + } + if(CURRENT == ']') { + read_pos++; + break; + } + Obj *o = read_internal(env, s, filename); + temp[count] = o; + count++; + if(count >= max_count) { + eval_error = obj_new_string("Can't read more than 512 values in literal. Please talk to the creator of this language about this."); + } + } + + Obj *new_array = obj_new_array(count); + for(int i = 0; i < count; i++) { + new_array->array[i] = temp[i]; + } + return new_array; + } else if(CURRENT == '{') { Obj *list = obj_new_cons(NULL, NULL); Obj *prev = list; diff --git a/src/repl.c b/src/repl.c index 4c67de79..8913bde5 100644 --- a/src/repl.c +++ b/src/repl.c @@ -118,6 +118,9 @@ void env_new_global() { type_char = obj_new_keyword("char"); define("type-char", type_char); + type_array = obj_new_keyword("array"); + define("type-array", type_array); + register_primop("open", p_open_file); register_primop("save", p_save_file); register_primop("+", p_add);