Add comparison operator <> and array method to sort by a custom

comparison function

13 files changed, 58 insertions, 18 deletions

diff --git a/ast.c b/ast.c
index e47ba571..80681e10 100644
--- a/ast.c
+++ b/ast.c
@@ -13,7 +13,8 @@ static const char *OP_NAMES[] = {
     [BINOP_MOD]="mod", [BINOP_MOD1]="mod1", [BINOP_PLUS]="+", [BINOP_MINUS]="minus",
     [BINOP_CONCAT]="++", [BINOP_LSHIFT]="<<", [BINOP_RSHIFT]=">>", [BINOP_MIN]="min",
     [BINOP_MAX]="max", [BINOP_EQ]="==", [BINOP_NE]="!=", [BINOP_LT]="<",
-    [BINOP_LE]="<=", [BINOP_GT]=">", [BINOP_GE]=">=", [BINOP_AND]="and", [BINOP_OR]="or", [BINOP_XOR]="xor",
+    [BINOP_LE]="<=", [BINOP_GT]=">", [BINOP_GE]=">=", [BINOP_CMP]="<>",
+    [BINOP_AND]="and", [BINOP_OR]="or", [BINOP_XOR]="xor",
 };
 
 static CORD ast_list_to_xml(ast_list_t *asts);
@@ -156,8 +157,8 @@ CORD type_ast_to_xml(type_ast_t *t)
 #define T(type, ...) case type: { auto data = t->__data.type; (void)data; return CORD_asprintf(__VA_ARGS__); }
     T(UnknownTypeAST, "<UnknownType/>")
     T(VarTypeAST, "%s", data.name)
-    T(PointerTypeAST, "<PointerType is_optional=\"%d\", is_stack=\"%d\", is_readonly=\"%d\">%r</PointerType>",
-      data.is_optional, data.is_stack, data.is_readonly, type_ast_to_xml(data.pointed))
+    T(PointerTypeAST, "<PointerType is_optional=\"%s\" is_stack=\"%s\" is_readonly=\"%s\">%r</PointerType>",
+      data.is_optional ? "yes" : "no", data.is_stack ? "yes" : "no", data.is_readonly ? "yes" : "no", type_ast_to_xml(data.pointed))
     T(ArrayTypeAST, "<ArrayType>%r</ArrayType>", type_ast_to_xml(data.item))
     T(TableTypeAST, "<TableType>%r %r</TableType>", type_ast_to_xml(data.key), type_ast_to_xml(data.value))
     T(FunctionTypeAST, "<FunctionType>%r %r</FunctionType>", arg_list_to_xml(data.args), type_ast_to_xml(data.ret))
diff --git a/ast.h b/ast.h
index 2fd55250..658f44c5 100644
--- a/ast.h
+++ b/ast.h
@@ -44,6 +44,7 @@ typedef enum {
     BINOP_POWER=100, BINOP_MULT, BINOP_DIVIDE, BINOP_MOD, BINOP_MOD1, BINOP_PLUS,
     BINOP_MINUS, BINOP_CONCAT, BINOP_LSHIFT, BINOP_RSHIFT, BINOP_MIN,
     BINOP_MAX, BINOP_EQ, BINOP_NE, BINOP_LT, BINOP_LE, BINOP_GT, BINOP_GE,
+    BINOP_CMP,
     BINOP_AND, BINOP_OR, BINOP_XOR,
 } binop_e;
 
diff --git a/builtins/array.c b/builtins/array.c
index 8b50dbcf..84b65ae7 100644
--- a/builtins/array.c
+++ b/builtins/array.c
@@ -138,7 +138,7 @@ public void Array$remove(array_t *arr, int64_t index, int64_t count, const TypeI
     arr->length -= count;
 }
 
-public void Array$sort(array_t *arr, const TypeInfo *type)
+public void Array$sort(array_t *arr, closure_t comparison, const TypeInfo *type)
 {
     const TypeInfo *item_type = type->ArrayInfo.item;
     int64_t item_size = item_type->size;
@@ -148,7 +148,7 @@ public void Array$sort(array_t *arr, const TypeInfo *type)
     if (arr->data_refcount || (int64_t)arr->stride != item_size)
         Array$compact(arr, type);
 
-    qsort_r(arr->data, arr->length, item_size, (void*)generic_compare, (void*)item_type);
+    qsort_r(arr->data, arr->length, item_size, comparison.fn, comparison.userdata);
 }
 
 public void Array$shuffle(array_t *arr, const TypeInfo *type)
