Browse Source

rewrite Abstract.do_check_cast (see #2856)

Simon Krajewski 11 years ago
parent
commit
ba78e4325e
1 changed files with 32 additions and 40 deletions
  1. 32 40
      codegen.ml

+ 32 - 40
codegen.ml

@@ -681,9 +681,6 @@ module Abstract = struct
 		make_static_call ctx c cf (apply_params a.a_types pl) args t p
 
 	let rec do_check_cast ctx tleft eright p =
-		let tright = follow eright.etype in
-		let tleft = follow tleft in
-		if tleft == tright then eright else
 		let recurse cf f =
 			if cf == ctx.curfield || List.mem cf !cast_stack then error "Recursive implicit cast" p;
 			cast_stack := cf :: !cast_stack;
@@ -691,43 +688,38 @@ module Abstract = struct
 			cast_stack := List.tl !cast_stack;
 			r
 		in
-		try (match tright,tleft with
-			| (TAbstract({a_impl = Some c1} as a1,pl1) as t1),(TAbstract({a_impl = Some c2} as a2,pl2) as t2) ->
-				if a1 == a2 then
-					eright
-				else begin
-					let c,cfo,a,pl = try
-						if Meta.has Meta.MultiType a1.a_meta then raise Not_found;
-						c1,snd (find_to a1 pl1 t2),a1,pl1
-					with Not_found ->
-						if Meta.has Meta.MultiType a2.a_meta then raise Not_found;
-						c2,snd (find_from a2 pl2 t1 t2),a2,pl2
-					in
-					match cfo with
-					| None -> eright
-					| Some cf ->
-						recurse cf (fun () -> make_static_call ctx c cf a pl [eright] tleft p)
-				end
-			| _, TMono _ | TMono _, _ ->
-				eright
-			| TAbstract({a_impl = Some c} as a,pl),t2 when not (Meta.has Meta.MultiType a.a_meta) ->
-				begin match find_to a pl t2 with
-					| tcf,None ->
-						let tcf = apply_params a.a_types pl tcf in
-						if type_iseq tcf tleft then eright else do_check_cast ctx tcf eright p
-					| _,Some cf ->
-						recurse cf (fun () -> make_static_call ctx c cf a pl [eright] tleft p)
-				end
-			| t1,(TAbstract({a_impl = Some c} as a,pl) as t2) when not (Meta.has Meta.MultiType a.a_meta) ->
-				begin match find_from a pl t1 t2 with
-					| tcf,None ->
-						let tcf = apply_params a.a_types pl tcf in
-						if type_iseq tcf tleft then eright else do_check_cast ctx tcf eright p
-					| _,Some cf ->
-						recurse cf (fun () -> make_static_call ctx c cf a pl [eright] tleft p)
-				end
-			| _ ->
-				eright)
+		let find a tl f =
+			let tcf,cfo = f() in
+			match cfo,a.a_impl with
+				| None,_ ->
+					let tcf = apply_params a.a_types tl tcf in
+					if type_iseq tcf tleft then
+						eright
+					else
+						(* TODO: causes Java overload issues *)
+						(* let eright = mk (TCast(eright,None)) tleft p in *)
+						do_check_cast ctx tcf eright p
+				| Some cf,Some c ->
+					make_static_call ctx c cf a tl [eright] tleft p
+				| _ ->
+					assert false
+		in
+		if type_iseq tleft eright.etype then
+			eright
+		else try
+			begin match follow eright.etype with
+				| TAbstract(a,tl) ->
+					find a tl (fun () -> find_to a tl tleft)
+				| _ ->
+					raise Not_found
+			end
+		with Not_found -> try
+			begin match follow tleft with
+				| TAbstract(a,tl) ->
+					find a tl (fun () -> find_from a tl eright.etype tleft)
+				| _ ->
+					raise Not_found
+			end
 		with Not_found ->
 			eright