浏览代码

Add @:using (#7462)

* [typer] add _using field to module types

* [typer] factor out static extension handling

* [typer] add @:using metadata

* [typer] respect `@:using` in `using_field`

* [display] make sure we pass the gama-test
Simon Krajewski 7 年之前
父节点
当前提交
fa49affb1f

+ 6 - 0
src/context/display/displayFields.ml

@@ -95,6 +95,12 @@ let collect_static_extensions ctx items e p =
 	| _ ->
 		let items = loop items ctx.m.module_using in
 		let items = loop items ctx.g.global_using in
+		let items = try
+			let mt = module_type_of_type e.etype in
+			loop items (t_infos mt).mt_using
+		with Exit ->
+			items
+		in
 		items
 
 let collect ctx e_ast e dk with_type p =

+ 6 - 0
src/core/ast.ml

@@ -859,6 +859,12 @@ let rec string_list_of_expr_path_raise (e,p) =
 	| EField (e,f) -> f :: string_list_of_expr_path_raise e
 	| _ -> raise Exit
 
+let rec string_pos_list_of_expr_path_raise (e,p) =
+	match e with
+	| EConst (Ident i) -> [i,p]
+	| EField (e,f) -> (f,p) :: string_pos_list_of_expr_path_raise e (* wrong p? *)
+	| _ -> raise Exit
+
 let expr_of_type_path (sl,s) p =
 	match sl with
 	| [] -> (EConst(Ident s),p)

+ 2 - 0
src/core/meta.ml

@@ -167,6 +167,7 @@ type strict_meta =
 	| UnifyMinDynamic
 	| Unreflective
 	| Unsafe
+	| Using
 	| Used
 	| Value
 	| Void
@@ -366,6 +367,7 @@ let get_info = function
 	| Unreflective -> ":unreflective",("",[Platform Cpp])
 	| Unsafe -> ":unsafe",("Declares a class, or a method with the C#'s 'unsafe' flag",[Platform Cs; UsedOnEither [TClass;TClassField]])
 	| Used -> ":used",("Internally used by DCE to mark a class or field as used",[UsedInternally])
+	| Using -> ":using",("Automatically uses the argument types as static extensions for the annotated type",[UsedOnEither [TClass;TEnum;TAbstract]])
 	| Value -> ":value",("Used to store default values for fields and function arguments",[UsedOn TClassField])
 	| Void -> ":void",("Use Cpp native 'void' return type",[Platform Cpp])
 	| Last -> assert false

+ 10 - 0
src/core/type.ml

@@ -215,6 +215,7 @@ and tinfos = {
 	mt_doc : Ast.documentation;
 	mutable mt_meta : metadata;
 	mt_params : type_params;
+	mutable mt_using : (tclass * pos) list;
 }
 
 and tclass = {
@@ -226,6 +227,7 @@ and tclass = {
 	mutable cl_doc : Ast.documentation;
 	mutable cl_meta : metadata;
 	mutable cl_params : type_params;
+	mutable cl_using : (tclass * pos) list;
 	(* do not insert any fields above *)
 	mutable cl_kind : tclass_kind;
 	mutable cl_extern : bool;
@@ -272,6 +274,7 @@ and tenum = {
 	e_doc : Ast.documentation;
 	mutable e_meta : metadata;
 	mutable e_params : type_params;
+	mutable e_using : (tclass * pos) list;
 	(* do not insert any fields above *)
 	e_type : tdef;
 	mutable e_extern : bool;
@@ -288,6 +291,7 @@ and tdef = {
 	t_doc : Ast.documentation;
 	mutable t_meta : metadata;
 	mutable t_params : type_params;
+	mutable t_using : (tclass * pos) list;
 	(* do not insert any fields above *)
 	mutable t_type : t;
 }
@@ -301,6 +305,7 @@ and tabstract = {
 	a_doc : Ast.documentation;
 	mutable a_meta : metadata;
 	mutable a_params : type_params;
+	mutable a_using : (tclass * pos) list;
 	(* do not insert any fields above *)
 	mutable a_ops : (Ast.binop * tclass_field) list;
 	mutable a_unops : (Ast.unop * unop_flag * tclass_field) list;
@@ -442,6 +447,7 @@ let mk_class m path pos name_pos =
 		cl_final = false;
 		cl_interface = false;
 		cl_params = [];
+		cl_using = [];
 		cl_super = None;
 		cl_implements = [];
 		cl_fields = PMap.empty;
@@ -521,6 +527,7 @@ let null_abstract = {
 	a_doc = None;
 	a_meta = [];
 	a_params = [];
+	a_using = [];
 	a_ops = [];
 	a_unops = [];
 	a_impl = None;
@@ -2789,6 +2796,7 @@ let class_module_type c = {
 	};
 	t_private = true;
 	t_params = [];
+	t_using = [];
 	t_meta = no_meta;
 }
 
@@ -2801,6 +2809,7 @@ let enum_module_type m path p  = {
 	t_type = mk_mono();
 	t_private = true;
 	t_params = [];
+	t_using = [];
 	t_meta = [];
 }
 
@@ -2816,6 +2825,7 @@ let abstract_module_type a tl = {
 	};
 	t_private = true;
 	t_params = [];
+	t_using = [];
 	t_meta = no_meta;
 }
 

+ 10 - 3
src/typing/fields.ml

@@ -273,16 +273,23 @@ let rec using_field ctx mode e i p =
 			if List.exists (function Has_extra_field _ -> true | _ -> false) el then check_constant_struct := true;
 			loop l
 	in
-	try loop ctx.m.module_using with Not_found ->
 	try
+		(* module using from `using Path` *)
+		loop ctx.m.module_using
+	with Not_found -> try
+		(* type using from `@:using(Path)` *)
+		let mt = module_type_of_type e.etype in
+		loop  (t_infos mt).mt_using
+	with Not_found | Exit -> try
+		(* global using *)
 		let acc = loop ctx.g.global_using in
 		(match acc with
 		| AKUsing (_,c,_,_) -> add_dependency ctx.m.curmod c.cl_module
 		| _ -> assert false);
 		acc
 	with Not_found ->
-	if not !check_constant_struct then raise Not_found;
-	remove_constant_flag e.etype (fun ok -> if ok then using_field ctx mode e i p else raise Not_found)
+		if not !check_constant_struct then raise Not_found;
+		remove_constant_flag e.etype (fun ok -> if ok then using_field ctx mode e i p else raise Not_found)
 
 (* Resolves field [i] on typed expression [e] using the given [mode]. *)
 let rec type_field ?(resume=false) ctx e i p mode =

+ 36 - 1
src/typing/typeload.ml

@@ -893,4 +893,39 @@ let handle_path_display ctx path p =
 					()
 			) m.m_types;
 		| (IDK,_),_ ->
-			()
+			()
+
+let handle_using ctx path p =
+	let t = match List.rev path with
+		| (s1,_) :: (s2,_) :: sl ->
+			if is_lower_ident s2 then { tpackage = (List.rev (s2 :: List.map fst sl)); tname = s1; tsub = None; tparams = [] }
+			else { tpackage = List.rev (List.map fst sl); tname = s2; tsub = Some s1; tparams = [] }
+		| (s1,_) :: sl ->
+			{ tpackage = List.rev (List.map fst sl); tname = s1; tsub = None; tparams = [] }
+		| [] ->
+			DisplayException.raise_fields (DisplayToplevel.collect ctx TKType NoValue) CRUsing None;
+	in
+	let types = (match t.tsub with
+		| None ->
+			let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
+			let types = List.filter (fun t -> not (t_infos t).mt_private) md.m_types in
+			types
+		| Some _ ->
+			let t = load_type_def ctx p t in
+			[t]
+	) in
+	(* delay the using since we need to resolve typedefs *)
+	let filter_classes types =
+		let rec loop acc types = match types with
+			| td :: l ->
+				(match resolve_typedef td with
+				| TClassDecl c | TAbstractDecl({a_impl = Some c}) ->
+					loop ((c,p) :: acc) l
+				| td ->
+					loop acc l)
+			| [] ->
+				acc
+		in
+		loop [] types
+	in
+	types,filter_classes

+ 11 - 0
src/typing/typeloadFields.ml

@@ -380,6 +380,17 @@ let build_module_def ctx mt meta fvars context_init fbuild =
 						()
 				end
 			)
+		| Meta.Using,el,p -> (fun () ->
+			List.iter (fun e ->
+				try
+					let path = List.rev (string_pos_list_of_expr_path_raise e) in
+					let types,filter_classes = handle_using ctx path (pos e) in
+					let ti = t_infos mt in
+					ti.mt_using <- (filter_classes types) @ ti.mt_using;
+				with Exit ->
+					error "dot path expected" (pos e)
+			) el;
+		) :: f_build,f_enum
 		| _ ->
 			f_build,f_enum
 	in

+ 6 - 34
src/typing/typeloadModule.ml

@@ -235,6 +235,7 @@ let module_pass_1 ctx m tdecls loadp =
 				e_doc = d.d_doc;
 				e_meta = d.d_meta;
 				e_params = [];
+				e_using = [];
 				e_private = priv;
 				e_extern = List.mem EExtern d.d_flags;
 				e_constrs = PMap.empty;
@@ -257,6 +258,7 @@ let module_pass_1 ctx m tdecls loadp =
 				t_doc = d.d_doc;
 				t_private = priv;
 				t_params = [];
+				t_using = [];
 				t_type = mk_mono();
 				t_meta = d.d_meta;
 			} in
@@ -281,6 +283,7 @@ let module_pass_1 ctx m tdecls loadp =
 				a_name_pos = pos d.d_name;
 				a_doc = d.d_doc;
 				a_params = [];
+				a_using = [];
 				a_meta = d.d_meta;
 				a_from = [];
 				a_to = [];
@@ -400,6 +403,7 @@ let init_module_type ctx context_init do_init (decl,p) =
 					t_doc = None;
 					t_meta = [];
 					t_params = (t_infos t).mt_params;
+					t_using = [];
 					t_type = f (List.map snd (t_infos t).mt_params);
 				} in
 				if ctx.is_display_file && DisplayPosition.encloses_display_position p then
