Browse Source

insert cast when inlining abstracts and make constructor inlining more robust

Simon Krajewski 10 years ago
parent
commit
33d8705813

+ 39 - 18
codegen.ml

@@ -864,29 +864,50 @@ module AbstractCast = struct
 				end
 			| TCall(e1, el) ->
 				begin try
-					begin match e1.eexpr with
+					let rec find_abstract e = match follow e.etype,e.eexpr with
+						| TAbstract(a,pl),_ when Meta.has Meta.MultiType a.a_meta -> a,pl,e
+						| _,TCast(e1,None) -> find_abstract e1
+						| _ -> raise Not_found
+					in
+					let rec find_field e1 =
+						match e1.eexpr with
+						| TCast(e2,None) ->
+							{e1 with eexpr = TCast(find_field e2,None)}
 						| TField(e2,fa) ->
-							begin match follow e2.etype with
-								| TAbstract(a,pl) when Meta.has Meta.MultiType a.a_meta ->
-									let m = Abstract.get_underlying_type a pl in
-									let fname = field_name fa in
-									let el = List.map (loop ctx) el in
-									begin try
-										let ef = mk (TField({e2 with etype = m},quick_field m fname)) e1.etype e2.epos in
-										make_call ctx ef el e.etype e.epos
-									with Not_found ->
-										(* quick_field raises Not_found if m is an abstract, we have to replicate the 'using' call here *)
-										match follow m with
-										| TAbstract({a_impl = Some c} as a,pl) ->
-											let cf = PMap.find fname c.cl_statics in
-											make_static_call ctx c cf a pl (e2 :: el) e.etype e.epos
-										| _ -> raise Not_found
-									end
+							let a,pl,e2 = find_abstract e2 in
+							let m = Abstract.get_underlying_type a pl in
+							let fname = field_name fa in
+							let el = List.map (loop ctx) el in
+							begin try
+								let fa = quick_field m fname in
+								let get_fun_type t = match follow t with
+									| TFun(_,tr) as tf -> tf,tr
+									| _ -> raise Not_found
+								in
+								let tf,tr = match fa with
+									| FStatic(_,cf) -> get_fun_type cf.cf_type
+									| FInstance(c,tl,cf) -> get_fun_type (apply_params c.cl_params tl cf.cf_type)
+									| FAnon cf -> get_fun_type cf.cf_type
+									| _ -> raise Not_found
+								in
+								let ef = mk (TField({e2 with etype = m},fa)) tf e2.epos in
+								let ecall = make_call ctx ef el tr e.epos in
+								if not (type_iseq ecall.etype e.etype) then
+									mk (TCast(ecall,None)) e.etype e.epos
+								else
+									ecall
+							with Not_found ->
+								(* quick_field raises Not_found if m is an abstract, we have to replicate the 'using' call here *)
+								match follow m with
+								| TAbstract({a_impl = Some c} as a,pl) ->
+									let cf = PMap.find fname c.cl_statics in
+									make_static_call ctx c cf a pl (e2 :: el) e.etype e.epos
 								| _ -> raise Not_found
 							end
 						| _ ->
 							raise Not_found
-					end
+					in
+					find_field e1
 				with Not_found ->
 					Type.map_expr (loop ctx) e
 				end

+ 73 - 42
optimizer.ml

@@ -337,7 +337,8 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
 			(* never inline a function which contain a delayed macro because its bound
 				to its variables and not the calling method *)
 			if v.v_name = "__dollar__delay_call" then cancel_inlining := true;
-			{ e with eexpr = TLocal l.i_subst }
+			let e = { e with eexpr = TLocal l.i_subst } in
+			if Meta.has Meta.This v.v_meta then mk (TCast(e,None)) v.v_type e.epos else e
 		| TConst TThis ->
 			let l = read_local vthis in
 			l.i_read <- l.i_read + (if !in_loop then 2 else 1);
@@ -417,12 +418,15 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
 		| TParenthesis e1 ->
 			let e1 = map term e1 in
 			mk (TParenthesis e1) e1.etype e.epos
