From 51c9f78b1f961ac34a80086b024e94e821aa6db3 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Wed, 8 May 2024 10:05:07 +0200 Subject: [PATCH] [hxb] only write imports to IMP (previously MDR) Also only load those imports when reading the whole module --- src/compiler/hxb/hxbData.ml | 6 +++--- src/compiler/hxb/hxbReader.ml | 15 ++++++++------ src/compiler/hxb/hxbWriter.ml | 29 ++++++++++++++------------- src/compiler/server.ml | 4 ++-- src/context/display/displayJson.ml | 2 +- src/context/display/importHandling.ml | 4 ++-- src/context/typecore.ml | 2 +- src/core/tPrinting.ml | 5 +++++ src/core/tType.ml | 1 + src/typing/macroContext.ml | 12 +++++------ src/typing/typeloadModule.ml | 8 ++++---- 11 files changed, 49 insertions(+), 39 deletions(-) diff --git a/src/compiler/hxb/hxbData.ml b/src/compiler/hxb/hxbData.ml index dce1543afa4..7936178f99a 100644 --- a/src/compiler/hxb/hxbData.ml +++ b/src/compiler/hxb/hxbData.ml @@ -27,7 +27,7 @@ type chunk_kind = | MDF (* module foward *) | MTF (* module types forward *) (* Module type references *) - | MDR (* module references *) + | IMP (* imports *) | CLR (* class references *) | ENR (* enum references *) | ABR (* abstract references *) @@ -68,7 +68,7 @@ let string_of_chunk_kind = function | DOC -> "DOC" | MDF -> "MDF" | MTF -> "MTF" - | MDR -> "MDR" + | IMP -> "IMP" | CLR -> "CLR" | ENR -> "ENR" | ABR -> "ABR" @@ -95,7 +95,7 @@ let chunk_kind_of_string = function | "DOC" -> DOC | "MDF" -> MDF | "MTF" -> MTF - | "MDR" -> MDR + | "IMP" -> IMP | "CLR" -> CLR | "ENR" -> ENR | "ABR" -> ABR diff --git a/src/compiler/hxb/hxbReader.ml b/src/compiler/hxb/hxbReader.ml index 7286185fa71..314ffa3fc3d 100644 --- a/src/compiler/hxb/hxbReader.ml +++ b/src/compiler/hxb/hxbReader.ml @@ -152,6 +152,7 @@ class hxb_reader (timers_enabled : bool) = object(self) val mutable api = Obj.magic "" + val mutable read_all = true val mutable current_module = null_module val mutable ch = BytesWithPosition.create (Bytes.create 0) @@ -1827,11 +1828,11 @@ class hxb_reader error ("Unexpected type where typedef was expected: " ^ (s_type_path (pack,tname))) )) - method read_mdr = + method read_imports = let length = read_uleb128 ch in for _ = 0 to length - 1 do let path = self#read_path in - ignore(api#resolve_module path) + if read_all then ignore(api#resolve_module path) done method read_mtf = @@ -1942,8 +1943,8 @@ class hxb_reader | MTF -> current_module.m_types <- self#read_mtf; api#add_module current_module; - | MDR -> - self#read_mdr; + | IMP -> + self#read_imports; | CLR -> self#read_clr; | ENR -> @@ -2011,10 +2012,11 @@ class hxb_reader close() method read_chunks (new_api : hxb_reader_api) (chunks : cached_chunks) = - fst (self#read_chunks_until new_api chunks EOM) + fst (self#read_chunks_until new_api chunks EOM true) - method read_chunks_until (new_api : hxb_reader_api) (chunks : cached_chunks) end_chunk = + method read_chunks_until (new_api : hxb_reader_api) (chunks : cached_chunks) end_chunk full_read = api <- new_api; + read_all <- full_read; let rec loop = function | (kind,data) :: chunks -> ch <- BytesWithPosition.create data; @@ -2027,6 +2029,7 @@ class hxb_reader method read (new_api : hxb_reader_api) (bytes : bytes) = api <- new_api; + read_all <- true; ch <- BytesWithPosition.create bytes; if (Bytes.to_string (read_bytes ch 3)) <> "hxb" then raise (HxbFailure "magic"); diff --git a/src/compiler/hxb/hxbWriter.ml b/src/compiler/hxb/hxbWriter.ml index cb9c74de1da..04dc89669de 100644 --- a/src/compiler/hxb/hxbWriter.ml +++ b/src/compiler/hxb/hxbWriter.ml @@ -468,7 +468,7 @@ module HxbWriter = struct let initial_size = match kind with | EOT | EOF | EOM -> 0 | MDF -> 16 - | MTF | MDR | CLR | END | ABD | ENR | ABR | TDR | EFR | CFR | AFD -> 64 + | MTF | IMP | CLR | END | ABD | ENR | ABR | TDR | EFR | CFR | AFD -> 64 | OFR | OFD | OBD | CLD | TDD | EFD -> 128 | STR | DOC -> 256 | CFD | EXD -> 512 @@ -2240,34 +2240,35 @@ module HxbWriter = struct end; begin - let deps = DynArray.create () in + let imports = DynArray.create () in PMap.iter (fun _ mdep -> - match mdep.md_kind with - | MCode | MExtern when mdep.md_sign = m.m_extra.m_sign -> - DynArray.add deps mdep.md_path; + match mdep.md_kind, mdep.md_origin with + | (MCode | MExtern), MDepFromImport when mdep.md_sign = m.m_extra.m_sign -> + DynArray.add imports mdep.md_path; | _ -> () ) m.m_extra.m_deps; - if DynArray.length deps > 0 then begin - start_chunk writer MDR; - Chunk.write_uleb128 writer.chunk (DynArray.length deps); + + if DynArray.length imports > 0 then begin + start_chunk writer IMP; + Chunk.write_uleb128 writer.chunk (DynArray.length imports); DynArray.iter (fun path -> write_path writer path - ) deps - end + ) imports + end; end; (* Note: this is only a start, and is still including a lot of dependencies *) (* that are not actually needed for signature only. *) let sig_deps = ref PMap.empty in - PMap.iter (fun id mdep -> match mdep.md_origin with - | MDepFromMacro -> sig_deps := PMap.add id mdep !sig_deps; - | _ -> () - ) m.m_extra.m_deps; List.iter (fun mdep -> let dep = {md_sign = mdep.m_extra.m_sign; md_path = mdep.m_path; md_kind = mdep.m_extra.m_kind; md_origin = MDepFromTyping} in sig_deps := PMap.add mdep.m_id dep !sig_deps; ) writer.sig_deps; + PMap.iter (fun id mdep -> match mdep.md_kind, mdep.md_origin with + | (MCode | MExtern), MDepFromMacro -> sig_deps := PMap.add id mdep !sig_deps; + | _ -> () + ) m.m_extra.m_deps; m.m_extra.m_sig_deps <- Some !sig_deps; start_chunk writer EOT; diff --git a/src/compiler/server.ml b/src/compiler/server.ml index c4b2a1ba81e..fd191bde7b4 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -427,7 +427,7 @@ class hxb_reader_api_server let full_restore = com.is_macro_context || com.display.dms_full_typing || is_display_file in let f_next chunks until = let t_hxb = Timer.timer ["server";"module cache";"hxb read"] in - let r = reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) chunks until in + let r = reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) chunks until full_restore in t_hxb(); r in @@ -591,7 +591,7 @@ and type_module sctx com delay mpath p = in let f_next chunks until = let t_hxb = Timer.timer ["server";"module cache";"hxb read"] in - let r = reader#read_chunks_until api chunks until in + let r = reader#read_chunks_until api chunks until full_restore in t_hxb(); r in diff --git a/src/context/display/displayJson.ml b/src/context/display/displayJson.ml index 8c85e6aa722..15f7339c893 100644 --- a/src/context/display/displayJson.ml +++ b/src/context/display/displayJson.ml @@ -140,7 +140,7 @@ class hxb_reader_api_com with Not_found -> let mc = cc#get_hxb_module m_path in let reader = new HxbReader.hxb_reader mc.mc_path com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined com Define.HxbTimes) in - fst (reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) mc.mc_chunks (if headers_only then MTF else EOM)) + fst (reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) mc.mc_chunks (if headers_only then MTF else EOM) (not headers_only)) method basic_types = com.basic diff --git a/src/context/display/importHandling.ml b/src/context/display/importHandling.ml index d0ac35235ff..92fabf2b902 100644 --- a/src/context/display/importHandling.ml +++ b/src/context/display/importHandling.ml @@ -81,7 +81,7 @@ let init_import ctx path mode p = | (tname,p2) :: rest -> let p1 = (match pack with [] -> p2 | (_,p1) :: _ -> p1) in let p_type = punion p1 p2 in - let md = ctx.g.do_load_module ctx (List.map fst pack,tname) p_type in + let md = ctx.g.do_load_module ~origin:MDepFromImport ctx (List.map fst pack,tname) p_type in let types = md.m_types in let not_private mt = not (t_infos mt).mt_private in let error_private p = raise_typing_error "Importing private declarations from a module is not allowed" p in @@ -267,7 +267,7 @@ let handle_using ctx path p = in let types = (match t.tsub with | None -> - let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in + let md = ctx.g.do_load_module ~origin:MDepFromImport ctx (t.tpackage,t.tname) p in let types = List.filter (fun t -> not (t_infos t).mt_private) md.m_types in Option.map_default (fun c -> (TClassDecl c) :: types) types md.m_statics | Some _ -> diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 7c59767d5ab..d1307bd3c4f 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -127,7 +127,7 @@ type typer_globals = { (* api *) do_macro : typer -> macro_mode -> path -> string -> expr list -> pos -> macro_result; do_load_macro : typer -> bool -> path -> string -> pos -> ((string * bool * t) list * t * tclass * Type.tclass_field); - do_load_module : typer -> path -> pos -> module_def; + do_load_module : ?origin:module_dep_origin -> typer -> path -> pos -> module_def; do_load_type_def : typer -> pos -> type_path -> module_type; get_build_info : typer -> module_type -> pos -> build_info; do_format_string : typer -> string -> pos -> Ast.expr; diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml index 2ce6843485f..c868a97ed21 100644 --- a/src/core/tPrinting.ml +++ b/src/core/tPrinting.ml @@ -612,6 +612,11 @@ module Printer = struct | MExtern -> "MExtern" | MImport -> "MImport" + let s_module_origin = function + | MDepFromImport -> "MDepFromImport" + | MDepFromTyping -> "MDepFromTyping" + | MDepFromMacro -> "MDepFromMacro" + let s_module_tainting_reason = function | CheckDisplayFile -> "check_display_file" | ServerInvalidate -> "server/invalidate" diff --git a/src/core/tType.ml b/src/core/tType.ml index 5caba0b383b..eaef3eeca82 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -403,6 +403,7 @@ and module_def_display = { and module_dep_origin = | MDepFromTyping + | MDepFromImport | MDepFromMacro and module_dep = { diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index 2355d6a919c..70f074923f0 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -400,7 +400,7 @@ let make_macro_api ctx mctx p = MacroApi.get_module = (fun s -> typing_timer ctx false (fun ctx -> let path = parse_path s in - let m = List.map type_of_module_type (TypeloadModule.load_module ctx path p).m_types in + let m = List.map type_of_module_type (TypeloadModule.load_module ~origin:MDepFromMacro ctx path p).m_types in m ) ); @@ -466,7 +466,7 @@ let make_macro_api ctx mctx p = | _ -> false in let add is_macro ctx = - let mdep = Option.map_default (fun s -> TypeloadModule.load_module ctx (parse_path s) pos) ctx.m.curmod mdep in + let mdep = Option.map_default (fun s -> TypeloadModule.load_module ~origin:MDepFromMacro ctx (parse_path s) pos) ctx.m.curmod mdep in let mnew = TypeloadModule.type_module ctx.com ctx.g ~dont_check_path:(has_native_meta) m (Path.UniqueKey.lazy_path mdep.m_extra.m_file) [tdef,pos] pos in mnew.m_extra.m_kind <- if is_macro then MMacro else MFake; add_dependency mnew mdep MDepFromMacro; @@ -506,7 +506,7 @@ let make_macro_api ctx mctx p = MacroApi.module_dependency = (fun mpath file -> let m = typing_timer ctx false (fun ctx -> let old_deps = ctx.m.curmod.m_extra.m_deps in - let m = TypeloadModule.load_module ctx (parse_path mpath) p in + let m = TypeloadModule.load_module ~origin:MDepFromMacro ctx (parse_path mpath) p in ctx.m.curmod.m_extra.m_deps <- old_deps; m ) in @@ -582,8 +582,8 @@ let make_macro_api ctx mctx p = let init_macro_interp mctx mint = let p = null_pos in - ignore(TypeloadModule.load_module mctx (["haxe";"macro"],"Expr") p); - ignore(TypeloadModule.load_module mctx (["haxe";"macro"],"Type") p); + ignore(TypeloadModule.load_module ~origin:MDepFromMacro mctx (["haxe";"macro"],"Expr") p); + ignore(TypeloadModule.load_module ~origin:MDepFromMacro mctx (["haxe";"macro"],"Type") p); Interp.init mint; macro_interp_cache := Some mint @@ -739,7 +739,7 @@ let load_macro_module mctx com cpath display p = (* Temporarily enter display mode while typing the macro. *) let old = mctx.com.display in if display then mctx.com.display <- com.display; - let mloaded = TypeloadModule.load_module mctx m p in + let mloaded = TypeloadModule.load_module ~origin:MDepFromMacro mctx m p in mctx.m <- { curmod = mloaded; import_resolution = new resolution_list ["import";s_type_path cpath]; diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 2cab79cde4b..98f11246d9e 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -289,7 +289,7 @@ module ModuleLevel = struct let decls = try let r = com.parser_cache#find path in let mimport = com.module_lut#find ([],path) in - if mimport.m_extra.m_kind <> MFake then add_dependency m mimport MDepFromTyping; + if mimport.m_extra.m_kind <> MFake then add_dependency m mimport MDepFromImport; r with Not_found -> if Sys.file_exists path then begin @@ -300,7 +300,7 @@ module ModuleLevel = struct List.iter (fun (d,p) -> match d with EImport _ | EUsing _ -> () | _ -> raise_typing_error "Only import and using is allowed in import.hx files" p) r; let m_import = make_import_module path r in add_module com m_import p; - add_dependency m m_import MDepFromTyping; + add_dependency m m_import MDepFromImport; r end else begin let r = [] in @@ -845,9 +845,9 @@ and load_module' com g m p = let is_extern = !is_extern in type_module com g m file ~is_extern decls p -let load_module ctx m p = +let load_module ?(origin:module_dep_origin = MDepFromTyping) ctx m p = let m2 = load_module' ctx.com ctx.g m p in - add_dependency ~skip_postprocess:true ctx.m.curmod m2 MDepFromTyping; + add_dependency ~skip_postprocess:true ctx.m.curmod m2 origin; if ctx.pass = PTypeField then flush_pass ctx.g PConnectField ("load_module",fst m @ [snd m]); m2