From e18701535755446c6c8bfda09d36bfea0957404e Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Thu, 21 Sep 2023 15:45:10 +0200 Subject: [PATCH] Update some type/module resolution + cleanup --- src/compiler/hxb/hxbRestore.ml | 26 +++++++++----------------- src/compiler/serverMessage.ml | 8 ++------ src/context/common.ml | 4 +++- src/context/commonCache.ml | 3 ++- src/core/define.ml | 29 ++++++++++++++++------------- src/filters/exceptions.ml | 5 +++-- src/typing/typeloadModule.ml | 27 ++++++++++++++------------- 7 files changed, 49 insertions(+), 53 deletions(-) diff --git a/src/compiler/hxb/hxbRestore.ml b/src/compiler/hxb/hxbRestore.ml index bc538ee89e4..71e41edcfad 100644 --- a/src/compiler/hxb/hxbRestore.ml +++ b/src/compiler/hxb/hxbRestore.ml @@ -7,7 +7,6 @@ class hxb_restore = object(self) method find (path : path) = - (* ServerMessage.debug_msg (Printf.sprintf "[1] Find %s from hxb" (s_type_path path)); *) try begin let m = com.module_lut#find path in (match m.m_extra.m_cache_state with @@ -16,11 +15,9 @@ class hxb_restore ) end with | Not_found -> - (* ServerMessage.debug_msg (Printf.sprintf "[2] Find %s from hxb" (s_type_path path)); *) match cc#find_module_opt path with | Some m -> m | None -> - (* ServerMessage.debug_msg (Printf.sprintf "[3] Find %s from hxb" (s_type_path path)); *) begin match cc#get_hxb_module path with | None -> raise Not_found | Some { mc_extra = { m_cache_state = MSBad reason }} -> raise (Bad_module (path, reason)) @@ -28,13 +25,8 @@ class hxb_restore end method load (mc : module_cache) = - (* ServerMessage.debug_msg (Printf.sprintf "[1] Load %s from hxb" (s_type_path mc.mc_path)); *) let reader = new HxbReader.hxb_reader (self#make_module mc) self#add_module self#resolve_type (fun () -> ()) in - try - let m = reader#read (IO.input_bytes mc.mc_bytes) true null_pos in - (* ServerMessage.debug_msg (Printf.sprintf "[2] Loaded %s from hxb" (s_type_path mc.mc_path)); *) - m - with + try reader#read (IO.input_bytes mc.mc_bytes) true null_pos with | Bad_module (path, reason) -> ServerMessage.skipping_dep com "" (path,(Printer.s_module_skip_reason reason)); com.module_lut#remove mc.mc_path; @@ -54,17 +46,12 @@ class hxb_restore method resolve_type (pack : string list) (mname : string) (tname : string) = let path = (pack,mname) in - (* ServerMessage.debug_msg (Printf.sprintf " resolve type %s (%b)" (s_type_path path) (com.module_lut#mem path)); *) try - let m = self#find path in + let m = try self#find path with Not_found -> print_endline "cannot find module"; raise Not_found in List.find (fun t -> snd (t_path t) = tname) m.m_types with - | Bad_module (_, reason) -> - ServerMessage.debug_msg (Printf.sprintf " error resolving type %s (bad)" (s_type_path path)); - raise (Bad_module (path, reason)) - | Not_found -> - ServerMessage.debug_msg (Printf.sprintf " error resolving type %s (not found)" (s_type_path path)); - raise Not_found + | Bad_module (_, reason) -> raise (Bad_module (path, reason)) + | Not_found -> raise Not_found method make_module (mc : module_cache) (path : path) (file : string) = { @@ -85,3 +72,8 @@ end let find (cc : CompilationCache.context_cache) (com : Common.context) (path : path) = let loader = new hxb_restore cc com in loader#find path + +let find_type (cc : CompilationCache.context_cache) (com : Common.context) (path : path) = + let m = find cc com path in + List.find (fun t -> snd (t_path t) = (snd path)) m.m_types + diff --git a/src/compiler/serverMessage.ml b/src/compiler/serverMessage.ml index c2113071c31..f5cc63546bf 100644 --- a/src/compiler/serverMessage.ml +++ b/src/compiler/serverMessage.ml @@ -29,7 +29,6 @@ type server_message_options = { mutable print_message : bool; mutable print_socket_message : bool; mutable print_uncaught_error : bool; - mutable print_new_context : bool; } let config = { @@ -58,7 +57,6 @@ let config = { print_message = false; print_socket_message = false; print_uncaught_error = false; - print_new_context = false; } let sign_string com = @@ -71,7 +69,7 @@ let debug_msg msg = if config.print_debug then print_endline msg let compiler_stage com = - if config.print_compiler_stage then print_endline (Printf.sprintf "%scompiler stage: %s" (sign_string com) (s_compiler_stage com.stage)) + if config.print_compiler_stage then print_endline (Printf.sprintf "compiler stage: %s" (s_compiler_stage com.stage)) let added_directory com tabs dir = if config.print_added_directory then print_endline (Printf.sprintf "%sadded directory %s" (sign_string com) dir) @@ -196,8 +194,7 @@ let enable_all () = config.print_stats <- true; config.print_message <- true; config.print_socket_message <- true; - config.print_uncaught_error <- true; - config.print_new_context <- true + config.print_uncaught_error <- true let set_by_name name value = match name with | "debug" -> config.print_debug <- value @@ -224,5 +221,4 @@ let set_by_name name value = match name with | "message" -> config.print_message <- value; | "socketMessage" -> config.print_socket_message <- value; | "uncaughtError" -> config.print_uncaught_error <- value; - | "newContext" -> config.print_new_context <- value; | _ -> raise Not_found diff --git a/src/context/common.ml b/src/context/common.ml index efaebe8b068..0407f8b4159 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -1040,7 +1040,9 @@ let rec has_feature com f = | field :: cl :: pack -> let r = (try let path = List.rev pack, cl in - (match List.find (fun t -> t_path t = path && not (Meta.has Meta.RealPath (t_infos t).mt_meta)) com.types with + (* (match List.find (fun t -> t_path t = path && not (Meta.has Meta.RealPath (t_infos t).mt_meta)) com.types with *) + let m = com.module_lut#find (com.type_to_module#find path) in + (match List.find (fun t -> snd (t_path t) = (snd path)) m.m_types with | t when field = "*" -> not (has_dce com) || (match t with TAbstractDecl a -> Meta.has Meta.ValueUsed a.a_meta | _ -> Meta.has Meta.Used (t_infos t).mt_meta) diff --git a/src/context/commonCache.ml b/src/context/commonCache.ml index 610b673a9f4..b2b2a5b6b49 100644 --- a/src/context/commonCache.ml +++ b/src/context/commonCache.ml @@ -74,7 +74,7 @@ let rec cache_context cs com = let sign = Define.get_signature com.defines in let cache_module m = (* If we have a signature mismatch, look-up cache for module. Physical equality check is fine as a heueristic. *) - let cc = if m.m_extra.m_sign == sign then cc else cs#get_context m.m_extra.m_sign in + let cc = if m.m_extra.m_sign = sign then cc else cs#get_context m.m_extra.m_sign in (* assert (m.m_extra.m_sign = sign); *) cc#cache_module m.m_path m; in @@ -90,6 +90,7 @@ let rec clear_cache cs com = com.module_lut#clear; com.stored_typed_exprs#clear; com.module_nonexistent_lut#clear; + (* Hashtbl.clear com.features; *) (* com.type_to_module#clear; *) match com.get_macros() with diff --git a/src/core/define.ml b/src/core/define.ml index aff032ada42..2494cb64ecf 100644 --- a/src/core/define.ml +++ b/src/core/define.ml @@ -106,23 +106,26 @@ let raw_define ctx k = let define ctx k = raw_define_value ctx (get_define_key k) "1" +let get_signature_raw def = + let defines = PMap.foldi (fun k v acc -> + (* don't make much difference between these special compilation flags *) + match String.concat "_" (ExtString.String.nsplit k "-") with + (* If we add something here that might be used in conditional compilation it should be added to + Parser.parse_macro_ident as well (issue #5682). + Note that we should removed flags like use_rtti_doc here. + *) + | "display" | "use_rtti_doc" | "macro_times" | "display_details" | "no_copt" | "display_stdin" + | "message.reporting" | "message.log_file" | "message.log_format" | "message.no_color" + | "dump" | "dump_dependencies" | "dump_ignore_var_ids" -> acc + | _ -> (k ^ "=" ^ v) :: acc + ) def.values [] in + String.concat "@" (List.sort compare defines) + let get_signature def = match def.defines_signature with | Some s -> s | None -> - let defines = PMap.foldi (fun k v acc -> - (* don't make much difference between these special compilation flags *) - match String.concat "_" (ExtString.String.nsplit k "-") with - (* If we add something here that might be used in conditional compilation it should be added to - Parser.parse_macro_ident as well (issue #5682). - Note that we should removed flags like use_rtti_doc here. - *) - | "display" | "use_rtti_doc" | "macro_times" | "display_details" | "no_copt" | "display_stdin" - | "message.reporting" | "message.log_file" | "message.log_format" | "message.no_color" - | "dump" | "dump_dependencies" | "dump_ignore_var_ids" -> acc - | _ -> (k ^ "=" ^ v) :: acc - ) def.values [] in - let str = String.concat "@" (List.sort compare defines) in + let str = get_signature_raw def in (* Printf.eprintf "Defines: %s\n" str; *) let s = Digest.string str in def.defines_signature <- Some s; diff --git a/src/filters/exceptions.ml b/src/filters/exceptions.ml index d092e890d7d..377a8642c5e 100644 --- a/src/filters/exceptions.ml +++ b/src/filters/exceptions.ml @@ -597,8 +597,9 @@ let insert_save_stacks tctx = (fun e -> e) else let native_stack_trace_cls = - let tp = mk_type_path (["haxe"],"NativeStackTrace") in - match Typeload.load_type_def tctx null_pos tp with + (* let tp = mk_type_path (["haxe"],"NativeStackTrace") in *) + (* match Typeload.load_type_def tctx null_pos tp with *) + match HxbRestore.find_type (CommonCache.get_cache tctx.com) tctx.com (["haxe"], "NativeStackTrace") with | TClassDecl cls -> cls | TAbstractDecl { a_impl = Some cls } -> cls | _ -> raise_typing_error "haxe.NativeStackTrace is expected to be a class or an abstract" null_pos diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index d0d5178cbe1..7fa73c682da 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -309,9 +309,9 @@ module ModuleLevel = struct | ParseError(_,(msg,p),_) -> Parser.error msg p in 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 ctx m_import p; - add_dependency m m_import; + let mimport = make_import_module path r in + add_module ctx mimport p; + add_dependency m mimport; r end else begin let r = [] in @@ -849,32 +849,33 @@ and load_hxb_module ctx path p = close_in ch; raise e -and load_module' ctx g m p = +and load_module' ctx g mpath p = try (* Check current context *) - ctx.com.module_lut#find m + ctx.com.module_lut#find mpath with Not_found -> (* Check cache *) - match !type_module_hook ctx m p with + match !type_module_hook ctx mpath p with | Some m -> + ctx.com.module_lut#add mpath m; m (* Try loading from hxb first, then from source *) - | None -> try load_hxb_module ctx m p with Not_found -> - let raise_not_found () = raise_error_msg (Module_not_found m) p in - if ctx.com.module_nonexistent_lut#mem m then raise_not_found(); + | None -> try load_hxb_module ctx mpath p with Not_found -> + let raise_not_found () = raise_error_msg (Module_not_found mpath) p in + if ctx.com.module_nonexistent_lut#mem mpath then raise_not_found(); if ctx.g.load_only_cached_modules then raise_not_found(); let is_extern = ref false in let file, decls = try (* Try parsing *) - TypeloadParse.parse_module ctx m p + TypeloadParse.parse_module ctx mpath p with Not_found -> (* Nothing to parse, try loading extern type *) let rec loop = function | [] -> - ctx.com.module_nonexistent_lut#add m true; + ctx.com.module_nonexistent_lut#add mpath true; raise_not_found() | (file,load) :: l -> - match load m p with + match load mpath p with | None -> loop l | Some (_,a) -> file, a in @@ -883,7 +884,7 @@ and load_module' ctx g m p = in let is_extern = !is_extern in try - type_module ctx m file ~is_extern decls p + type_module ctx mpath file ~is_extern decls p with Forbid_package (inf,pl,pf) when p <> null_pos -> raise (Forbid_package (inf,p::pl,pf))