added @:structInit (see #4526)

ast.ml

@@ -160,6 +160,7 @@ module Meta = struct
 		| Strict
 		| Struct
 		| StructAccess
+		| StructInit
 		| SuppressWarnings
 		| This
 		| Throws

common.ml

@@ -491,6 +491,7 @@ module MetaInfo = struct
 		| Strict -> ":strict",("Used to declare a native C# attribute or a native Java metadata. Is type checked",[Platforms [Java;Cs]])
 		| Struct -> ":struct",("Marks a class definition as a struct",[Platform Cs; UsedOn TClass])
 		| StructAccess -> ":structAccess",("Marks an extern class as using struct access('.') not pointer('->')",[Platform Cpp; UsedOn TClass])
+		| StructInit -> ":structInit",("Allows to initialize the class with a structure that matches constructor parameters",[UsedOn TClass])
 		| SuppressWarnings -> ":suppressWarnings",("Adds a SuppressWarnings annotation for the generated Java class",[Platform Java; UsedOn TClass])
 		| Throws -> ":throws",("Adds a 'throws' declaration to the generated function",[HasParam "Type as String"; Platform Java; UsedOn TClassField])
 		| This -> ":this",("Internally used to pass a 'this' expression to macros",[Internal; UsedOn TExpr])

typer.ml

@@ -62,6 +62,11 @@ type access_kind =
 	| AKUsing of texpr * tclass * tclass_field * texpr
 	| AKAccess of tabstract * tparams * tclass * texpr * texpr
 
+type object_decl_kind =
+	| ODKWithStructure of tanon
+	| ODKWithClass of tclass * tparams
+	| ODKPlain
+
 let build_call_ref : (typer -> access_kind -> expr list -> with_type -> pos -> texpr) ref = ref (fun _ _ _ _ _ -> assert false)
 
 let mk_infos ctx p params =
@@ -3040,50 +3045,48 @@ and type_expr ctx (e,p) (with_type:with_type) =
 		let a = (match with_type with
 		| WithType t ->
 			let rec loop t =
-				(match follow t with
-				| TAnon a when not (PMap.is_empty a.a_fields) -> Some a
+				match follow t with
+				| TAnon a when not (PMap.is_empty a.a_fields) -> ODKWithStructure a
 				| TAbstract (a,pl) when not (Meta.has Meta.CoreType a.a_meta) ->
-					select_abstract_with a pl loop
+					let l = List.fold_left (fun acc t -> match loop (apply_params a.a_params pl t) with ODKPlain -> acc | t -> t :: acc) [] a.a_from in
+					let l = List.fold_left (fun acc (t,f) ->
+						match follow (Type.field_type f) with
+						| TFun ([_,_,v],t) ->
+							ignore(type_eq EqStrict t (TAbstract(a,pl))); (* unify monomorphs *)
+							(match loop v with
+							| ODKPlain -> acc
+							| t -> t :: acc)
+						| _ -> assert false
+					) l a.a_from_field in
+					(match l with
+					| [t] -> t (* only once choice possible *)
+					| _ -> ODKPlain)
 				| TDynamic t when (follow t != t_dynamic) ->
 					dynamic_parameter := Some t;
-					Some {
+					ODKWithStructure {
 						a_status = ref Closed;
 						a_fields = PMap.empty;
 					}
-				| _ -> None)
+				| TInst(c,tl) when Meta.has Meta.StructInit c.cl_meta ->
+					ODKWithClass(c,tl)
+				| _ ->
+					ODKPlain
 			in
 			loop t
-		| _ -> None
+		| _ ->
+			ODKPlain
 		) in
 		let wrap_quoted_meta e =
 			mk (TMeta((Meta.QuotedField,[],e.epos),e)) e.etype e.epos
 		in
-		(match a with
-		| None ->
-			let rec loop (l,acc) (f,e) =
-				let f,is_quoted,is_valid = Parser.unquote_ident f in
-				if PMap.mem f acc then error ("Duplicate field in object declaration : " ^ f) p;
-				let e = type_expr ctx e Value in
-				(match follow e.etype with TAbstract({a_path=[],"Void"},_) -> error "Fields of type Void are not allowed in structures" e.epos | _ -> ());
-				let cf = mk_field f e.etype e.epos in
-				let e = if is_quoted then wrap_quoted_meta e else e in
-				((f,e) :: l, if is_valid then begin
-					if String.length f > 0 && f.[0] = '$' then error "Field names starting with a dollar are not allowed" p;
-					PMap.add f cf acc
-				end else acc)
-			in
-			let fields , types = List.fold_left loop ([],PMap.empty) fl in
-			let x = ref Const in
-			ctx.opened <- x :: ctx.opened;
-			mk (TObjectDecl (List.rev fields)) (TAnon { a_fields = types; a_status = x }) p
-		| Some a ->
+		let type_fields field_map =
 			let fields = ref PMap.empty in
 			let extra_fields = ref [] in
 			let fl = List.map (fun (n, e) ->
 				let n,is_quoted,is_valid = Parser.unquote_ident n in
 				if PMap.mem n !fields then error ("Duplicate field in object declaration : " ^ n) p;
 				let e = try
-					let t = (match !dynamic_parameter with Some t -> t | None -> (PMap.find n a.a_fields).cf_type) in
+					let t = (match !dynamic_parameter with Some t -> t | None -> (PMap.find n field_map).cf_type) in
 					let e = type_expr ctx e (WithType t) in
 					let e = Codegen.AbstractCast.cast_or_unify ctx t e p in
 					(try type_eq EqStrict e.etype t; e with Unify_error _ -> mk (TCast (e,None)) t e.epos)
@@ -3102,7 +3105,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
 			) fl in
 			let t = (TAnon { a_fields = !fields; a_status = ref Const }) in
 			if not ctx.untyped then begin
-				(match PMap.foldi (fun n cf acc -> if not (Meta.has Meta.Optional cf.cf_meta) && not (PMap.mem n !fields) then n :: acc else acc) a.a_fields [] with
+				(match PMap.foldi (fun n cf acc -> if not (Meta.has Meta.Optional cf.cf_meta) && not (PMap.mem n !fields) then n :: acc else acc) field_map [] with
 					| [] -> ()
 					| [n] -> raise_or_display ctx [Unify_custom ("Object requires field " ^ n)] p
 					| nl -> raise_or_display ctx [Unify_custom ("Object requires fields: " ^ (String.concat ", " nl))] p);
@@ -3110,8 +3113,63 @@ and type_expr ctx (e,p) (with_type:with_type) =
 				| [] -> ()
 				| _ -> raise_or_display ctx (List.map (fun n -> has_extra_field t n) !extra_fields) p);
 			end;
+			t, fl
+		in
+		(match a with
+		| ODKPlain ->
+			let rec loop (l,acc) (f,e) =
+				let f,is_quoted,is_valid = Parser.unquote_ident f in
+				if PMap.mem f acc then error ("Duplicate field in object declaration : " ^ f) p;
+				let e = type_expr ctx e Value in
+				(match follow e.etype with TAbstract({a_path=[],"Void"},_) -> error "Fields of type Void are not allowed in structures" e.epos | _ -> ());
+				let cf = mk_field f e.etype e.epos in
+				let e = if is_quoted then wrap_quoted_meta e else e in
+				((f,e) :: l, if is_valid then begin
+					if String.length f > 0 && f.[0] = '$' then error "Field names starting with a dollar are not allowed" p;
+					PMap.add f cf acc
+				end else acc)
+			in
+			let fields , types = List.fold_left loop ([],PMap.empty) fl in
+			let x = ref Const in
+			ctx.opened <- x :: ctx.opened;
+			mk (TObjectDecl (List.rev fields)) (TAnon { a_fields = types; a_status = x }) p
+		| ODKWithStructure a ->
+			let t, fl = type_fields a.a_fields in
 			if !(a.a_status) <> Const then a.a_status := Closed;
-			mk (TObjectDecl fl) t p)
+			mk (TObjectDecl fl) t p
+		| ODKWithClass (c,tl) ->
+			let _,ctor = get_constructor ctx c tl p in
+			let args = match follow ctor.cf_type with
+				| TFun(args,_) -> args
+				| _ -> assert false
+			in
+			let fields = List.fold_left (fun acc (n,opt,t) ->
+				let f = mk_field n t ctor.cf_pos in
+				if opt then f.cf_meta <- [(Meta.Optional,[],ctor.cf_pos)];
+				PMap.add n f acc
+			) PMap.empty args in
+			let t,fl = type_fields fields in
+			let evars,fl,_ = List.fold_left (fun (evars,elocs,had_side_effect) (s,e) ->
+				begin match e.eexpr with
+				| TConst _ | TTypeExpr _ | TFunction _ ->
+					evars,(s,e) :: elocs,had_side_effect
+				| _ ->
+					if had_side_effect then begin
+						let v = gen_local ctx e.etype in
+						let ev = mk (TVar(v,Some e)) e.etype e.epos in
+						let eloc = mk (TLocal v) v.v_type e.epos in
+						(ev :: evars),((s,eloc) :: elocs),had_side_effect
+					end else
+						evars,(s,e) :: elocs,Optimizer.has_side_effect e
+				end
+			) ([],[],false) (List.rev fl) in
+			let el = List.map (fun (n,_,t) ->
+				try List.assoc n fl
+				with Not_found -> mk (TConst TNull) t p
+			) args in
+			let e = mk (TNew(c,tl,el)) (TInst(c,tl)) p in
+			mk (TBlock (List.rev (e :: (List.rev evars)))) e.etype e.epos
+		)
 	| EArrayDecl [(EFor _,_) | (EWhile _,_) as e] ->
 		let v = gen_local ctx (mk_mono()) in
 		let et = ref (EConst(Ident "null"),p) in