Browse Source

TAnon factory (prepare for #9185)

Aleksandr Kuzmenko 5 years ago
parent
commit
727dbc2718

+ 4 - 4
src/codegen/codegen.ml

@@ -58,7 +58,7 @@ let add_property_field com c =
 			let cf = mk_field n com.basic.tstring p null_pos in
 			PMap.add n cf fields,((n,null_pos,NoQuotes),Texpr.Builder.make_string com.basic v p) :: values
 		) (PMap.empty,[]) props in
-		let t = mk_anon fields in
+		let t = mk_anon ~fields (ref Closed) in
 		let e = mk (TObjectDecl values) t p in
 		let cf = mk_field "__properties__" t p null_pos in
 		cf.cf_expr <- Some e;
@@ -452,9 +452,9 @@ end
 let default_cast ?(vtmp="$t") com e texpr t p =
 	let api = com.basic in
 	let mk_texpr = function
-		| TClassDecl c -> TAnon { a_fields = PMap.empty; a_status = ref (Statics c) }
-		| TEnumDecl e -> TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }
-		| TAbstractDecl a -> TAnon { a_fields = PMap.empty; a_status = ref (AbstractStatics a) }
+		| TClassDecl c -> mk_anon (ref (Statics c))
+		| TEnumDecl e -> mk_anon (ref (EnumStatics e))
+		| TAbstractDecl a -> mk_anon (ref (AbstractStatics a))
 		| TTypeDecl _ -> assert false
 	in
 	let vtmp = alloc_var VGenerated vtmp e.etype e.epos in

+ 1 - 1
src/codegen/gencommon/enumToClass2.ml

@@ -85,7 +85,7 @@ module EnumToClass2Modf = struct
 		let e_pack, e_name = en.e_path in
 		let cl_enum_t = TInst (cl_enum, []) in
 		let cf_getTag_t = tfun [] basic.tstring in
-		let cf_getParams_ret = basic.tarray (mk_anon PMap.empty) in
+		let cf_getParams_ret = basic.tarray (mk_anon (ref Closed)) in
 		let cf_getParams_t = tfun [] cf_getParams_ret in
 		let static_ctors = ref [] in
 		let ctors_map = ref PMap.empty in

+ 1 - 1
src/codegen/gencommon/gencommon.ml

@@ -116,7 +116,7 @@ let follow_once t =
 	| _ ->
 		t
 
-let t_empty = TAnon({ a_fields = PMap.empty; a_status = ref Closed })
+let t_empty = mk_anon (ref Closed)
 
 let alloc_var n t = Type.alloc_var VGenerated n t null_pos
 

+ 2 - 4
src/codegen/gencommon/normalize.ml

@@ -54,10 +54,8 @@ let rec filter_param (stack:t list) t =
 	| TAbstract(a,tl) ->
 		TAbstract(a, List.map (filter_param stack) tl)
 	| TAnon a ->
-		TAnon {
-			a_fields = PMap.map (fun f -> { f with cf_type = filter_param stack f.cf_type }) a.a_fields;
-			a_status = a.a_status
-		}
+		let fields = PMap.map (fun f -> { f with cf_type = filter_param stack f.cf_type }) a.a_fields in
+		mk_anon ~fields a.a_status
 	| TFun(args,ret) ->
 		TFun(List.map (fun (n,o,t) -> (n,o,filter_param stack t)) args, filter_param stack ret)
 	| TDynamic _ ->

+ 1 - 1
src/context/typecore.ml

@@ -170,7 +170,7 @@ let unify_min ctx el = (!unify_min_ref) ctx el
 let unify_min_for_type_source ctx el src = (!unify_min_for_type_source_ref) ctx el src
 
 let make_static_this c p =
-	let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
+	let ta = mk_anon ~fields:c.cl_statics (ref (Statics c)) in
 	mk (TTypeExpr (TClassDecl c)) ta p
 
 let make_static_field_access c cf t p =

+ 5 - 9
src/core/tFunctions.ml

@@ -66,7 +66,9 @@ let mk_mono() = TMono (!monomorph_create_ref ())
 
 let rec t_dynamic = TDynamic t_dynamic
 
