|
@@ -2191,126 +2191,6 @@ let rec type_binop ctx op e1 e2 is_assign_op with_type p =
|
|
|
end
|
|
|
with Not_found ->
|
|
|
make e1 e2
|
|
|
-(* let find_overload a pl c t left =
|
|
|
- let rec loop ops = match ops with
|
|
|
- | [] -> raise Not_found
|
|
|
- | (o,cf) :: ops when is_assign_op && o = OpAssignOp(op) || o == op ->
|
|
|
- let impl = Meta.has Meta.Impl cf.cf_meta in
|
|
|
- let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
|
|
|
- let tcf = apply_params cf.cf_params monos cf.cf_type in
|
|
|
- let tcf = if impl then apply_params a.a_params pl tcf else tcf in
|
|
|
- (match follow tcf with
|
|
|
- | TFun([(_,_,t1);(_,_,t2)],r) ->
|
|
|
- (* implementation fields can only be used in left mode (issue #2130) *)
|
|
|
- if impl && not left then loop ops else begin
|
|
|
- let t1,t2 = if left || Meta.has Meta.Commutative cf.cf_meta then t1,t2 else t2,t1 in
|
|
|
- begin try
|
|
|
- begin
|
|
|
- if impl then
|
|
|
- type_eq EqStrict (Abstract.get_underlying_type a pl) (Abstract.follow_with_abstracts t1)
|
|
|
- else
|
|
|
- type_eq EqStrict (TAbstract(a,pl)) t1;
|
|
|
- end;
|
|
|
- (* special case for == and !=: if the second type is a monomorph, assume that we want to unify
|
|
|
- it with the first type to preserve comparison semantics. *)
|
|
|
- begin match op,follow t with
|
|
|
- | (OpEq | OpNotEq),TMono _ ->
|
|
|
- Type.unify (if left then e1.etype else e2.etype) t
|
|
|
- | _ ->
|
|
|
- ()
|
|
|
- end;
|
|
|
- Type.unify t t2;
|
|
|
- check_constraints ctx "" cf.cf_params monos (apply_params a.a_params pl) false cf.cf_pos;
|
|
|
- cf,t2,r,o = OpAssignOp(op),Meta.has Meta.Commutative cf.cf_meta
|
|
|
- with Unify_error _ ->
|
|
|
- loop ops
|
|
|
- end
|
|
|
- end;
|
|
|
- | _ -> loop ops)
|
|
|
- | _ :: ops ->
|
|
|
- loop ops
|
|
|
- in
|
|
|
- loop a.a_ops
|
|
|
- in
|
|
|
- let mk_cast_op c f a pl e1 e2 r assign =
|
|
|
- let t = field_type ctx c [] f p in
|
|
|
- let t = apply_params a.a_params pl t in
|
|
|
- let et = type_module_type ctx (TClassDecl c) None p in
|
|
|
- let ef = mk (TField (et,FStatic (c,f))) t p in
|
|
|
- let ec = make_call ctx ef [e1;e2] r p in
|
|
|
- if is_assign_op && not assign then mk (TMeta((Meta.RequiresAssign,[],ec.epos),ec)) ec.etype ec.epos else ec
|
|
|
- in
|
|
|
- let cast_rec e1t e2t r is_core_type =
|
|
|
- if is_core_type then
|
|
|
- (* we assume that someone declaring a @:coreType knows what he is doing with regards to operation return types (issue #2333) *)
|
|
|
- mk (TBinop(op,e1t,e2t)) r p
|
|
|
- else begin
|
|
|
- let e = make e1t e2t in
|
|
|
- begin try
|
|
|
- unify_raise ctx e.etype r p
|
|
|
- with Error (Unify _,_) ->
|
|
|
- match follow r with
|
|
|
- | TAbstract(a,tl) when type_iseq (Abstract.get_underlying_type a tl) e.etype ->
|
|
|
- ()
|
|
|
- | _ ->
|
|
|
- error ("The result of this operation (" ^ (s_type (print_context()) e.etype) ^ ") is not compatible with declared return type " ^ (s_type (print_context()) r)) p;
|
|
|
- end;
|
|
|
- {e with etype = r}
|
|
|
- end
|
|
|
- in
|
|
|
- let hack_test ctx t e p = try Codegen.AbstractCast.cast_or_unify_raise ctx t e p with Error (Unify _,_) -> e in
|
|
|
- try (match follow e1.etype with
|
|
|
- | TAbstract ({a_impl = Some c} as a,pl) ->
|
|
|
- let f,t2,r,assign,_ = find_overload a pl c e2.etype true in
|
|
|
- let e2 = hack_test ctx t2 e2 e2.epos in
|
|
|
- begin match f.cf_expr with
|
|
|
- | None ->
|
|
|
- let e2 = match follow e2.etype with TAbstract(a,pl) -> {e2 with etype = apply_params a.a_params pl a.a_this} | _ -> e2 in
|
|
|
- cast_rec {e1 with etype = apply_params a.a_params pl a.a_this} e2 r (Meta.has Meta.CoreType a.a_meta)
|
|
|
- | Some _ ->
|
|
|
- mk_cast_op c f a pl e1 e2 r assign
|
|
|
- end
|
|
|
- | _ ->
|
|
|
- raise Not_found)
|
|
|
- with Not_found -> try (match follow e2.etype with
|
|
|
- | TAbstract ({a_impl = Some c} as a,pl) ->
|
|
|
- let f,t2,r,assign,commutative = find_overload a pl c e1.etype false in
|
|
|
- (* let e1,e2 = if commutative then else e1,Codegen.AbstractCast.check_cast ctx t2 e2 e2.epos in *)
|
|
|
- let e1,e2,init = if not commutative then
|
|
|
- e1,hack_test ctx t2 e2 e2.epos,None
|
|
|
- else if not (Optimizer.has_side_effect e1) && not (Optimizer.has_side_effect e2) then
|
|
|
- e2,hack_test ctx t2 e1 e1.epos,None
|
|
|
- else begin
|
|
|
- let v1,v2 = gen_local ctx e1.etype, gen_local ctx e2.etype in
|
|
|
- let mk_var v e =
|
|
|
- mk (TVar(v,Some e)) ctx.t.tvoid e.epos,mk (TLocal v) e.etype e.epos
|
|
|
- in
|
|
|
- let v1 = mk_var v1 (hack_test ctx t2 e1 e1.epos) in
|
|
|
- let v2 = mk_var v2 e2 in
|
|
|
- snd v2,snd v1,Some(fst v1,fst v2)
|
|
|
- end in
|
|
|
- let e = match f.cf_expr with
|
|
|
- | None ->
|
|
|
- let e1 = match follow e1.etype with TAbstract(a,pl) -> {e1 with etype = apply_params a.a_params pl a.a_this} | _ -> e1 in
|
|
|
- cast_rec e1 {e2 with etype = apply_params a.a_params pl a.a_this} r (Meta.has Meta.CoreType a.a_meta)
|
|
|
- | Some _ ->
|
|
|
- mk_cast_op c f a pl e1 e2 r assign
|
|
|
- in
|
|
|
- begin match init with
|
|
|
- | None ->
|
|
|
- e
|
|
|
- | Some(e1,e2) ->
|
|
|
- mk (TBlock [
|
|
|
- e1;
|
|
|
- e2;
|
|
|
- e
|
|
|
- ]) e.etype e.epos
|
|
|
- end
|
|
|
- | _ ->
|
|
|
- raise Not_found)
|
|
|
- with Not_found ->
|
|
|
- make e1 e2 *)
|
|
|
-
|
|
|
|
|
|
and type_unop ctx op flag e p =
|
|
|
let set = (op = Increment || op = Decrement) in
|