-		| TUnop ((Increment|Decrement),_,{ eexpr = TLocal v }) ->
-			(read_local v).i_write <- true;
-			Type.map_expr (map false) e
-		| TBinop ((OpAssign | OpAssignOp _),{ eexpr = TLocal v },_) ->
-			(read_local v).i_write <- true;
-			Type.map_expr (map false) e;
+		| TUnop ((Increment|Decrement) as op,flag,({ eexpr = TLocal v } as e1)) ->
+			let l = read_local v in
+			l.i_write <- true;
+			{e with eexpr = TUnop(op,flag,{e1 with eexpr = TLocal l.i_subst})}
+		| TBinop ((OpAssign | OpAssignOp _) as op,({ eexpr = TLocal v } as e1),e2) ->
+			let l = read_local v in
+			l.i_write <- true;
+			let e2 = map false e2 in
+			{e with eexpr = TBinop(op,{e1 with eexpr = TLocal l.i_subst},e2)}
 		| TFunction f ->
 			(match f.tf_args with [] -> () | _ -> has_vars := true);
 			let old = save_locals ctx and old_fun = !in_local_fun in
@@ -1267,6 +1271,11 @@ let inline_constructors ctx e =
 		| _ -> ());
 		vars := PMap.remove v.v_id !vars;
 	in
+	let rec skip_to_var e = match e.eexpr with
+		| TLocal v when v.v_id < 0 -> Some v
+		| TCast(e1,None) | TMeta(_,e1) | TParenthesis(e1) -> skip_to_var e1
+		| _ -> None
+	in
 	let rec find_locals e =
 		match e.eexpr with
 		| TVar (v,eo) ->
@@ -1315,12 +1324,16 @@ let inline_constructors ctx e =
 					end
 				| None -> ()
 			end
-		| TField({eexpr = TLocal v}, (FInstance(_, _, {cf_kind = Var _; cf_name = s}) | FAnon({cf_kind = Var _; cf_name = s}))) ->
-			()
-		| TArray ({eexpr = TLocal v},{eexpr = TConst (TInt i)}) when v.v_id < 0 ->
-			let (_,_,fields,_,_) = PMap.find (-v.v_id) !vars in
-			let i = Int32.to_int i in
-			if i < 0 || i >= List.length fields then cancel v
+		| TField(e1, (FInstance(_, _, {cf_kind = Var _; cf_name = s}) | FAnon({cf_kind = Var _; cf_name = s}))) ->
+			(match skip_to_var e1 with None -> find_locals e1 | Some _ -> ())
+		| TArray (e1,{eexpr = TConst (TInt i)}) ->
+			begin match skip_to_var e1 with
+				| None -> find_locals e1
+				| Some v ->
+					let (_,_,fields,_,_) = PMap.find (-v.v_id) !vars in
+					let i = Int32.to_int i in
+					if i < 0 || i >= List.length fields then cancel v
+			end
 		| TBinop((OpAssign | OpAssignOp _),e1,e2) ->
 			begin match e1.eexpr with
 	 			| TArray ({eexpr = TLocal v},{eexpr = TConst (TInt i)}) when v.v_id < 0 ->
@@ -1349,6 +1362,38 @@ let inline_constructors ctx e =
 		) vars in
 		let el_b = ref [] in
 		let append e = el_b := e :: !el_b in
