Simon Krajewski 11 yıl önce
ebeveyn
işleme
6ebdfe31f6
2 değiştirilmiş dosya ile 1 ekleme ve 120 silme
  1. 1 0
      optimizer.ml
  2. 0 120
      typer.ml

+ 1 - 0
optimizer.ml

@@ -277,6 +277,7 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
 			| TConst TNull , Some c -> mk (TConst c) v.v_type e.epos
 			(* we have to check for abstract casts here because we can't do that later. However, we have to skip the check for the
 			   first argument of abstract implementation functions. *)
+			(* actually we don't because unify_call_args takes care of that anyway *)
 			(* | _ when not (first && Meta.has Meta.Impl cf.cf_meta && cf.cf_name <> "_new") -> (!check_abstract_cast_ref) ctx (map_type v.v_type) e e.epos *)
 			| _ -> e) :: loop pl al false
 		| [], (v,opt) :: al ->

+ 0 - 120
typer.ml

@@ -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