added arrays

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)

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

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

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

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)

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

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

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

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

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;

src/obj_array.c

@@ -0,0 +1,2 @@
+#include "obj_array.h"
+

src/obj_array.h

@@ -0,0 +1,2 @@
+#pragma once
+

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

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.");

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;

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