From 3bcb82722edc327fc3b3f7f622d44a3a42b6e21c Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sun, 23 Sep 2018 08:55:28 +0200 Subject: [PATCH 1/5] [typer] add _using field to module types --- src/core/type.ml | 10 ++++++++++ src/typing/typeloadModule.ml | 4 ++++ 2 files changed, 14 insertions(+) diff --git a/src/core/type.ml b/src/core/type.ml index 43decb7c0ce..bff168f1c86 100644 --- a/src/core/type.ml +++ b/src/core/type.ml @@ -215,6 +215,7 @@ and tinfos = { mt_doc : Ast.documentation; mutable mt_meta : metadata; mt_params : type_params; + 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; } diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 1d9041d8ec5..d54d6ee4601 100644 --- a/src/typing/typeloadModule.ml +++ b/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 From 648dcfc57ede5ad0a171600d43b27f589932446d Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sun, 23 Sep 2018 09:08:58 +0200 Subject: [PATCH 2/5] [typer] factor out static extension handling --- src/typing/typeload.ml | 37 +++++++++++++++++++++++++++++++++++- src/typing/typeloadModule.ml | 36 ++--------------------------------- 2 files changed, 38 insertions(+), 35 deletions(-) diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index cc9dc478c19..eefa5d3ff7c 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -889,4 +889,39 @@ let handle_path_display ctx path p = () ) m.m_types; | (IDK,_),_ -> - () \ No newline at end of file + () + +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 \ No newline at end of file diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index d54d6ee4601..ce372e37c06 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -480,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 From b4276a67b8af9f4cbea51ad1bf7b4cb6e8811970 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sun, 23 Sep 2018 09:19:46 +0200 Subject: [PATCH 3/5] [typer] add @:using metadata --- src/core/ast.ml | 6 ++++++ src/core/meta.ml | 2 ++ src/core/type.ml | 2 +- src/typing/typeloadFields.ml | 11 +++++++++++ 4 files changed, 20 insertions(+), 1 deletion(-) diff --git a/src/core/ast.ml b/src/core/ast.ml index d892901482a..e99e769b5a1 100644 --- a/src/core/ast.ml +++ b/src/core/ast.ml @@ -855,6 +855,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) diff --git a/src/core/meta.ml b/src/core/meta.ml index 6d69713727a..61e7c0b6818 100644 --- a/src/core/meta.ml +++ b/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 diff --git a/src/core/type.ml b/src/core/type.ml index bff168f1c86..62063c6fcf4 100644 --- a/src/core/type.ml +++ b/src/core/type.ml @@ -215,7 +215,7 @@ and tinfos = { mt_doc : Ast.documentation; mutable mt_meta : metadata; mt_params : type_params; - mt_using : (tclass * pos) list; + mutable mt_using : (tclass * pos) list; } and tclass = { diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index 34d14be4a88..7289c0f0dc6 100644 --- a/src/typing/typeloadFields.ml +++ b/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 From e5c8949adc5dfac0831e8bcd8f608290cab27998 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sun, 23 Sep 2018 09:25:41 +0200 Subject: [PATCH 4/5] [typer] respect `@:using` in `using_field` --- src/typing/fields.ml | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/typing/fields.ml b/src/typing/fields.ml index 38cb25725ae..cbf38d2dbb0 100644 --- a/src/typing/fields.ml +++ b/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 = From da228f4a2509f53ceca29b2d3103323481168b4c Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sun, 23 Sep 2018 09:27:59 +0200 Subject: [PATCH 5/5] [display] make sure we pass the gama-test --- src/context/display/displayFields.ml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/context/display/displayFields.ml b/src/context/display/displayFields.ml index f36d59b086f..9672a32e108 100644 --- a/src/context/display/displayFields.ml +++ b/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 =