diff --git a/builtins/array.h b/builtins/array.h
index 98638222..7b432194 100644
--- a/builtins/array.h
+++ b/builtins/array.h
@@ -56,7 +56,7 @@
 void Array$insert(array_t *arr, const void *item, int64_t index, const TypeInfo *type);
 void Array$insert_all(array_t *arr, array_t to_insert, int64_t index, const TypeInfo *type);
 void Array$remove(array_t *arr, int64_t index, int64_t count, const TypeInfo *type);
-void Array$sort(array_t *arr, const TypeInfo *type);
+void Array$sort(array_t *arr, closure_t comparison, const TypeInfo *type);
 void Array$shuffle(array_t *arr, const TypeInfo *type);
 void *Array$random(array_t arr);
 void Array$clear(array_t *array);
diff --git a/builtins/functions.c b/builtins/functions.c
index 53c4db0f..aa410b74 100644
--- a/builtins/functions.c
+++ b/builtins/functions.c
@@ -164,7 +164,7 @@ public void $test(void *expr, const TypeInfo *type, CORD expected, const char *f
 
             if (!success) {
                 fail_source(filename, start, end, 
-                            USE_COLOR ? "\x1b[31;1mDoctest failure:\nExpected: \x1b[32;1m%s\x1b[0m\n\x1b[31;1m But got: \x1b[31;7m%s\x1b[0m\n"
+                            USE_COLOR ? "\x1b[31;1mDoctest failure:\nExpected: \x1b[32;1m%s\x1b[0m\n\x1b[31;1m But got:\x1b[m %s\n"
                             : "Doctest failure:\nExpected: %s\n But got: %s\n",
                             CORD_to_const_char_star(expected), CORD_to_const_char_star(expr_normalized));
             }
diff --git a/builtins/table.c b/builtins/table.c
index 32bf6858..956c0565 100644
--- a/builtins/table.c
+++ b/builtins/table.c
@@ -441,8 +441,8 @@ public int32_t Table$compare(const table_t *x, const table_t *y, const TypeInfo
         return (x->entries.length > y->entries.length) - (x->entries.length < y->entries.length);
 
     array_t x_entries = x->entries, y_entries = y->entries;
-    Array$sort(&x_entries, table.key);
-    Array$sort(&y_entries, table.key);
+    Array$sort(&x_entries, (closure_t){.fn=generic_compare, .userdata=(void*)table.key}, table.key);
+    Array$sort(&y_entries, (closure_t){.fn=generic_compare, .userdata=(void*)table.key}, table.key);
     for (int64_t i = 0; i < x_entries.length; i++) {
         void *x_key = x_entries.data + x_entries.stride * i;
         void *y_key = y_entries.data + y_entries.stride * i;
diff --git a/compile.c b/compile.c
index 3e887399..c4983254 100644
--- a/compile.c
+++ b/compile.c
@@ -1105,6 +1105,9 @@ CORD compile(env_t *env, ast_t *ast)
             else
                 code_err(ast, "Boolean operators are only supported for Bool and integer types");
         }
+        case BINOP_CMP: {
+            return CORD_all("generic_compare($stack(", lhs, "), $stack(", rhs, "), ", compile_type_info(env, operand_t), ")");
+        }
         case BINOP_OR: {
             if (operand_t->tag == BoolType)
                 return CORD_asprintf("(%r || %r)", lhs, rhs);
@@ -1455,8 +1458,8 @@ CORD compile(env_t *env, ast_t *ast)
         switch (self_value_t->tag) {
         case ArrayType: {
             // TODO: check for readonly
+            type_t *item_t = Match(self_value_t, ArrayType)->item_type;
             if (streq(call->name, "insert")) {
-                type_t *item_t = Match(self_value_t, ArrayType)->item_type;
                 CORD self = compile_to_pointer_depth(env, call->self, 1, false);
                 arg_t *arg_spec = new(arg_t, .name="item", .type=item_t,
                                       .next=new(arg_t, .name="at", .type=Type(IntType, .bits=64), .default_val=FakeAST(Int, .i=0, .bits=64)));
@@ -1476,15 +1479,28 @@ CORD compile(env_t *env, ast_t *ast)
                                 compile_type_info(env, self_value_t), ")");
             } else if (streq(call->name, "random")) {
                 CORD self = compile_to_pointer_depth(env, call->self, 0, false);
+                (void)compile_arguments(env, ast, NULL, call->args);
                 return CORD_all("Array$random(", self, ")");
             } else if (streq(call->name, "shuffle")) {
                 CORD self = compile_to_pointer_depth(env, call->self, 1, false);
+                (void)compile_arguments(env, ast, NULL, call->args);
                 return CORD_all("Array$shuffle(", self, ", ", compile_type_info(env, self_value_t), ")");
             } else if (streq(call->name, "sort")) {
                 CORD self = compile_to_pointer_depth(env, call->self, 1, false);
-                return CORD_all("Array$sort(", self, ", ", compile_type_info(env, self_value_t), ")");
+                CORD comparison;
+                if (call->args) {
+                    type_t *item_ptr = Type(PointerType, .pointed=item_t, .is_stack=true, .is_readonly=true);
+                    type_t *fn_t = Type(FunctionType, .args=new(arg_t, .name="x", .type=item_ptr, .next=new(arg_t, .name="y", .type=item_ptr)),
+                                        .ret=Type(IntType, .bits=32));
+                    arg_t *arg_spec = new(arg_t, .name="by", .type=Type(ClosureType, .fn=fn_t));
+                    comparison = compile_arguments(env, ast, arg_spec, call->args);
+                } else {
+                    comparison = CORD_all("(closure_t){.fn=generic_compare, .userdata=(void*)", compile_type_info(env, item_t), "}");
+                }
+                return CORD_all("Array$sort(", self, ", ", comparison, ", ", compile_type_info(env, self_value_t), ")");
             } else if (streq(call->name, "clear")) {
                 CORD self = compile_to_pointer_depth(env, call->self, 1, false);
+                (void)compile_arguments(env, ast, NULL, call->args);
                 return CORD_all("Array$clear(", self, ")");
             } else if (streq(call->name, "slice")) {
                 CORD self = compile_to_pointer_depth(env, call->self, 1, false);
@@ -1495,6 +1511,7 @@ CORD compile(env_t *env, ast_t *ast)
                                 compile_type_info(env, self_value_t), ")");
             } else if (streq(call->name, "reversed")) {
                 CORD self = compile_to_pointer_depth(env, call->self, 0, false);
+                (void)compile_arguments(env, ast, NULL, call->args);
                 return CORD_all("Array$reversed(", self, ")");
             } else code_err(ast, "There is no '%s' method for arrays", call->name);
         }
@@ -1518,6 +1535,7 @@ CORD compile(env_t *env, ast_t *ast)
                                 compile_type_info(env, self_value_t), ")");
             } else if (streq(call->name, "clear")) {
                 CORD self = compile_to_pointer_depth(env, call->self, 1, false);
+                (void)compile_arguments(env, ast, NULL, call->args);
                 return CORD_all("Table$clear(", self, ")");
             } else code_err(ast, "There is no '%s' method for tables", call->name);
         }