-let mk_anon fl = TAnon { a_fields = fl; a_status = ref Closed; }
+let mk_anon ?fields status =
+	let fields = match fields with Some fields -> fields | None -> PMap.empty in
+	TAnon { a_fields = fields; a_status = status; }
 
 (* We use this for display purposes because otherwise we never see the Dynamic type that
    is defined in StdTypes.hx. This is set each time a typer is created, but this is fine
@@ -242,10 +244,7 @@ let map loop t =
 				a.a_fields <- fields;
 				t
 			| _ ->
-				TAnon {
-					a_fields = fields;
-					a_status = a.a_status;
-				}
+				mk_anon ~fields a.a_status
 		end
 	| TLazy f ->
 		let ft = lazy_type f in
@@ -375,10 +374,7 @@ let apply_params ?stack cparams params t =
 					a.a_fields <- fields;
 					t
 				| _ ->
-					TAnon {
-						a_fields = fields;
-						a_status = a.a_status;
-					}
+					mk_anon ~fields a.a_status
 			end
 		| TLazy f ->
 			let ft = lazy_type f in

+ 2 - 8
src/core/tOther.ml

@@ -234,10 +234,7 @@ let class_module_type c = {
 	t_doc = None;
 	t_pos = c.cl_pos;
 	t_name_pos = null_pos;
-	t_type = TAnon {
-		a_fields = c.cl_statics;
-		a_status = ref (Statics c);
-	};
+	t_type = mk_anon ~fields:c.cl_statics (ref (Statics c));
 	t_private = true;
 	t_params = [];
 	t_using = [];
@@ -263,10 +260,7 @@ let abstract_module_type a tl = {
 	t_doc = None;
 	t_pos = a.a_pos;
 	t_name_pos = null_pos;
-	t_type = TAnon {
-		a_fields = PMap.empty;
-		a_status = ref (AbstractStatics a);
-	};
+	t_type = mk_anon (ref (AbstractStatics a));
 	t_private = true;
 	t_params = [];
 	t_using = [];

+ 5 - 5
src/core/texpr.ml

@@ -461,15 +461,15 @@ let foldmap f acc e =
 (* Collection of functions that return expressions *)
 module Builder = struct
 	let make_static_this c p =
-		let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
+		let ta = mk_anon ~fields:c.cl_statics (ref (Statics c)) in
 		mk (TTypeExpr (TClassDecl c)) ta p
 
 	let make_typeexpr mt pos =
 		let t =
 			match resolve_typedef mt with
-			| TClassDecl c -> TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) }
-			| TEnumDecl e -> TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }
-			| TAbstractDecl a -> TAnon { a_fields = PMap.empty; a_status = ref (AbstractStatics a) }
+			| TClassDecl c -> mk_anon ~fields:c.cl_statics (ref (Statics c))
+			| TEnumDecl e -> mk_anon (ref (EnumStatics e))
+			| TAbstractDecl a -> mk_anon (ref (AbstractStatics a))
 			| _ -> assert false
 		in
 		mk (TTypeExpr mt) t pos
@@ -575,7 +575,7 @@ let rec type_constant_value basic (e,p) =
 	| EParenthesis e ->
 		type_constant_value basic e
 	| EObjectDecl el ->
-		mk (TObjectDecl (List.map (fun (k,e) -> k,type_constant_value basic e) el)) (TAnon { a_fields = PMap.empty; a_status = ref Closed }) p
+		mk (TObjectDecl (List.map (fun (k,e) -> k,type_constant_value basic e) el)) (mk_anon (ref Closed)) p
 	| EArrayDecl el ->
 		mk (TArrayDecl (List.map (type_constant_value basic) el)) (basic.tarray t_dynamic) p
 	| _ ->

+ 2 - 2
src/generators/gencs.ml

@@ -690,7 +690,7 @@ let reserved = let res = Hashtbl.create 120 in
 		"remove"; "select"; "set"; "value"; "var"; "where"; "yield"; "await"];
 	res
 
-let dynamic_anon = TAnon( { a_fields = PMap.empty; a_status = ref Closed } )
+let dynamic_anon = mk_anon (ref Closed)
 
 let rec get_class_modifiers meta cl_type cl_access cl_modifiers =
 	match meta with
@@ -3004,7 +3004,7 @@ let generate con =
 
 		let empty_en = match get_type gen (["haxe";"lang"], "EmptyObject") with TEnumDecl e -> e | _ -> assert false in
 		let empty_ctor_type = TEnum(empty_en, []) in
