Browse Source

resolve leftover multi-type abstracts during DCE (closes #2163)

Simon Krajewski 12 years ago
parent
commit
5b5b7be5c3
3 changed files with 23 additions and 20 deletions
  1. 1 1
      Makefile
  2. 20 19
      codegen.ml
  3. 2 0
      dce.ml

+ 1 - 1
Makefile

@@ -90,7 +90,7 @@ codegen.cmx: optimizer.cmx typeload.cmx typecore.cmx type.cmx genxml.cmx common.
 
 common.cmx: type.cmx ast.cmx
 
-dce.cmx: ast.cmx common.cmx type.cmx
+dce.cmx: ast.cmx common.cmx codegen.cmx type.cmx
 
 genas3.cmx: type.cmx common.cmx codegen.cmx ast.cmx
 

+ 20 - 19
codegen.ml

@@ -1525,28 +1525,29 @@ module Abstract = struct
 	let check_cast ctx tleft eright p =
 		if ctx.com.display then eright else do_check_cast ctx tleft eright p
 
+	let find_multitype_specialization a pl p =
+		let m = mk_mono() in
+		let at = apply_params a.a_types pl a.a_this in
+		let _,cfo =
+			try find_to a pl m
+			with Not_found ->
+				let st = s_type (print_context()) at in
+				if has_mono at then
+					error ("Type parameters of multi type abstracts must be known (for " ^ st ^ ")") p
+				else
+					error ("Abstract " ^ (s_type_path a.a_path) ^ " has no @:to function that accepts " ^ st) p;
+		in
+		match cfo with
+			| None -> assert false
+			| Some cf -> cf, follow m
+
 	let handle_abstract_casts ctx e =
 		let rec loop ctx e = match e.eexpr with
 			| TNew({cl_kind = KAbstractImpl a} as c,pl,el) ->
-				(* a TNew of an abstract implementation is only generated if it is a generic abstract *)
-				let at = apply_params a.a_types pl a.a_this in
-				let m = mk_mono() in
-				let _,cfo =
-					try find_to a pl m
-					with Not_found ->
-						let st = s_type (print_context()) at in
-						if has_mono at then
-							error ("Type parameters of multi type abstracts must be known (for " ^ st ^ ")") e.epos
-						else
-							error ("Abstract " ^ (s_type_path a.a_path) ^ " has no @:to function that accepts " ^ st) e.epos;
-				in
-				begin match cfo with
-				| None -> assert false
-				| Some cf ->
-					let m = follow m in
-					let e = make_static_call ctx c cf a pl ((mk (TConst TNull) (TAbstract(a,pl)) e.epos) :: el) m e.epos in
-					{e with etype = m}
-				end
+				(* a TNew of an abstract implementation is only generated if it is a multi type abstract *)
+				let cf,m = find_multitype_specialization a pl e.epos in
+				let e = make_static_call ctx c cf a pl ((mk (TConst TNull) (TAbstract(a,pl)) e.epos) :: el) m e.epos in
+				{e with etype = m}
 			| TCall(e1, el) ->
 				begin try
 					begin match e1.eexpr with

+ 2 - 0
dce.ml

@@ -157,6 +157,8 @@ and mark_t dce t =
 		| TEnum(e,pl) ->
 			mark_enum dce e;
 			List.iter (mark_t dce) pl
+		| TAbstract(a,pl) when Meta.has Meta.MultiType a.a_meta ->
+			mark_t dce (snd (Codegen.Abstract.find_multitype_specialization a pl Ast.null_pos))
 		| TAbstract(a,pl) ->
 			mark_abstract dce a;
 			List.iter (mark_t dce) pl