+		let inline_field c cf v =
+			let (_, vars),el_init = PMap.find (-v.v_id) vfields in
+			(try
+				let v = PMap.find cf.cf_name vars in
+				mk (TLocal v) v.v_type e.epos
+			with Not_found ->
+				if (c.cl_path = ([],"Array") && cf.cf_name = "length") then begin
+					(* this can only occur for inlined array declarations, so we can use the statically known length here (issue #2568)*)
+					let l = PMap.fold (fun _ i -> i + 1) vars 0 in
+					mk (TConst (TInt (Int32.of_int l))) ctx.t.tint e.epos
+				end else
+					(* the variable was not set in the constructor, assume null *)
+					mk (TConst TNull) e.etype e.epos)
+		in
+		let inline_anon_field cf v =
+			let (_, vars),_ = PMap.find (-v.v_id) vfields in
+			(try
+				let v = PMap.find cf.cf_name vars in
+				mk (TLocal v) v.v_type e.epos
+			with Not_found ->
+				(* this could happen in untyped code, assume null *)
+				mk (TConst TNull) e.etype e.epos)
+		in
+		let inline_array_access i v =
+			let (_, vars),_ = PMap.find (-v.v_id) vfields in
+			(try
+				let v = PMap.find (Int32.to_string i) vars in
+				mk (TLocal v) v.v_type e.epos
+			with Not_found ->
+				(* probably out-of-bounds, assume null *)
+				mk (TConst TNull) e.etype e.epos)
+		in
 		let rec subst e =
 			match e.eexpr with
 			| TBlock el ->
@@ -1369,35 +1414,21 @@ let inline_constructors ctx e =
 				in
 				List.iter (fun (v,e) -> append (mk (TVar(v,Some (subst e))) ctx.t.tvoid e.epos)) (List.rev vars);
 				mk (TVar (v_first, Some (subst e_first))) ctx.t.tvoid e.epos
-			| TField ({ eexpr = TLocal v },FInstance (c,_,cf)) when v.v_id < 0 ->
-				let (_, vars),el_init = PMap.find (-v.v_id) vfields in
-				(try
-					let v = PMap.find cf.cf_name vars in
-					mk (TLocal v) v.v_type e.epos
-				with Not_found ->
-					if (c.cl_path = ([],"Array") && cf.cf_name = "length") then begin
-						(* this can only occur for inlined array declarations, so we can use the statically known length here (issue #2568)*)
-						let l = PMap.fold (fun _ i -> i + 1) vars 0 in
-						mk (TConst (TInt (Int32.of_int l))) ctx.t.tint e.epos
-					end else
-						(* the variable was not set in the constructor, assume null *)
-						mk (TConst TNull) e.etype e.epos)
-			| TArray ({eexpr = TLocal v},{eexpr = TConst (TInt i)}) when v.v_id < 0 ->
-				let (_, vars),_ = PMap.find (-v.v_id) vfields in
-				(try
-					let v = PMap.find (Int32.to_string i) vars in
-					mk (TLocal v) v.v_type e.epos
-				with Not_found ->
-					(* probably out-of-bounds, assume null *)
-					mk (TConst TNull) e.etype e.epos)
-			| TField({eexpr = TLocal v},FAnon(cf)) when v.v_id < 0 ->
-				let (_, vars),_ = PMap.find (-v.v_id) vfields in
-				(try
-					let v = PMap.find cf.cf_name vars in
-					mk (TLocal v) v.v_type e.epos
-				with Not_found ->
-					(* this could happen in untyped code, assume null *)
-					mk (TConst TNull) e.etype e.epos)
+			| TField (e1,FInstance (c,_,cf)) ->
+				begin match skip_to_var e1 with
+					| None -> Type.map_expr subst e
+					| Some v -> inline_field c cf v
+				end
+			| TArray (e1,{eexpr = TConst (TInt i)}) ->
+				begin match skip_to_var e1 with
+					| None -> Type.map_expr subst e
+					| Some v -> inline_array_access i v
+				end
+			| TField (e1,FAnon(cf)) ->
+				begin match skip_to_var e1 with
+					| None -> Type.map_expr subst e
+					| Some v -> inline_anon_field cf v
+				end
 			| _ ->
 				Type.map_expr subst e
 		in

+ 0 - 0
tests/unit/src/unit/issues/Issue2236.hx.disabled → tests/unit/src/unit/issues/Issue2236.hx


+ 2 - 3
tests/unit/src/unit/issues/Issue2645.hx

@@ -12,6 +12,5 @@ class Issue2645 extends unit.Test
 
 private abstract Maybe<T>(Null<T>) from T
 {
-	    public inline function or(defaultValue:T):T return this != null ? this : defaultValue;
-}
-
+	public inline function or(defaultValue:T):T return this != null ? this : defaultValue;
+}

+ 29 - 0
tests/unit/src/unit/issues/Issue3637.hx

@@ -0,0 +1,29 @@
+package unit.issues;
+
+private abstract Abs(String) to String {
+	inline public function new(s:String) this = s;
+	public function raw() return this;
+}
+
+class Issue3637 extends Test {
+	function test() {
+		var map = new Map<Abs, Int>();
+		map[new Abs("a")] = 1;
+		map[new Abs("b")] = 1;
+
+		var a:Array<Dynamic> = [];
+		for (key in map.keys()) {
+			a.push(key);
+			a.push(map[key]);
+		}
+		eq(4, a.length);
+		// TODO: some separate issue
+		#if !cs
+		t(Lambda.has(a, "a"));
+		t(Lambda.has(a, "b"));
+		t(Lambda.has(a, 1));
+		t(a.remove(1));
+		t(Lambda.has(a, 1));
+		#end
+	}
+}

+ 0 - 0
tests/unit/src/unit/issues/Issue3713.hx.disabled → tests/unit/src/unit/issues/Issue3713.hx


+ 13 - 0
tests/unit/src/unit/issues/Issue3892.hx

@@ -0,0 +1,13 @@
+package unit.issues;
+
+abstract MyBool(Bool) {
+    public inline function new(x:Bool) this = x;
+    public inline function toString():String return "asString: " + this;
+}
+
+class Issue3892 extends Test {
+	function test() {
+		var z = new MyBool(true);
+		eq("asString: true", z.toString());
+	}
+}