Add classes to core library.

src/core/array.c

@@ -193,6 +193,8 @@ static int cfun_slice(JanetArgs args) {
     }
     if (start < 0) start = len + start;
     if (end < 0) end = len + end + 1;
+    if (end < 0 || start < 0 || end > len || start > len)
+        JANET_THROW(args, "slice range out of bounds");
     if (end >= start) {
         ret = janet_array(end - start);
         memcpy(ret->data, vals + start, sizeof(Janet) * (end - start));
@@ -228,6 +230,29 @@ static int cfun_concat(JanetArgs args) {
     JANET_RETURN_ARRAY(args, array);
 }
 
+static int cfun_insert(JanetArgs args) {
+    int32_t at;
+    size_t chunksize, restsize;
+    JanetArray *array;
+    JANET_MINARITY(args, 2);
+    JANET_ARG_ARRAY(array, args, 0);
+    JANET_ARG_INTEGER(at, args, 1);
+    if (at < 0) {
+        at = array->count + at + 1; 
+    }
+    if (at < 0 || at > array->count)
+        JANET_THROW(args, "insertion index out of bounds");
+    chunksize = (args.n - 2) * sizeof(Janet);
+    restsize = (array->count - at) * sizeof(Janet);
+    janet_array_ensure(array, array->count + args.n - 2, 2);
+    memmove(array->data + at + args.n - 2,
+            array->data + at,
+            restsize);
+    memcpy(array->data + at, args.v + 2, chunksize);
+    array->count += (args.n - 2);
+    JANET_RETURN_ARRAY(args, array);
+}
+
 static const JanetReg cfuns[] = {
     {"array.new", cfun_new,
         "(array.new capacity)\n\n"
@@ -273,6 +298,13 @@ static const JanetReg cfuns[] = {
         "be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
         "Return the modified array arr."
     },
+    {"array.insert", cfun_insert,
+        "(array.insert arr at & xs)\n\n"
+        "Insert all of xs into array arr at index at. at should be an integer "
+        "0 and the length of the array. A negative value for at will index from "
+        "the end of the array, such that inserting at -1 appends to the array. "
+        "Returns the array."
+    },
     {NULL, NULL, NULL}
 };
 

src/core/buffer.c

@@ -257,6 +257,8 @@ static int cfun_slice(JanetArgs args) {
     }
     if (start < 0) start = len + start;
     if (end < 0) end = len + end + 1;
+    if (end < 0 || start < 0 || end > len || start > len)
+        JANET_THROW(args, "slice range out of bounds");
     if (end >= start) {
         ret = janet_buffer(end - start);
         memcpy(ret->data, data + start, end - start);

src/core/core.janet

@@ -1062,6 +1062,79 @@ value, one key will be ignored."
     (:= current (macroexpand-1 current)))
   current)
 
+
+###
+###
+### Classes
+###
+###
+
+(defn- parse-signature
+  "Turn a signature into a (method, object) pair."
+  [signature]
+  (when (not (symbol? signature)) (error "expected method signature"))
+  (def parts (string.split ":" signature))
+  (def self (symbol (get parts 0)))
+  (def method (apply symbol (tuple.slice parts 1)))
+  (tuple (tuple 'quote method) self))
+
+(def class 
+  "(class obj)\n\nGets the class of an object."
+  table.getproto)
+
+(defn instance-of?
+  "Checks if an object is an instance of a class."
+  [class obj]
+  (if obj (or 
+            (= class obj) 
+            (instance-of? class (table.getproto obj)))))
+
+(defmacro call
+  "Call a method."
+  [signature & args]
+  (def [method self] (parse-signature signature))
+  (apply tuple (tuple get self method) self args))
+
+(def $ :macro call)
+
+(defmacro wrap-call
+  "Wrap a method call in a function."
+  [signature & args]
+  (def [method self] (parse-signature signature))
+  (def $m (gensym))
+  (def $args (gensym))
+  (tuple 'do
+         (tuple 'def $m (tuple get self method))
+         (tuple 'fn (symbol "wrapped-" signature) [tuple '& $args]
+                (tuple apply $m self $args))))
+
+(defmacro defm
+  "Defines a method for a class."
+  [signature & args]
+  (def [method self] (parse-signature signature))
+  (def i (find-index tuple? args))
+  (def newargs (array.slice args))
+  (put newargs i (tuple.prepend (get newargs i) 'self))
+  (tuple put self method (apply defn signature newargs)))
+
+(defmacro defnew
+  "Defines the constructor for a class."
+  [class & args]
+  (def newargs (array.slice args))
+  (def i (find-index tuple? args))
+  (array.insert newargs (+ i 1) (tuple 'def 'self (tuple table.setproto @{} class)))
+  (array.push newargs 'self)
+  (tuple put class ''new (apply defn (symbol class :new)  newargs)))
+
+(defmacro defclass
+  "Defines a new prototype class."
+  [name & args]
+  (if (not name) (error "expected a name"))
+  (tuple 'def name
+         (apply tuple table :name (tuple 'quote name) args)))
+
+(put _env 'parse-signature nil)
+
 ###
 ###
 ### Evaluation and Compilation

src/core/string.c

@@ -801,6 +801,8 @@ static int cfun_slice(JanetArgs args) {
     }
     if (start < 0) start = len + start;
     if (end < 0) end = len + end + 1;
+    if (end < 0 || start < 0 || end > len || start > len)
+        JANET_THROW(args, "slice range out of bounds");
     if (end >= start) {
         ret = janet_string(data + start, end - start);
     } else {

src/core/tuple.c

@@ -116,6 +116,8 @@ static int cfun_slice(JanetArgs args) {
     }
     if (start < 0) start = len + start;
     if (end < 0) end = len + end + 1;
+    if (end < 0 || start < 0 || end > len || start > len)
+        JANET_THROW(args, "slice range out of bounds");
     if (end >= start) {
         ret = janet_tuple_begin(end - start);
         memcpy(ret, vals + start, sizeof(Janet) * (end - start));