Skip to content

Commit

Permalink
retain current return type constraints
Browse files Browse the repository at this point in the history
  • Loading branch information
Simn committed Sep 15, 2014
1 parent b52b695 commit b81afd7
Show file tree
Hide file tree
Showing 3 changed files with 41 additions and 7 deletions.
1 change: 0 additions & 1 deletion tests/unit/MyAbstract.hx
Original file line number Diff line number Diff line change
Expand Up @@ -203,7 +203,6 @@ abstract MyString(String) from String to String {
@:op(A + B) static public function add(lhs:MyString, rhs:MyString):MyString;
@:op(A + B) static public function addInt(lhs:MyString, rhs:Int):MyString;
@:op(A + B) static public function addBool(lhs:MyString, rhs:Bool):Bool;
@:op(A - B) static public function sub(lhs:MyString, rhs:MyString):MyString;
}

class ClassWithHashCode {
Expand Down
4 changes: 2 additions & 2 deletions tests/unit/TestType.hx
Original file line number Diff line number Diff line change
Expand Up @@ -783,9 +783,9 @@ class TestType extends Test {
t(Std.is(msum2, String));

// operation is defined, but return type is not compatible
//t(typeError(ms1 + true));
t(typeError(ms1 + true));
// operation is not defined
//t(typeError(ms1 - ms2));
t(typeError(ms1 - ms2));
}

function testAbstractUnop() {
Expand Down
43 changes: 39 additions & 4 deletions typer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -2111,6 +2111,14 @@ let rec type_binop ctx op e1 e2 is_assign_op with_type p =
| OpAssignOp _ ->
assert false
in
let rec expected_result_type = function
| OpAdd | OpSub | OpMult | OpDiv | OpMod -> ctx.t.tfloat
| OpGt | OpGte | OpLt | OpLte | OpEq | OpNotEq | OpBoolAnd | OpBoolOr -> ctx.t.tbool
| OpAnd | OpOr | OpXor | OpUShr | OpShr | OpShl -> ctx.t.tint
| OpArrow -> t_dynamic
| OpAssignOp op -> expected_result_type op
| OpInterval | OpAssign -> assert false
in
let find_overload a c tl =
let map = apply_params a.a_params tl in
(* special case for == and !=: if the second type is a monomorph, assume that we want to unify
Expand All @@ -2131,7 +2139,7 @@ let rec type_binop ctx op e1 e2 is_assign_op with_type p =
loop ol
| (op_cf,cf) :: ol ->
begin match follow cf.cf_type with
| TFun([(_,_,t1);(_,_,t2)],ret) ->
| TFun([(_,_,t1);(_,_,t2)],tret) ->
let map_arguments () =
let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
let map t = map (apply_params cf.cf_params monos t) in
Expand All @@ -2140,9 +2148,36 @@ let rec type_binop ctx op e1 e2 is_assign_op with_type p =
monos,t1,t2
in
let make e1 e2 =
if cf.cf_expr = None then mk_cast (Codegen.binop op e1 e2 ret p) ret p
else begin
let e = make_static_call ctx c cf map [e1;e2] ret p in
if cf.cf_expr = None then begin
if not (Meta.has Meta.CoreType a.a_meta) then begin
(* for non core-types we require that the return type is compatible to the native result type *)
let t_expected = expected_result_type op_cf in
begin try
unify_raise ctx tret t_expected p
with Error (Unify _,_) ->
let invalid_return () =
let s_expected = match op with
| OpAdd | OpAssignOp OpAdd -> "String or "
| _ -> ""
in
let pctx = print_context() in
let st = s_type pctx in
error (Printf.sprintf "The result of this operation (%s%s) is not compatible with declared return type %s" s_expected (st t_expected) (st tret)) p
in
match op with
| OpAdd | OpAssignOp OpAdd ->
begin try
unify_raise ctx tret ctx.t.tstring p
with Error (Unify _,_) ->
invalid_return()
end
| _ ->
invalid_return()
end;
end;
mk_cast (Codegen.binop op e1 e2 tret p) tret p
end else begin
let e = make_static_call ctx c cf map [e1;e2] tret p in
if is_assign_op && op_cf = op then (mk (TMeta((Meta.RequiresAssign,[],p),e)) e.etype e.epos)
else e
end
Expand Down

0 comments on commit b81afd7

Please sign in to comment.