diff --git a/src/compiler/server.ml b/src/compiler/server.ml index 33d8b085285..7f0b736b124 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -229,18 +229,18 @@ let get_changed_directories sctx com = (* Checks if module [m] can be reused from the cache and returns None in that case. Otherwise, returns [Some m'] where [m'] is the module responsible for [m] not being reusable. *) let check_module sctx com m_path m_extra p = - (* let cc = CommonCache.get_cache com in *) - (* let content_changed m_path file = *) - (* let fkey = com.file_keys#get file in *) - (* try *) - (* let cfile = cc#find_file fkey in *) - (* (1* We must use the module path here because the file path is absolute and would cause *) - (* positions in the parsed declarations to differ. *1) *) - (* let new_data = TypeloadParse.parse_module com m_path p in *) - (* cfile.c_decls <> snd new_data *) - (* with Not_found -> *) - (* true *) - (* in *) + let cc = CommonCache.get_cache com in + let content_changed m_path file = + let fkey = com.file_keys#get file in + try + let cfile = cc#find_file fkey in + (* We must use the module path here because the file path is absolute and would cause + positions in the parsed declarations to differ. *) + let new_data = TypeloadParse.parse_module com m_path p in + cfile.c_decls <> snd new_data + with Not_found -> + true + in let check_module_shadowing paths m_path m_extra = List.iter (fun dir -> let file = (dir.c_path ^ (snd m_path)) ^ ".hx" in @@ -290,17 +290,20 @@ let check_module sctx com m_path m_extra p = check_module_shadowing (get_changed_directories sctx mcom) m_path m_extra end in + let has_policy policy = List.mem policy m_extra.m_fs_check_policy || match policy with + | NoFileSystemCheck when !ServerConfig.do_not_check_modules && !Parser.display_mode <> DMNone -> true + | _ -> false + in let check_file () = let file = Path.UniqueKey.lazy_path m_extra.m_file in if file_time file <> m_extra.m_time then begin - (* TODO that one might be useful? *) - (* if has_policy CheckFileContentModification && not (content_changed m_path file) then begin *) - (* ServerMessage.unchanged_content com "" file; *) - (* end else begin *) + if has_policy CheckFileContentModification && not (content_changed m_path file) then begin + ServerMessage.unchanged_content com "" file; + end else begin ServerMessage.not_cached com "" m_path; if m_extra.m_kind = MFake then Hashtbl.remove com.fake_modules (Path.UniqueKey.lazy_key m_extra.m_file); raise (Dirty (FileChanged file)) - (* end *) + end end in let find_module_extra sign mpath = @@ -323,7 +326,7 @@ let check_module sctx com m_path m_extra p = let check () = try check_module_path(); - if Path.file_extension (Path.UniqueKey.lazy_path m_extra.m_file) <> "hx" then check_file(); + if not (has_policy NoFileSystemCheck) || Path.file_extension (Path.UniqueKey.lazy_path m_extra.m_file) <> "hx" then check_file(); check_dependencies(); None with diff --git a/src/compiler/serverMessage.ml b/src/compiler/serverMessage.ml index f2b670f1e8b..e82930c08bc 100644 --- a/src/compiler/serverMessage.ml +++ b/src/compiler/serverMessage.ml @@ -15,7 +15,7 @@ type server_message_options = { mutable print_reusing : bool; mutable print_retyping : bool; mutable print_skipping_dep : bool; - (* mutable print_unchanged_content : bool; *) + mutable print_unchanged_content : bool; mutable print_cached_modules : bool; mutable print_class_paths_changed : bool; mutable print_arguments : bool; @@ -42,7 +42,7 @@ let config = { print_reusing = false; print_retyping = false; print_skipping_dep = false; - (* print_unchanged_content = false; *) + print_unchanged_content = false; print_cached_modules = false; print_class_paths_changed = false; print_arguments = false; @@ -103,8 +103,8 @@ let retyper_fail com tabs m reason = let skipping_dep com tabs (mpath,reason) = if config.print_skipping_dep then print_endline (Printf.sprintf "%sskipping %s (%s)" (sign_string com) (s_type_path mpath) reason) -(* let unchanged_content com tabs file = *) -(* if config.print_unchanged_content then print_endline (Printf.sprintf "%s%s changed time not but content, reusing" (sign_string com) file) *) +let unchanged_content com tabs file = + if config.print_unchanged_content then print_endline (Printf.sprintf "%s%s changed time not but content, reusing" (sign_string com) file) let cached_modules com tabs i = if config.print_cached_modules then print_endline (Printf.sprintf "%sCached %i modules" (sign_string com) i) @@ -172,7 +172,7 @@ let enable_all () = config.print_reusing <- true; config.print_retyping <- true; config.print_skipping_dep <- true; - (* config.print_unchanged_content <- true; *) + config.print_unchanged_content <- true; config.print_cached_modules <- true; config.print_arguments <- true; config.print_completion <- true; @@ -197,7 +197,7 @@ let set_by_name name value = match name with | "reusing" -> config.print_reusing <- value; | "retyping" -> config.print_retyping <- value; | "skippingDep" -> config.print_skipping_dep <- value; - (* | "unchangedContent" -> config.print_unchanged_content <- value; *) + | "unchangedContent" -> config.print_unchanged_content <- value; | "cachedModules" -> config.print_cached_modules <- value; | "arguments" -> config.print_arguments <- value; | "completion" -> config.print_completion <- value; diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 2b921b7d810..8986b29cce5 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -113,6 +113,7 @@ type typer_globals = { mutable core_api : typer option; mutable macros : ((unit -> unit) * typer) option; mutable std_types : module_def; + mutable module_fs_check_policies : (string list * filesystem_check_policy list * bool) list; mutable global_using : (tclass * pos) list; (* Indicates that Typer.create() finished building this instance *) mutable complete : bool; diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index edf793db5bc..a813fd71ea3 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -156,7 +156,7 @@ let mk_class m path pos name_pos = c.cl_type <- TType(class_module_type c,[]); c -let module_extra file sign time kind added = +let module_extra file sign time kind added policy = { m_file = Path.UniqueKey.create_lazy file; m_sign = sign; @@ -174,6 +174,7 @@ let module_extra file sign time kind added = m_kind = kind; m_cache_bound_objects = DynArray.create (); m_features = Hashtbl.create 0; + m_fs_check_policy = policy; } let mk_class_field_ref (c : tclass) (cf : tclass_field) (kind : class_field_ref_kind) (is_macro : bool) = { @@ -218,7 +219,7 @@ let null_module = { m_path = [] , ""; m_types = []; m_statics = None; - m_extra = module_extra "" (Digest.string "") 0. MFake 0; + m_extra = module_extra "" (Digest.string "") 0. MFake 0 []; } let null_class = diff --git a/src/core/tType.ml b/src/core/tType.ml index b37bae1c427..a73536b084c 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -25,6 +25,11 @@ and method_kind = | MethDynamic | MethMacro +type filesystem_check_policy = + | NoFileSystemCheck + | CheckFileModificationTime + | CheckFileContentModification + type module_tainting_reason = | CheckDisplayFile | ServerInvalidate @@ -405,6 +410,7 @@ and module_def_extra = { m_file : Path.UniqueKey.lazy_t; m_sign : Digest.t; m_display : module_def_display; + mutable m_fs_check_policy : filesystem_check_policy list; mutable m_time : float; mutable m_cache_state : module_cache_state; mutable m_added : int; diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index c4c191b80fe..c6be15a6ae8 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -56,6 +56,7 @@ type 'value compiler_api = { add_global_metadata : string -> string -> (bool * bool * bool) -> pos -> unit; register_define : string -> Define.user_define -> unit; register_metadata : string -> Meta.user_meta -> unit; + add_module_fs_check_policy : string list -> int list -> bool -> unit; decode_expr : 'value -> Ast.expr; encode_expr : Ast.expr -> 'value; encode_ctype : Ast.type_hint -> 'value; @@ -2291,6 +2292,12 @@ let macro_api ccom get_api = vnull ); (* Compilation server *) + "server_add_module_fs_check_policy", vfun3 (fun filter policy recursive -> + let filter = List.map decode_string (decode_array filter) in + let policy = List.map decode_int (decode_array policy) in + (get_api()).add_module_fs_check_policy filter policy (decode_bool recursive); + vnull + ); "server_invalidate_files", vfun1 (fun a -> let com = ccom() in let cs = com.cs in diff --git a/src/typing/generic.ml b/src/typing/generic.ml index 39466e3a1af..be9a81c9104 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -182,7 +182,7 @@ let static_method_container gctx c cf p = m_path = (pack,name); m_types = []; m_statics = None; - m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake gctx.ctx.com.compilation_step; + m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake gctx.ctx.com.compilation_step m.m_extra.m_fs_check_policy; } in gctx.mg <- Some mg; let cg = mk_class mg (pack,name) c.cl_pos c.cl_name_pos in @@ -297,7 +297,7 @@ let build_generic_class ctx c p tl = m_path = (pack,name); m_types = []; m_statics = None; - m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake gctx.ctx.com.compilation_step; + m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake gctx.ctx.com.compilation_step m.m_extra.m_fs_check_policy; } in let ctx = TyperManager.clone_for_module ctx.g.root_typer (TypeloadModule.make_curmod ctx.com ctx.g mg) in gctx.mg <- Some mg; diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index 5f8c5416ab0..c5a9c5dfa71 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -257,6 +257,9 @@ let make_macro_com_api com mcom p = com.global_metadata <- (ExtString.String.nsplit s1 ".",m,config) :: com.global_metadata; ) meta; ); + add_module_fs_check_policy = (fun sl il b -> + Interp.exc_string "unsupported" + ); register_define = (fun s data -> Define.register_user_define com.user_defines s data); register_metadata = (fun s data -> Meta.register_user_meta com.user_metas s data); decode_expr = Interp.decode_expr; @@ -523,6 +526,16 @@ let make_macro_api ctx mctx p = ctx.com.global_metadata <- (ExtString.String.nsplit s1 ".",m,config) :: ctx.com.global_metadata; ) meta; ); + MacroApi.add_module_fs_check_policy = (fun sl il b -> + let add ctx = + ctx.g.module_fs_check_policies <- (List.fold_left (fun acc s -> (ExtString.String.nsplit s ".",List.map Obj.magic il,b) :: acc) ctx.g.module_fs_check_policies sl); + ctx.com.module_lut#iter (fun _ m -> m.m_extra.m_fs_check_policy <- TypeloadModule.get_policy ctx.g m.m_path); + in + add ctx; + match ctx.g.macros with + | None -> () + | Some(_,mctx) -> add mctx + ); MacroApi.with_imports = (fun imports usings f -> let restore_resolution = ctx.m.import_resolution#save in let old_using = ctx.m.module_using in diff --git a/src/typing/typeloadCacheHook.ml b/src/typing/typeloadCacheHook.ml index c4eeb36a4ee..f43d3a60bed 100644 --- a/src/typing/typeloadCacheHook.ml +++ b/src/typing/typeloadCacheHook.ml @@ -22,10 +22,10 @@ let create_fake_module com file = m_path = (["$DEP"],file); m_types = []; m_statics = None; - m_extra = module_extra file (Define.get_signature com.defines) (file_time file) MFake com.compilation_step; + m_extra = module_extra file (Define.get_signature com.defines) (file_time file) MFake com.compilation_step []; } in Hashtbl.add fake_modules key mdep; mdep ) in com.module_lut#add mdep.m_path mdep; - mdep + mdep \ No newline at end of file diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 452c225e62d..3abc7addf05 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -29,6 +29,10 @@ open Typeload open Error open Resolution +let get_policy g mpath = + let sl1 = full_dot_path2 mpath mpath in + List.fold_left (fun acc (sl2,policy,recursive) -> if match_path recursive sl1 sl2 then policy @ acc else acc) [] g.module_fs_check_policies + let field_of_static_definition d p = { cff_name = d.d_name; @@ -46,7 +50,7 @@ module ModuleLevel = struct m_path = mpath; m_types = []; m_statics = None; - m_extra = module_extra (Path.get_full_path file) (Define.get_signature com.defines) (file_time file) (if com.is_macro_context then MMacro else MCode) com.compilation_step; + m_extra = module_extra (Path.get_full_path file) (Define.get_signature com.defines) (file_time file) (if com.is_macro_context then MMacro else MCode) com.compilation_step (get_policy g mpath); } in m diff --git a/src/typing/typerEntry.ml b/src/typing/typerEntry.ml index 77affe62dab..5bcd4452b47 100644 --- a/src/typing/typerEntry.ml +++ b/src/typing/typerEntry.ml @@ -13,6 +13,7 @@ let create com macros = g = { core_api = None; macros = macros; + module_fs_check_policies = []; delayed = Array.init all_typer_passes_length (fun _ -> { tasks = []}); delayed_min_index = 0; debug_delayed = []; diff --git a/std/haxe/macro/CompilationServer.hx b/std/haxe/macro/CompilationServer.hx index e5ac247a7e4..7d9dd9a2aa2 100644 --- a/std/haxe/macro/CompilationServer.hx +++ b/std/haxe/macro/CompilationServer.hx @@ -24,12 +24,51 @@ package haxe.macro; import haxe.macro.Compiler; +enum abstract FileCheckPolicy(Int) { + /** + Disables file modification checks, avoiding some filesystem operations. + **/ + var NoFileSystemCheck = 0; + + /** + Default behavior: check last modification time. + **/ + var CheckFileModificationTime = 1; + + /** + If a file is modified, also checks if its content changed. This check + is not free, but useful when .hx files are auto-generated. + **/ + var CheckFileContentModification = 2; +} + /** This class provides some methods which can be invoked from command line using `--macro server.field(args)`. **/ class CompilationServer { #if macro + /** + Sets the `FileCheckPolicy` of all files whose dot-path matches an + element of `pathFilters`. + + If `recursive` is true, a dot-path is considered matched if it starts + with the path filter. This automatically applies to path filters of + packages. Otherwise an exact match is required. + + If an element in `pathFilters` is the empty String `""` it matches + everything (if `recursive = true`) or only top-level types (if + `recursive = false`). + + If a call to this function is added to the compilation parameters, the + compilation server should be restarted to ensure it takes effect. + **/ + static public function setModuleFileSystemCheckPolicy(pathFilters:Array, policy:Array, ?recursive = true) { + Context.onAfterInitMacros(() -> { + @:privateAccess Compiler.load("server_add_module_fs_check_policy", 4)(pathFilters, policy, recursive); + }); + } + /** Invalidates all files given in `filePaths`, removing them from the cache. **/