-		let empty_en_expr = mk (TTypeExpr (TEnumDecl empty_en)) (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics empty_en) }) null_pos in
+		let empty_en_expr = mk (TTypeExpr (TEnumDecl empty_en)) (mk_anon (ref (EnumStatics empty_en))) null_pos in
 		let empty_ctor_expr = mk (TField (empty_en_expr, FEnum(empty_en, PMap.find "EMPTY" empty_en.e_constrs))) empty_ctor_type null_pos in
 		OverloadingConstructor.configure ~empty_ctor_type:empty_ctor_type ~empty_ctor_expr:empty_ctor_expr gen;
 

+ 2 - 2
src/generators/genjava.ml

@@ -936,7 +936,7 @@ let reserved = let res = Hashtbl.create 120 in
 		"void"; "volatile"; "while"; ];
 	res
 
-let dynamic_anon = TAnon( { a_fields = PMap.empty; a_status = ref Closed } )
+let dynamic_anon = mk_anon (ref Closed)
 
 let rec get_class_modifiers meta cl_type cl_access cl_modifiers =
 	match meta with
@@ -2324,7 +2324,7 @@ let generate con =
 
 	let empty_en = match get_type gen (["haxe";"lang"], "EmptyObject") with TEnumDecl e -> e | _ -> assert false in
 	let empty_ctor_type = TEnum(empty_en, []) in
-	let empty_en_expr = mk (TTypeExpr (TEnumDecl empty_en)) (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics empty_en) }) null_pos in
+	let empty_en_expr = mk (TTypeExpr (TEnumDecl empty_en)) (mk_anon (ref (EnumStatics empty_en))) null_pos in
 	let empty_ctor_expr = mk (TField (empty_en_expr, FEnum(empty_en, PMap.find "EMPTY" empty_en.e_constrs))) empty_ctor_type null_pos in
 	OverloadingConstructor.configure ~empty_ctor_type:empty_ctor_type ~empty_ctor_expr:empty_ctor_expr gen;
 

+ 1 - 1
src/generators/genpy.ml

@@ -38,7 +38,7 @@ module Utils = struct
 			abort (Printf.sprintf "Could not find type %s\n" (s_type_path path)) null_pos
 
 	let mk_static_field c cf p =
-			let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
+			let ta = mk_anon ~fields:c.cl_statics (ref (Statics c)) in
 			let ethis = mk (TTypeExpr (TClassDecl c)) ta p in
 			let t = monomorphs cf.cf_params cf.cf_type in
 			mk (TField (ethis,(FStatic (c,cf)))) t p

+ 2 - 2
src/typing/fields.ml

@@ -119,7 +119,7 @@ let field_type ctx c pl f p =
 		apply_params l monos f.cf_type
 
 let fast_enum_field e ef p =
-	let et = mk (TTypeExpr (TEnumDecl e)) (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }) p in
+	let et = mk (TTypeExpr (TEnumDecl e)) (mk_anon (ref (EnumStatics e))) p in
 	TField (et,FEnum (e,ef))
 
 let get_constructor ctx c params p =
@@ -523,7 +523,7 @@ let rec type_field cfg ctx e i p mode =
 			cf_kind = Var { v_read = AccNormal; v_write = (match mode with MSet -> AccNormal | MGet | MCall -> AccNo) };
 		} in
 		let x = ref Opened in
-		let t = TAnon { a_fields = PMap.add i f PMap.empty; a_status = x } in
+		let t = mk_anon ~fields:(PMap.add i f PMap.empty) x in
 		ctx.opened <- x :: ctx.opened;
 		Monomorph.bind r t;
 		field_access ctx mode f (FAnon f) (Type.field_type f) e p

+ 1 - 1
src/typing/finalization.ml

@@ -35,7 +35,7 @@ let get_main ctx types =
 			let ec = (match et with TClassDecl c -> c | _ -> assert false) in
 			let ef = PMap.find "run" ec.cl_statics in
 			let p = null_pos in
-			let et = mk (TTypeExpr et) (TAnon { a_fields = PMap.empty; a_status = ref (Statics ec) }) p in
+			let et = mk (TTypeExpr et) (mk_anon (ref (Statics ec))) p in
 			let call = mk (TCall (mk (TField (et,FStatic (ec,ef))) ef.cf_type p,[])) ctx.t.tvoid p in
 			mk (TBlock [main;call]) ctx.t.tvoid p
 		with Not_found ->

