added hl_ptr_compare, detect invalid __compare methods

src/std/cast.c

@@ -313,6 +313,12 @@ static int dcompare( double a, double b ) {
  	return d == 0. ? 0 : (d > 0. ? 1 : -1);
 }
 
+HL_PRIM int hl_ptr_compare( vdynamic *a, vdynamic *b ) {
+	if( a == b )
+		return 0;
+	return a > b ? 1 : -1;
+}
+
 HL_PRIM int hl_dyn_compare( vdynamic *a, vdynamic *b ) {
 	if( a == b )
 		return 0;
@@ -341,7 +347,7 @@ HL_PRIM int hl_dyn_compare( vdynamic *a, vdynamic *b ) {
 	case TK2(HI32, HF64):
 		return dcompare((double)a->v.i,b->v.d);
 	case TK2(HOBJ,HOBJ):
-		if( a->t->obj == b->t->obj && a->t->obj->rt->compareFun )
+		if( a->t->obj->rt->compareFun )
 			return a->t->obj->rt->compareFun(a,b);
 		return a > b ? 1 : -1;
 	case TK2(HENUM,HENUM):
@@ -468,3 +474,5 @@ DEFINE_PRIM(_I32, dyn_compare, _DYN _DYN);
 DEFINE_PRIM(_DYN, value_cast, _DYN _TYPE);
 DEFINE_PRIM(_BOOL, type_safe_cast, _TYPE _TYPE);
 DEFINE_PRIM(_DYN, dyn_op, _I32 _DYN _DYN);
+DEFINE_PRIM(_I32, ptr_compare, _DYN _DYN);
+

src/std/obj.c

@@ -250,6 +250,7 @@ HL_PRIM hl_runtime_obj *hl_get_obj_rt( hl_type *ot ) {
 	compareHash = hl_hash_gen(USTR("__compare"),false);
 	for(i=0;i<o->nproto;i++) {
 		hl_obj_proto *pr = o->proto + i;
+		hl_type *mt;
 		int method_index;
 		if( p ) {
 			if( pr->pindex >= 0 && pr->pindex < p->nproto )
@@ -258,9 +259,10 @@ HL_PRIM hl_runtime_obj *hl_get_obj_rt( hl_type *ot ) {
 		} else
 			method_index = i;
 		if( pr->pindex >= t->nproto ) t->nproto = pr->pindex + 1;
-		hl_lookup_insert(t->lookup,nlookup++,pr->hashed_name,m->functions_types[pr->findex],-(method_index+1));
+		mt = m->functions_types[pr->findex];
+		hl_lookup_insert(t->lookup,nlookup++,pr->hashed_name,mt,-(method_index+1));
 		// tell if we have a compare fun (req for JIT)
-		if( pr->hashed_name == compareHash )
+		if( pr->hashed_name == compareHash && mt->fun->nargs == 2 && mt->fun->args[1]->kind == HDYN && mt->fun->ret->kind == HI32 )
 			t->compareFun = (void*)(int_val)pr->findex;
 	}
 
@@ -375,7 +377,7 @@ HL_API hl_runtime_obj *hl_get_obj_proto( hl_type *ot ) {
 	castField = obj_resolve_field(o,hl_hash_gen(USTR("__cast"),false));
 	getField = obj_resolve_field(o,hl_hash_gen(USTR("__get_field"),false));
 	t->toStringFun = strField ? t->methods[-(strField->field_index+1)] : NULL;
-	t->compareFun = cmpField ? t->methods[-(cmpField->field_index+1)] : NULL;
+	t->compareFun = cmpField && t->compareFun ? t->methods[-(cmpField->field_index+1)] : NULL;
 	t->castFun = castField ? t->methods[-(castField->field_index+1)] : NULL;
 	t->getFieldFun = getField ? t->methods[-(getField->field_index+1)] : NULL;
 	if( p && !t->getFieldFun ) t->getFieldFun = p->getFieldFun;