@@ -476,41 +480,9 @@ let init_module_type ctx context_init do_init (decl,p) =
 			))
 	| EUsing path ->
 		check_path_display path p;
-		let t = match List.rev path with
-			| (s1,_) :: (s2,_) :: sl ->
-				if is_lower_ident s2 then { tpackage = (List.rev (s2 :: List.map fst sl)); tname = s1; tsub = None; tparams = [] }
-				else { tpackage = List.rev (List.map fst sl); tname = s2; tsub = Some s1; tparams = [] }
-			| (s1,_) :: sl ->
-				{ tpackage = List.rev (List.map fst sl); tname = s1; tsub = None; tparams = [] }
-			| [] ->
-				DisplayException.raise_fields (DisplayToplevel.collect ctx TKType NoValue) CRUsing None;
-		in
+		let types,filter_classes = handle_using ctx path p in
 		(* do the import first *)
-		let types = (match t.tsub with
-			| None ->
-				let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
-				let types = List.filter (fun t -> not (t_infos t).mt_private) md.m_types in
-				ctx.m.module_types <- (List.map (fun t -> t,p) types) @ ctx.m.module_types;
-				types
-			| Some _ ->
-				let t = load_type_def ctx p t in
-				ctx.m.module_types <- (t,p) :: ctx.m.module_types;
-				[t]
-		) in
-		(* delay the using since we need to resolve typedefs *)
-		let filter_classes types =
-			let rec loop acc types = match types with
-				| td :: l ->
-					(match resolve_typedef td with
-					| TClassDecl c | TAbstractDecl({a_impl = Some c}) ->
-						loop ((c,p) :: acc) l
-					| td ->
-						loop acc l)
-				| [] ->
-					acc
-			in
-			loop [] types
-		in
+		ctx.m.module_types <- (List.map (fun t -> t,p) types) @ ctx.m.module_types;
 		context_init := (fun() -> ctx.m.module_using <- filter_classes types @ ctx.m.module_using) :: !context_init
 	| EClass d ->
 		let c = (match get_type (fst d.d_name) with TClassDecl c -> c | _ -> assert false) in