+ 2 - 2
src/typing/typeload.ml

@@ -295,7 +295,7 @@ let make_extension_type ctx tl =
 	in
 	let fields = List.fold_left mk_extension PMap.empty tl in
 	let tl = List.map (fun (t,_) -> t) tl in
-	let ta = TAnon { a_fields = fields; a_status = ref (Extend tl); } in
+	let ta = mk_anon ~fields (ref (Extend tl)) in
 	ta
 
 (* build an instance from a full type *)
@@ -460,7 +460,7 @@ and load_complex_type' ctx allow_display (t,p) =
 					error "Loop found in cascading signatures definitions. Please change order/import" p
 				| TAnon a2 ->
 					PMap.iter (fun _ cf -> ignore(is_redefined ctx cf a2.a_fields p)) a.a_fields;
-					TAnon { a_fields = (PMap.foldi PMap.add a.a_fields a2.a_fields); a_status = ref (Extend [t]); }
+					mk_anon ~fields:(PMap.foldi PMap.add a.a_fields a2.a_fields) (ref (Extend [t]))
 				| _ -> error "Can only extend structures" p
 			in
 			let loop (t,p) = match follow t with

+ 2 - 5
src/typing/typeloadModule.ml

@@ -193,7 +193,7 @@ let module_pass_1 ctx m tdecls loadp =
 	let com = ctx.com in
 	let decls = ref [] in
 	let make_path name priv p =
-		List.iter (fun (t2,(_,p2)) -> 
+		List.iter (fun (t2,(_,p2)) ->
 			if snd (t_path t2) = name then begin
 				display_error ctx ("Type name " ^ name ^ " is already defined in this module") p;
 				error "Previous declaration here" p2;
@@ -688,10 +688,7 @@ let init_module_type ctx context_init (decl,p) =
 		e.e_names <- List.rev !names;
 		e.e_extern <- e.e_extern;
 		e.e_type.t_params <- e.e_params;
-		e.e_type.t_type <- TAnon {
-			a_fields = !fields;
-			a_status = ref (EnumStatics e);
-		};
+		e.e_type.t_type <- mk_anon ~fields:!fields (ref (EnumStatics e));
 		if !is_flat then e.e_meta <- (Meta.FlatEnum,[],null_pos) :: e.e_meta;
 
 		if (ctx.com.platform = Java || ctx.com.platform = Cs) && not e.e_extern then

+ 4 - 4
src/typing/typer.ml

@@ -248,7 +248,7 @@ let rec unify_min_raise basic (el:texpr list) : t =
 				let t = try unify_min_raise basic el with Unify_error _ -> raise Not_found in
 				PMap.add n (mk_field n t (List.hd el).epos null_pos) acc
 			) fields PMap.empty in
-			TAnon { a_fields = fields; a_status = ref Closed }
+			mk_anon ~fields (ref Closed)
 		with Not_found ->
 			(* Second pass: Get all base types (interfaces, super classes and their interfaces) of most general type.
 			   Then for each additional type filter all types that do not unify. *)
@@ -1597,7 +1597,7 @@ and type_object_decl ctx fl with_type p =
 			end;
 			((n,pn,qs),e)
 		) fl in
-		let t = (TAnon { a_fields = !fields; a_status = ref Const }) in
+		let t = mk_anon ~fields:!fields (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) field_map [] with
 				| [] -> ()
@@ -1625,7 +1625,7 @@ and type_object_decl ctx fl with_type p =
 		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
+		mk (TObjectDecl (List.rev fields)) (mk_anon ~fields:types x) p
 	in
 	(match a with
 	| ODKPlain -> type_plain_fields()
@@ -1752,7 +1752,7 @@ and type_new ctx path el with_type force_inline p =
 		end
 	| TAbstract({a_impl = Some c} as a,tl) when not (Meta.has Meta.MultiType a.a_meta) ->
 		let el,cf,ct = build_constructor_call c tl in
-		let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
+		let ta = mk_anon ~fields:c.cl_statics (ref (Statics c)) in
 		let e = mk (TTypeExpr (TClassDecl c)) ta p in
 		let e = mk (TField (e,(FStatic (c,cf)))) ct p in
 		make_call ctx e el t ~force_inline p