allow right side this-type operators (fixed issue #1595)

typeload.ml

@@ -1496,7 +1496,10 @@ let init_class ctx c p context_init herits fields =
 					else (try match Meta.get Meta.Op cf.cf_meta with
 						| _,[EBinop(op,_,_),_],_ ->
 							let targ = if Meta.has Meta.Impl f.cff_meta then tthis else ta in
-							(try type_eq EqStrict t (tfun [targ;m] (mk_mono())) with Unify_error l -> raise (Error ((Unify l),f.cff_pos)));
+							let left_eq = type_iseq t (tfun [targ;m] (mk_mono())) in
+							let right_eq = type_iseq t (tfun [mk_mono();targ] (mk_mono())) in
+							if not (left_eq || right_eq) then error ("The left or right argument type must be " ^ (s_type (print_context()) targ)) f.cff_pos;
+							if right_eq && Meta.has Meta.Commutative f.cff_meta then error ("@:commutative is only allowed if the right argument is not " ^ (s_type (print_context()) targ)) f.cff_pos;
 							a.a_ops <- (op,cf) :: a.a_ops;
 							if fd.f_expr = None then do_bind := false;
 						| _,[EUnop(op,flag,_),_],_ ->

typer.ml

@@ -1597,12 +1597,12 @@ let rec type_binop ctx op e1 e2 is_assign_op p =
 			| [] -> raise Not_found
 			| (o,cf) :: ops when is_assign_op && o = OpAssignOp(op) || o == op ->
 				(match follow (monomorphs cf.cf_params cf.cf_type) with
-				| TFun([(_,_,t1);(_,_,t2)],r) when
-					(left || Meta.has Meta.Commutative cf.cf_meta)
-					&& type_iseq t t2
-					&& if Meta.has Meta.Impl cf.cf_meta then type_iseq (apply_params a.a_types pl a.a_this) t1 else type_iseq (TAbstract(a,pl)) t1 ->
+				| TFun([(_,_,t1);(_,_,t2)],r) ->
+					let t1,t2 = if left || Meta.has Meta.Commutative cf.cf_meta then t1,t2 else t2,t1 in
+					if type_iseq t t2 && (if Meta.has Meta.Impl cf.cf_meta then type_iseq (apply_params a.a_types pl a.a_this) t1 else type_iseq (TAbstract(a,pl)) t1) then begin
 						if not (can_access ctx c cf true) then display_error ctx ("Cannot access operator function " ^ (s_type_path a.a_path) ^ "." ^ cf.cf_name) p;
 						cf,r,o = OpAssignOp(op)
+					end else loop ops
 				| _ -> loop ops)
 			| _ :: ops ->
 				loop ops