@@ -1837,7 +1855,7 @@ CORD compile_type_info(env_t *env, type_t *t)
     case PointerType: {
         auto ptr = Match(t, PointerType);
         CORD sigil = ptr->is_stack ? "&" : (ptr->is_optional ? "?" : "@");
-        if (ptr->is_readonly) sigil = CORD_cat(sigil, "(readonly)");
+        if (ptr->is_readonly) sigil = CORD_cat(sigil, "%");
         return CORD_asprintf("$PointerInfo(%r, %r)", Text$quoted(sigil, false), compile_type_info(env, ptr->pointed));
     }
     case FunctionType: {
diff --git a/parse.c b/parse.c
index e683bb63..8b2e9840 100644
--- a/parse.c
+++ b/parse.c
@@ -38,6 +38,7 @@ int op_tightness[] = {
     [BINOP_MIN]=4, [BINOP_MAX]=4,
     [BINOP_EQ]=3, [BINOP_NE]=3,
     [BINOP_LT]=2, [BINOP_LE]=2, [BINOP_GT]=2, [BINOP_GE]=2,
+    [BINOP_CMP]=2,
     [BINOP_AND]=1, [BINOP_OR]=1, [BINOP_XOR]=1,
 };
 #define MAX_TIGHTNESS 9
@@ -505,7 +506,7 @@ type_ast_t *parse_pointer_type(parse_ctx_t *ctx, const char *pos) {
         return NULL;
 
     spaces(&pos);
-    bool is_readonly = match(&pos, "(readonly)");
+    bool is_readonly = match(&pos, "%");
     spaces(&pos);
     type_ast_t *type = expect(ctx, start, &pos, parse_type,
                              "I couldn't parse a pointer type after this point");
@@ -1313,7 +1314,12 @@ binop_e match_binary_operator(const char **pos)
     case '*': *pos += 1; return BINOP_MULT;
     case '/': *pos += 1; return BINOP_DIVIDE;
     case '^': *pos += 1; return BINOP_POWER;
-    case '<': *pos += 1; return match(pos, "=") ? BINOP_LE : (match(pos, "<") ? BINOP_LSHIFT : BINOP_LT);
+    case '<':
+        *pos += 1;
+        if (match(pos, "=")) return BINOP_LE;
+        else if (match(pos, ">")) return BINOP_CMP;
+        else if (match(pos, "<")) return BINOP_LSHIFT;
+        else return BINOP_LT;
     case '>': *pos += 1; return match(pos, "=") ? BINOP_GE : (match(pos, ">") ? BINOP_RSHIFT : BINOP_GT);
     default: {
         if (match(pos, "!=")) return BINOP_NE;
diff --git a/repl.c b/repl.c
index d6c8676f..0e968cdf 100644
--- a/repl.c
+++ b/repl.c
@@ -133,7 +133,7 @@ const TypeInfo *type_to_type_info(type_t *t)
     case PointerType: {
         auto ptr = Match(t, PointerType);
         CORD sigil = ptr->is_stack ? "&" : (ptr->is_optional ? "?" : "@");
-        if (ptr->is_readonly) sigil = CORD_cat(sigil, "(readonly)");
+        if (ptr->is_readonly) sigil = CORD_cat(sigil, "%");
         const TypeInfo *pointed_info = type_to_type_info(ptr->pointed);
         const TypeInfo pointer_info = {.size=sizeof(void*), .align=__alignof__(void*),
             .tag=PointerInfo, .PointerInfo.sigil=sigil, .PointerInfo.pointed=pointed_info};
diff --git a/test/arrays.tm b/test/arrays.tm
index e8856b3b..d4dd2119 100644
--- a/test/arrays.tm
+++ b/test/arrays.tm
@@ -73,3 +73,15 @@ if yes
 	>> arr := [10, 20, 30]
 	>> arr:reversed()
 	= [30, 20, 10]
+
+if yes
+	>> nums := [10, -20, 30]
+	>> nums:sort()
+	>> nums
+	= [-20, 10, 30]
+	>> nums:sort(func(x:&%Int,y:&%Int) x:abs() <> y:abs())
+	>> nums
+	= [10, -20, 30]
+	>> nums:sort(func(x:&%Int,y:&%Int) y[] <> x[])
+	>> nums
+	= [30, 10, -20]
diff --git a/test/tables.tm b/test/tables.tm
index 53e81d48..74123f88 100644
--- a/test/tables.tm
+++ b/test/tables.tm
@@ -18,7 +18,7 @@ for k,v in t
 >> #t
 = 2
 >> t.default
-= ?(readonly)999
+= ?%999
 >> t.fallback
 = !{Text=>Int}
 
@@ -42,7 +42,7 @@ for k,v in t
 >> t2.default
 = !Int
 >> t2.fallback
-= ?(readonly){"one"=>1, "two"=>2; default=999}
+= ?%{"one"=>1, "two"=>2; default=999}
 
 t2_str := ""
 for k,v in t2
diff --git a/typecheck.c b/typecheck.c
index 6f92374f..f876851e 100644
--- a/typecheck.c
+++ b/typecheck.c
@@ -652,6 +652,8 @@ type_t *get_type(env_t *env, ast_t *ast)
                 code_err(ast, "I can't compare these two different types: %T vs %T", lhs_t, rhs_t);
             return Type(BoolType);
         }
+        case BINOP_CMP:
+            return Type(IntType, .bits=32);
         case BINOP_POWER: {
             type_t *result = get_math_type(env, ast, lhs_t, rhs_t);
             if (result->tag == NumType)
diff --git a/types.c b/types.c
index 4bc7e85b..cd63e574 100644
--- a/types.c
+++ b/types.c
@@ -48,7 +48,7 @@ CORD type_to_cord(type_t *t) {
         case PointerType: {
             auto ptr = Match(t, PointerType);
             CORD sigil = ptr->is_stack ? "&" : (ptr->is_optional ? "?" : "@");
-            if (ptr->is_readonly) sigil = CORD_cat(sigil, "(readonly)");
+            if (ptr->is_readonly) sigil = CORD_cat(sigil, "%");
             return CORD_cat(sigil, type_to_cord(ptr->pointed));
         }
         case EnumType: {