feature: use clonefile on macos

Use mac's [clonefile] instead of manually copying. [clonefile] is like
hardlink but it will copy-on-write when edited.

Signed-off-by: Rudi Grinberg <[email protected]>

<!-- ps-id: 7c730484-ecf9-4dae-9718-9bbd0bd480f5 -->

bench/micro/copyfile.ml

@@ -0,0 +1,14 @@
+open Stdune
+
+let dir = Temp.create Dir ~prefix:"copyfile" ~suffix:"bench"
+
+let contents = String.make 50_000 '0'
+
+let () =
+  let src = Path.relative dir "initial" in
+  Io.write_file (Path.relative dir "initial") contents;
+  let chmod _ = 444 in
+  for i = 1 to 10_000 do
+    let dst = Path.relative dir (sprintf "dst-%d" i) in
+    Io.copy_file ~chmod ~src ~dst ()
+  done

bench/micro/dune

@@ -1,3 +1,8 @@
+(executable
+ (name copyfile)
+ (modules copyfile)
+ (libraries stdune))
+
 (executable
  (name main)
  (modules main)

otherlibs/stdune/src/copyfile_stubs.c

@@ -0,0 +1,51 @@
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+#if defined(__APPLE__)
+#define _DARWIN_C_SOURCE
+#include <caml/threads.h>
+#include <caml/unixsupport.h>
+#include <copyfile.h>
+#include <stdlib.h>
+
+CAMLprim value stdune_copyfile(value v_from, value v_to) {
+  CAMLparam2(v_from, v_to);
+  char *from = caml_stat_strdup(String_val(v_from));
+  char *to = caml_stat_strdup(String_val(v_to));
+  caml_release_runtime_system();
+  /* clonefile doesn't follow symlinks automatically */
+  char *real_from = realpath(from, NULL);
+  caml_stat_free(from);
+  if (real_from == NULL) {
+    caml_acquire_runtime_system();
+    caml_stat_free(to);
+    uerror("realpath", Nothing);
+  }
+  int ret = copyfile(real_from, to, NULL, COPYFILE_CLONE);
+  caml_stat_free(to);
+  free(real_from);
+  caml_acquire_runtime_system();
+  if (ret < 0) {
+    uerror("copyfile", Nothing);
+  }
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value stdune_is_darwin(value v_unit) {
+  CAMLparam1(v_unit);
+  CAMLreturn(Val_true);
+}
+
+#else
+
+CAMLprim value stdune_copyfile(value v_from, value v_to) {
+  caml_failwith("copyfile: only on macos");
+}
+
+CAMLprim value stdune_is_darwin(value v_unit) {
+  CAMLparam1(v_unit);
+  CAMLreturn(Val_false);
+}
+
+#endif

otherlibs/stdune/src/dune

@@ -12,6 +12,6 @@
   (re_export dune_filesystem_stubs))
  (foreign_stubs
   (language c)
-  (names wait3_stubs))
+  (names wait3_stubs copyfile_stubs))
  (instrumentation
   (backend bisect_ppx)))

otherlibs/stdune/src/io.ml

@@ -248,10 +248,31 @@ struct
     in
     (ic, oc)
 
+  module Copyfile = struct
+    (* Bindings to mac's fast copy function. It's similar to a hardlink, except
+       it does COW when edited. It will also default back to regular copying if
+       it fails for w/e reason *)
+    external copyfile : string -> string -> unit = "stdune_copyfile"
+
+    external available : unit -> bool = "stdune_is_darwin"
+  end
+
   let copy_file ?chmod ~src ~dst () =
     Exn.protectx (setup_copy ?chmod ~src ~dst ()) ~finally:close_both
       ~f:(fun (ic, oc) -> copy_channels ic oc)
 
+  let copy_file =
+    match Copyfile.available () with
+    | false -> copy_file
+    | true -> (
+      fun ?chmod ~src ~dst () ->
+        let src = Path.to_string src in
+        let dst = Path.to_string dst in
+        Copyfile.copyfile src dst;
+        match chmod with
+        | None -> ()
+        | Some chmod -> (Unix.stat src).st_perm |> chmod |> Unix.chmod dst)
+
   let file_line path n =
     with_file_in ~binary:false path ~f:(fun ic ->
         for _ = 1 to n - 1 do