From 42b565394a7b79f115169b715b350698024d37b2 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 6 Oct 2021 15:04:26 -0600 Subject: [PATCH] Use fsevents in dune's file watcher Signed-off-by: Rudi Grinberg --- boot/duneboot.ml | 18 ++-- boot/libs.ml | 10 +++ src/dune_file_watcher/dune | 1 + src/dune_file_watcher/dune_file_watcher.ml | 94 ++++++++++++++------- src/dune_file_watcher/dune_file_watcher.mli | 8 +- src/dune_rules/bootstrap_info.ml | 14 +++ 6 files changed, 104 insertions(+), 41 deletions(-) diff --git a/boot/duneboot.ml b/boot/duneboot.ml index 628b7792c03b..b42e5f397bb2 100644 --- a/boot/duneboot.ml +++ b/boot/duneboot.ml @@ -1068,7 +1068,7 @@ let common_build_args name ~external_includes ~external_libraries = ; external_libraries ] -let build ~ocaml_config ~dependencies ~c_files +let build ~ocaml_config ~dependencies ~c_files ~link_flags { target = name, main; external_libraries; _ } = let ext_obj = try StringMap.find "ext_obj" ocaml_config with @@ -1126,10 +1126,10 @@ let build ~ocaml_config ~dependencies ~c_files (List.concat [ common_build_args name ~external_includes ~external_libraries ; obj_files - ; [ "-args"; "compiled_ml_files" ] + ; [ "-args"; "compiled_ml_files" ] @ link_flags ]) -let build_with_single_command ~ocaml_config:_ ~dependencies ~c_files +let build_with_single_command ~ocaml_config:_ ~dependencies ~c_files ~link_flags { target = name, main; external_libraries; _ } = let external_libraries, external_includes = resolve_externals external_libraries @@ -1140,7 +1140,7 @@ let build_with_single_command ~ocaml_config:_ ~dependencies ~c_files [ common_build_args name ~external_includes ~external_libraries ; [ "-no-alias-deps"; "-w"; "-49" ] ; c_files - ; [ "-args"; "mods_list" ] + ; [ "-args"; "mods_list" ] @ link_flags ]) let rec rm_rf fn = @@ -1161,12 +1161,20 @@ let main () = List.map ~f:(fun (_, _, c_files) -> c_files) libraries |> List.concat in get_dependencies libraries >>= fun dependencies -> + let link_flags = + match StringMap.find_opt "system" ocaml_config with + | None -> assert false + | Some platform -> ( + match List.assoc_opt platform Libs.link_flags with + | None -> [] + | Some flags -> flags) + in let build = if concurrency = 1 || Sys.win32 then build_with_single_command else build in - build ~ocaml_config ~dependencies ~c_files task + build ~ocaml_config ~dependencies ~c_files ~link_flags task let () = Fiber.run (main ()) diff --git a/boot/libs.ml b/boot/libs.ml index 3a14cb7e40e1..b4a9ee99660e 100644 --- a/boot/libs.ml +++ b/boot/libs.ml @@ -34,6 +34,7 @@ let local_libraries = ; ("src/dune_rpc_server", Some "Dune_rpc_server", false, None) ; ("src/thread_worker", Some "Thread_worker", false, None) ; ("src/ocamlc_loc", Some "Ocamlc_loc", false, None) + ; ("src/fsevents", Some "Fsevents", false, None) ; ("vendor/ocaml-inotify/src", Some "Ocaml_inotify", false, None) ; ("src/async_inotify_for_dune", Some "Async_inotify_for_dune", false, None) @@ -48,3 +49,12 @@ let local_libraries = ; ("src/csexp_rpc", Some "Csexp_rpc", false, None) ; ("src/dune_rpc_impl", Some "Dune_rpc_impl", false, None) ] + +let link_flags = + [ ("macosx", + [ "-cclib" + ; "-framework Foundation" + ; "-cclib" + ; "-framework CoreServices" + ]) + ] diff --git a/src/dune_file_watcher/dune b/src/dune_file_watcher/dune index 47915edd2db4..51c9eacfee23 100644 --- a/src/dune_file_watcher/dune +++ b/src/dune_file_watcher/dune @@ -2,6 +2,7 @@ (name dune_file_watcher) (libraries spawn + fsevents unix stdune threads.posix diff --git a/src/dune_file_watcher/dune_file_watcher.ml b/src/dune_file_watcher/dune_file_watcher.ml index e1450f1bb3e6..86737745cd7c 100644 --- a/src/dune_file_watcher/dune_file_watcher.ml +++ b/src/dune_file_watcher/dune_file_watcher.ml @@ -21,12 +21,15 @@ let decompose_inotify_event (event : Inotify_lib.Event.t) = let inotify_event_paths event = List.map ~f:fst (decompose_inotify_event event) type kind = - | Coarse of { wait_for_watches_established : unit -> unit } - | Fine of { inotify : Inotify_lib.t } + | Coarse of + { pid : Pid.t + ; wait_for_watches_established : unit -> unit + } + | Fsevents of Fsevents.t + | Inotify of Inotify_lib.t type t = - { shutdown : [ `Kill of Pid.t | `No_op ] - ; kind : kind + { kind : kind (* CR-someday amokhov: The way we handle "ignored files" using this mutable table is fragile and also wrong. We use [ignored_files] for the [(mode promote)] feature: if a file is promoted, we call @@ -161,7 +164,15 @@ module Scheduler = struct } end -let shutdown t = t.shutdown +let shutdown t = + match t.kind with + | Coarse { pid; _ } -> `Kill pid + | Inotify _ -> `No_op + | Fsevents fsevents -> + `Thunk + (fun () -> + List.iter [ Fsevents.stop; Fsevents.break; Fsevents.destroy ] + ~f:(fun f -> f fsevents)) let buffer_capacity = 65536 @@ -268,7 +279,9 @@ let select_watcher_backend () = if Sys.linux then ( assert (Ocaml_inotify.Inotify.supported_by_the_os ()); `Inotify_lib - ) else + ) else if Fsevents.available () then + `Fsevents + else fswatch_backend () let emit_sync () = @@ -354,10 +367,7 @@ let create_no_buffering ~(scheduler : Scheduler.t) ~root ~backend = done in scheduler.spawn_thread (fun () -> worker_thread pipe); - { shutdown = `Kill pid - ; kind = Coarse { wait_for_watches_established = wait } - ; ignored_files - } + { kind = Coarse { pid; wait_for_watches_established = wait }; ignored_files } let with_buffering ~create ~(scheduler : Scheduler.t) ~debounce_interval = let jobs = ref [] in @@ -401,6 +411,42 @@ let with_buffering ~create ~(scheduler : Scheduler.t) ~debounce_interval = scheduler.spawn_thread buffer_thread; res +let create_inotifylib ~scheduler = + prepare_sync (); + let ignored_files = Table.create (module String) 64 in + let inotify = create_inotifylib_watcher ~ignored_files ~scheduler in + Inotify_lib.add inotify + (Path.to_string (Path.build (special_file_for_inotify_sync ()))); + { kind = Inotify inotify; ignored_files } + +let create_fsevents ~(scheduler : Scheduler.t) = + let ignored_files = Table.create (module String) 64 in + let fsevents = + let paths = [ Path.to_string Path.root ] in + Fsevents.create ~paths ~latency:0.2 ~f:(fun _ events -> + scheduler.thread_safe_send_emit_events_job (fun () -> + List.map events ~f:(fun event -> + let path = Path.of_string (Fsevents.Event.path event) in + let kind = + match Fsevents.Event.action event with + | Unknown -> Fs_memo_event.Unknown + | Create -> Created + | Remove -> Deleted + | Modify -> + if Fsevents.Event.kind event = File then + File_changed + else + Unknown + in + Event.Fs_memo_event { Fs_memo_event.kind; path }))) + in + scheduler.spawn_thread (fun () -> + Fsevents.start fsevents; + Fsevents.loop fsevents); + (* XXX hardcoded *) + Fsevents.set_exclusion_paths fsevents ~paths:[ "_build" ]; + { kind = Fsevents fsevents; ignored_files } + let create_external ~root ~debounce_interval ~scheduler ~backend = match debounce_interval with | None -> create_no_buffering ~root ~scheduler ~backend @@ -409,48 +455,38 @@ let create_external ~root ~debounce_interval ~scheduler ~backend = ~create:(create_no_buffering ~root) ~backend -let create_inotifylib ~scheduler = - prepare_sync (); - let ignored_files = Table.create (module String) 64 in - let inotify = create_inotifylib_watcher ~ignored_files ~scheduler in - Inotify_lib.add inotify - (Path.to_string (Path.build (special_file_for_inotify_sync ()))); - { kind = Fine { inotify }; shutdown = `No_op; ignored_files } - let create_default ~scheduler = match select_watcher_backend () with | `Fswatch _ as backend -> create_external ~scheduler ~root:Path.root ~debounce_interval:(Some 0.5 (* seconds *)) ~backend + | `Fsevents -> create_fsevents ~scheduler | `Inotify_lib -> create_inotifylib ~scheduler -let create_external ~root ~debounce_interval ~scheduler = - match fswatch_backend () with - | `Fswatch _ as backend -> - create_external ~root ~debounce_interval ~scheduler ~backend - let wait_for_initial_watches_established_blocking t = match t.kind with - | Coarse { wait_for_watches_established } -> wait_for_watches_established () - | Fine { inotify = _ } -> + | Coarse c -> c.wait_for_watches_established () + | Fsevents _ + | Inotify _ -> (* no initial watches needed: all watches should be set up at the time just before file access *) () let add_watch t path = match t.kind with + | Fsevents _ | Coarse _ -> (* Here we assume that the path is already being watched because the coarse file watchers are expected to watch all the source files from the start *) () - | Fine { inotify } -> Inotify_lib.add inotify (Path.to_string path) + | Inotify inotify -> Inotify_lib.add inotify (Path.to_string path) module For_tests = struct let pid t = - match t.shutdown with - | `Kill pid -> pid - | `No_op -> failwith "don't know how to suspend an inotifylib watcher" + match t.kind with + | Coarse c -> c.pid + | _ -> failwith "pid unavailable" let suspend t = Unix.kill (Pid.to_int (pid t)) Sys.sigstop diff --git a/src/dune_file_watcher/dune_file_watcher.mli b/src/dune_file_watcher/dune_file_watcher.mli index 85e73c7e2867..a78ce3834a45 100644 --- a/src/dune_file_watcher/dune_file_watcher.mli +++ b/src/dune_file_watcher/dune_file_watcher.mli @@ -59,17 +59,11 @@ module Scheduler : sig } end -(** Create a new file watcher. [debounce_interval] is measured in seconds and it - controls the minimum time between calls to - [scheduler.thread_safe_send_files_changed]. *) -val create_external : - root:Path.t -> debounce_interval:float option -> scheduler:Scheduler.t -> t - (** Create a new file watcher with default settings. *) val create_default : scheduler:Scheduler.t -> t (** The action that needs to be taken to shutdown the watcher. *) -val shutdown : t -> [ `Kill of Pid.t | `No_op ] +val shutdown : t -> [ `Kill of Pid.t | `No_op | `Thunk of unit -> unit ] val wait_for_initial_watches_established_blocking : t -> unit diff --git a/src/dune_rules/bootstrap_info.ml b/src/dune_rules/bootstrap_info.ml index 78c6709e3fed..e7c94d67916f 100644 --- a/src/dune_rules/bootstrap_info.ml +++ b/src/dune_rules/bootstrap_info.ml @@ -18,6 +18,16 @@ let rule sctx compile (exes : Dune_file.Executables.t) () = | Some x -> Left x | None -> Right lib) in + let link_flags = + (* additional link flags keyed by the platform *) + [ ( "macosx" + , [ "-cclib" + ; "-framework Foundation" + ; "-cclib" + ; "-framework CoreServices" + ] ) + ] + in let+ locals = Memo.Build.parallel_map locals ~f:(fun x -> let info = Lib.Local.info x in @@ -57,6 +67,10 @@ let rule sctx compile (exes : Dune_file.Executables.t) () = (List.map externals ~f:(fun x -> Lib.name x |> Lib_name.to_dyn))) ; Pp.nop ; def "local_libraries" (List locals) + ; Pp.nop + ; def "link_flags" + (let open Dyn.Encoder in + list (pair string (list string)) link_flags) ])) let gen_rules sctx (exes : Dune_file.Executables.t) ~dir compile =