re-implement constructor inlining

optimizer.ml

@@ -86,7 +86,7 @@ let api_inline2 com c field params p =
 			None)
 	| ([],"Std"),"string",[{ eexpr = TIf (_,{ eexpr = TConst (TString _)},Some { eexpr = TConst (TString _) }) } as e] ->
 		Some e
- 	| ([],"Std"),"string",[{ eexpr = TLocal v | TField({ eexpr = TLocal v },_) } as ev] when (com.platform = Js || com.platform = Flash) && not (Meta.has Meta.CompilerGenerated v.v_meta) ->
+	| ([],"Std"),"string",[{ eexpr = TLocal v | TField({ eexpr = TLocal v },_) } as ev] when (com.platform = Js || com.platform = Flash) && not (Meta.has Meta.CompilerGenerated v.v_meta) ->
 		let pos = ev.epos in
 		let stringv() =
 			let to_str = mk (TBinop (Ast.OpAdd, mk (TConst (TString "")) com.basic.tstring pos, ev)) com.basic.tstring pos in
@@ -597,7 +597,7 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
 		if not has_params then
 			Some e
 		else
- 			let mt = map_type cf.cf_type in
+			let mt = map_type cf.cf_type in
 			let unify_func () = unify_raise ctx mt (TFun (List.map (fun e -> "",false,e.etype) params,tret)) p in
 			(match follow ethis.etype with
 			| TAnon a -> (match !(a.a_status) with
@@ -1253,14 +1253,20 @@ let rec make_constant_expression ctx ?(concat_strings=false) e =
 	We replace the variables by their fields lists, and the corresponding fields accesses as well
 *)
 
-type inline_kind =
-	| IKCtor of tfunc * tclass_field * tclass * t list * texpr list * texpr list
-	| IKArray of texpr list * t
-	| IKStructure of (string * texpr) list
-	| IKNone
+type inline_info_kind =
+	| IKCtor of tclass_field * bool
+	| IKStructure
+	| IKArray of int
+
+type inline_info = {
+	ii_var : tvar;
+	ii_expr : texpr;
+	ii_kind : inline_info_kind;
+	mutable ii_fields : (string,tvar) PMap.t;
+}
 
 let inline_constructors ctx e =
-	let vars = ref PMap.empty in
+	let vars = ref IntMap.empty in
 	let is_valid_ident s =
 		try
 			if String.length s = 0 then raise Exit;
@@ -1278,220 +1284,214 @@ let inline_constructors ctx e =
 		with Exit ->
 			false
 	in
-	let rec get_inline_ctor_info e = match e.eexpr with
-		| TNew ({ cl_constructor = Some ({ cf_kind = Method MethInline; cf_expr = Some { eexpr = TFunction f } } as cst) } as c,tl,pl) ->
-			IKCtor (f,cst,c,tl,pl,[])
-		| TObjectDecl [] | TArrayDecl [] ->
-			IKNone
-		| TArrayDecl el ->
-			begin match follow e.etype with
-				| TInst({cl_path = [],"Array"},[t]) ->
-					IKArray(el,t)
+	let cancel v p =
+		try
+			let ii = IntMap.find v.v_id !vars in
+			vars := IntMap.remove v.v_id !vars;
+			v.v_id <- -v.v_id;
+			begin match ii.ii_kind with
+				| IKCtor(cf,true) ->
+					display_error ctx "Extern constructor could not be inlined" p;
+					error "Variable is used here" p;
 				| _ ->
-					IKNone
-			end
-		| TObjectDecl fl ->
-			if (List.exists (fun (s,_) -> not (is_valid_ident s)) fl) then
-				IKNone
-			else
-				IKStructure fl
-		| TCast(e,None) | TParenthesis e ->
-			get_inline_ctor_info e
-		| TBlock el ->
-			begin match List.rev el with
-				| e :: el ->
-					begin match get_inline_ctor_info e with
-						| IKCtor(f,cst,c,tl,pl,e_init) ->
-							IKCtor(f,cst,c,tl,pl,(List.rev el) @ e_init)
-						| _ ->
-							IKNone
-					end
-				| [] ->
-					IKNone
-			end
-		| _ ->
-			IKNone
-	in
-	let check_field v s e t =
-		let (a,b,fields,c,d) = PMap.find (-v.v_id) !vars in
-		if not (List.exists (fun (s2,_,_) -> s = s2) fields) then
-			vars := PMap.add (-v.v_id) (a,b,(s,e,t) :: fields,c,d) !vars
+					()
+			end;
+		with Not_found ->
+			()
 	in
-	let cancel v =
+	let add v e kind =
+		let ii = {
+			ii_var = v;
+			ii_fields = PMap.empty;
+			ii_expr = e;
+			ii_kind = kind
+		} in
 		v.v_id <- -v.v_id;
-		(* error if the constructor is extern *)
-		(match PMap.find v.v_id !vars with
-		| _,_,_,true,p ->
-			display_error ctx "Extern constructor could not be inlined" p;
-			error "Variable is used here" e.epos
-		| _ -> ());
-		vars := PMap.remove v.v_id !vars;
+		vars := IntMap.add v.v_id ii !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
+	let int_field_name i =
+		if i < 0 then "n" ^ (string_of_int (-i))
+		else (string_of_int i)
 	in
-	let rec find_locals e =
-		match e.eexpr with
-		| TVar (v,eo) ->
-			Type.iter find_locals e;
-			begin match eo with
-				| Some n ->
-					begin match get_inline_ctor_info n with
-					| IKCtor (f,cst,c,tl,pl,el_init) when type_iseq v.v_type n.etype ->
-						(* inline the constructor *)
-						(match (try type_inline ctx cst f (mk (TLocal v) (TInst (c,tl)) n.epos) pl ctx.t.tvoid None n.epos true with Error (Custom _,_) -> None) with
-						| None -> ()
-						| Some ecst ->
-							let assigns = ref [] in
-							(* add field inits here because the filter has not run yet (issue #2336) *)
-							List.iter (fun cf -> match cf.cf_kind,cf.cf_expr with
-								| Var _,Some e -> assigns := (cf.cf_name,e,cf.cf_type) :: !assigns
-								| _ -> ()
-							) c.cl_ordered_fields;
-							(* make sure we only have v.field = expr calls *)
-							let rec get_assigns e =
-								match e.eexpr with
-								| TBlock el ->
-									List.iter get_assigns el
-								| TBinop (OpAssign, { eexpr = TField ({ eexpr = TLocal vv },FInstance(_,_,cf)); etype = t }, e) when v == vv ->
-									assigns := (cf.cf_name,e,t) :: !assigns
-								| _ ->
-									raise Exit
-							in
-							try
-								get_assigns ecst;
-								(* mark variable as candidate for inlining *)
-								vars := PMap.add v.v_id (v,el_init,List.rev !assigns,c.cl_extern || Meta.has Meta.Extern cst.cf_meta,n.epos) !vars;
-								v.v_id <- -v.v_id; (* mark *)
-								(* recurse with the constructor code which will be inlined here *)
-								find_locals ecst
-							with Exit ->
-								())
-					| IKArray (el,t) ->
-						vars := PMap.add v.v_id (v,[],ExtList.List.mapi (fun i e -> string_of_int i,e,t) el, false, n.epos) !vars;
-						v.v_id <- -v.v_id;
-					| IKStructure fl ->
-						vars := PMap.add v.v_id (v,[],List.map (fun (s,e) -> s,e,e.etype) fl, false, n.epos) !vars;
-						v.v_id <- -v.v_id;
-					| _ ->
+	let rec find_locals e = match e.eexpr with
+		| TVar(v,Some e1) ->
+			find_locals e1;
+			let rec loop el_init e1 = match e1.eexpr with
+ 				| TBlock el ->
+					List.iter find_locals el;
+					begin match List.rev el with
+					| e1 :: el ->
+						loop el e1
+					| [] ->
 						()
 					end
-				| _ -> ()
-			end
-		| 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 ->
-					check_field v (Int32.to_string i) e2 e2.etype
-				| TField({eexpr = TLocal v}, (FInstance(_, _, {cf_kind = Var _; cf_name = s}) | FAnon({cf_kind = Var _; cf_name = s}))) when v.v_id < 0 ->
-					check_field v s e2 e2.etype
+				| TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some ({eexpr = TFunction tf})} as cf)} as c,tl,pl) when type_iseq v.v_type e1.etype->
+					begin match type_inline ctx cf tf (mk (TLocal v) (TInst (c,tl)) e1.epos) pl ctx.t.tvoid None e1.epos true with
+					| Some e ->
+						(* add field inits here because the filter has not run yet (issue #2336) *)
+						let ev = mk (TLocal v) v.v_type e.epos in
+						let el_init = List.fold_left (fun acc cf -> match cf.cf_kind,cf.cf_expr with
+							| Var _,Some e ->
+								let ef = mk (TField(ev,FInstance(c,tl,cf))) e.etype e.epos in
+								let e = mk (TBinop(OpAssign,ef,e)) e.etype e.epos in
+								e :: acc
+							| _ -> acc
+						) el_init c.cl_ordered_fields in
+						let e = match el_init with
+							| [] -> e
+							| _ -> mk (TBlock (List.rev (e :: el_init))) e.etype e.epos
+						in
+						add v e (IKCtor(cf,c.cl_extern || Meta.has Meta.Extern cf.cf_meta));
+						find_locals e
+					| None ->
+						()
+					end
+				| TObjectDecl fl ->
+					begin try
+						let ev = mk (TLocal v) v.v_type e.epos in
+						let el = List.fold_left (fun acc (s,e) ->
+							if not (is_valid_ident s) then raise Exit;
+							let ef = mk (TField(ev,FDynamic s)) e.etype e.epos in
+							let e = mk (TBinop(OpAssign,ef,e)) e.etype e.epos in
+							e :: acc
+						) el_init fl in
+						let e = mk (TBlock (List.rev el)) ctx.t.tvoid e.epos in
+						add v e IKStructure
+					with Exit ->
+						()
+					end
+				| TArrayDecl el ->
+					let ev = mk (TLocal v) v.v_type e.epos in
+					let el,_ = List.fold_left (fun (acc,i) e ->
+						let ef = mk (TField(ev,FDynamic (string_of_int i))) e.etype e.epos in
+						let e = mk (TBinop(OpAssign,ef,e)) e.etype e.epos in
+						e :: acc,i + 1
+					) (el_init,0) el in
+					let e = mk (TBlock (List.rev el)) ctx.t.tvoid e.epos in
+					add v e (IKArray (List.length el))
+				| TCast(e1,None) | TParenthesis e1 ->
+					loop el_init e1
 				| _ ->
-					find_locals e1
-			end;
+					()
+			in
+			loop [] e1
+		| TBinop(OpAssign,{eexpr = TField({eexpr = TLocal v},_)},e2) when v.v_id < 0 ->
 			find_locals e2
+		| TField({eexpr = TLocal v},fa) when v.v_id < 0 ->
+			begin match extract_field fa with
+			| Some {cf_kind = Var _} -> ()
+			| _ -> cancel v e.epos
+			end
+		| TArray({eexpr = TLocal v},{eexpr = TConst (TInt i)}) when v.v_id < 0 ->
+			let i = Int32.to_int i in
+			begin try
+				let ii = IntMap.find v.v_id !vars in
+				let l = match ii.ii_kind with
+					| IKArray l -> l
+					| _ -> raise Not_found
+				in
+				if i < 0 || i >= l then raise Not_found;
+			with Not_found ->
+				cancel v e.epos
+			end
 		| TLocal v when v.v_id < 0 ->
-			cancel v
+			cancel v e.epos;
 		| _ ->
 			Type.iter find_locals e
 	in
 	find_locals e;
-	let vars = !vars in
-	if PMap.is_empty vars then
-		e
-	else begin
-		let vfields = PMap.map (fun (v,el_init,assigns,_,_) ->
-			(List.fold_left (fun (acc,map) (name,e,t) ->
-				let vf = alloc_var (v.v_name ^ "_" ^ name) t in
-				((vf,e) :: acc, PMap.add name vf map)
-			) ([],PMap.empty) assigns),el_init
-		) 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
+	(* Pass 2 *)
+	let get_field_var v s =
+		let ii = IntMap.find v.v_id !vars in
+		PMap.find s ii.ii_fields
+	in
+	let add_field_var v s t =
+		let ii = IntMap.find v.v_id !vars in
+		let v' = alloc_var (Printf.sprintf "%s_%s" v.v_name s) t in
+		ii.ii_fields <- PMap.add s v' ii.ii_fields;
+		v'
+	in
+	let inline v p =
+		try
+			let ii = IntMap.find v.v_id !vars in
+			Some ii.ii_expr
+		with Not_found ->
+			None
+	in
+	let assign_or_declare v name e2 t p =
+		 try
+			let v = get_field_var v name in
+			let e1 = mk (TLocal v) t p in
+			{e with eexpr = TBinop(OpAssign,e1,e2)}
+		with Not_found ->
+			let v = add_field_var v name t in
+			mk (TVar(v,Some e2)) ctx.t.tvoid e.epos
+	in
+	let use_local_or_null v name t p =
+		try
+			let v' = get_field_var v name in
+			mk (TLocal v') t p
+		with Not_found -> try
+			if name <> "length" then raise Not_found;
+			let ii = IntMap.find v.v_id !vars in
+			begin match ii.ii_kind with
+			| IKArray l -> mk (TConst (TInt (Int32.of_int l))) ctx.t.tint p
+			| _ -> raise Not_found
+			end
+		with Not_found ->
+			mk (TConst TNull) t p
+	in
+	let flatten e =
+		let el = ref [] in
+		let rec loop e = match e.eexpr with
 			| TBlock el ->
-				let old = !el_b in
-				el_b := [];
-				List.iter (fun e -> append (subst e)) el;
-				let n = !el_b in
-				el_b := old;
-				{e with eexpr = TBlock (List.rev n)}
-			| TVar (v,Some e) when v.v_id < 0 ->
-				let (vars, _),el_init = PMap.find (-v.v_id) vfields in
-				List.iter (fun e ->
-					append (subst e)
-				) el_init;
-				let (v_first,e_first),vars = match vars with
-					| v :: vl -> v,vl
-					| [] -> assert false
-				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 (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
+				List.iter loop el
 			| _ ->
-				Type.map_expr subst e
+				el := e :: !el
 		in
-		let e = (try subst e with Not_found -> assert false) in
-		PMap.iter (fun _ (v,_,_,_,_) -> v.v_id <- -v.v_id) vars;
-		e
-	end
+		loop e;
+		let e = mk (TBlock (List.rev !el)) e.etype e.epos in
+		mk (TMeta((Meta.MergeBlock,[],e.epos),e)) e.etype e.epos
+	in
+	let rec loop e = match e.eexpr with
+		| TVar(v,_) when v.v_id < 0 ->
+			begin match inline v e.epos with
+			| Some e ->
+				let e = flatten e in
+				loop e
+			| None ->
+				cancel v e.epos;
+				e
+			end
+		| TBinop(OpAssign,({eexpr = TField({eexpr = TLocal v},fa)} as e1),e2) when v.v_id < 0 ->
+			let e2 = loop e2 in
+			assign_or_declare v (field_name fa) e2 e1.etype e.epos
+		| TField({eexpr = TLocal v},fa) when v.v_id < 0 ->
+			use_local_or_null v (field_name fa) e.etype e.epos
+		| TBinop(OpAssign,({eexpr = TArray({eexpr = TLocal v},{eexpr = TConst (TInt i)})} as e1),e2) when v.v_id < 0 ->
+			let e2 = loop e2 in
+			let name = int_field_name (Int32.to_int i) in
+			assign_or_declare v name e2 e1.etype e.epos
+		| TArray({eexpr = TLocal v},{eexpr = TConst (TInt i)}) when v.v_id < 0	->
+			use_local_or_null v (int_field_name (Int32.to_int i)) e.etype e.epos
+		| TBlock el ->
+			let rec block acc el = match el with
+				| e1 :: el ->
+					begin match loop e1 with
+					| {eexpr = TMeta((Meta.MergeBlock,_,_),{eexpr = TBlock el2})} ->
+						let acc = block acc el2 in
+						block acc el
+					| e -> block (e :: acc) el
+					end
+				| [] ->
+					acc
+			in
+			let el = block [] el in
+			mk (TBlock (List.rev el)) e.etype e.epos
+		| _ ->
+			Type.map_expr loop e
+	in
+	loop e
 
 (* ---------------------------------------------------------------------- *)
 (* COMPLETION *)