Merge branch 'master' into add-classical-ppx-test
This commit is contained in:
commit
b057c40668
|
@ -1137,31 +1137,19 @@ module Trace = struct
|
|||
|
||||
let file = Path.relative Path.build_dir ".db"
|
||||
|
||||
let dump (trace : t) =
|
||||
let sexp =
|
||||
Sexp.List (
|
||||
Hashtbl.foldi trace ~init:Path.Map.empty ~f:(fun key data acc ->
|
||||
Path.Map.add acc key data)
|
||||
|> Path.Map.to_list
|
||||
|> List.map ~f:(fun (path, hash) ->
|
||||
Sexp.List [ Path.sexp_of_t path;
|
||||
Atom (Sexp.Atom.of_digest hash) ]))
|
||||
in
|
||||
if Path.build_dir_exists () then
|
||||
Io.write_file file (Sexp.to_string sexp)
|
||||
module P = Utils.Persistent(struct
|
||||
type nonrec t = t
|
||||
let name = "INCREMENTAL-DB"
|
||||
let version = 1
|
||||
end)
|
||||
|
||||
let dump t =
|
||||
if Path.build_dir_exists () then P.dump file t
|
||||
|
||||
let load () =
|
||||
let trace = Hashtbl.create 1024 in
|
||||
if Path.exists file then begin
|
||||
let sexp = Io.Sexp.load file ~mode:Single in
|
||||
let bindings =
|
||||
let open Sexp.Of_sexp in
|
||||
list (pair Path.t (fun s -> Digest.from_hex (string s))) sexp
|
||||
in
|
||||
List.iter bindings ~f:(fun (path, hash) ->
|
||||
Hashtbl.add trace path hash);
|
||||
end;
|
||||
trace
|
||||
match P.load file with
|
||||
| Some t -> t
|
||||
| None -> Hashtbl.create 1024
|
||||
end
|
||||
|
||||
let all_targets t =
|
||||
|
|
|
@ -199,6 +199,11 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
|
|||
Left fn)
|
||||
in
|
||||
let files = String.Set.of_list files in
|
||||
let sub_dirs =
|
||||
List.sort
|
||||
~compare:(fun (a, _, _) (b, _, _) -> String.compare a b)
|
||||
sub_dirs
|
||||
in
|
||||
let project =
|
||||
match Dune_project.load ~dir:path ~files with
|
||||
| Some _ as x -> x
|
||||
|
|
|
@ -127,19 +127,19 @@ let dot_merlin sctx ~dir ~scope ({ requires; flags; _ } as t) =
|
|||
flags
|
||||
>>^ (fun flags ->
|
||||
let (src_dirs, obj_dirs) =
|
||||
Lib.Set.fold requires ~init:(Path.Set.empty, Path.Set.empty)
|
||||
~f:(fun (lib : Lib.t) (src_dirs, build_dirs) ->
|
||||
( Path.Set.add src_dirs (Lib.src_dir lib)
|
||||
, Path.Set.add build_dirs (
|
||||
Lib.obj_dir lib
|
||||
|> Path.drop_optional_build_context)))
|
||||
Lib.Set.fold requires ~init:(t.source_dirs, t.objs_dirs)
|
||||
~f:(fun (lib : Lib.t) (src_dirs, obj_dirs) ->
|
||||
( Path.Set.add src_dirs (
|
||||
Lib.src_dir lib
|
||||
|> Path.drop_optional_build_context)
|
||||
, Path.Set.add obj_dirs (Lib.obj_dir lib)))
|
||||
in
|
||||
Dot_file.to_string
|
||||
~remaindir
|
||||
~ppx:(ppx_flags sctx ~dir ~scope ~src_dir:remaindir t)
|
||||
~flags
|
||||
~src_dirs:(Path.Set.union src_dirs t.source_dirs)
|
||||
~obj_dirs:(Path.Set.union obj_dirs t.objs_dirs))
|
||||
~src_dirs
|
||||
~obj_dirs)
|
||||
>>>
|
||||
Build.write_file_dyn merlin_file)
|
||||
|
||||
|
|
96
src/utils.ml
96
src/utils.ml
|
@ -146,19 +146,55 @@ let install_file ~(package : Package.Name.t) ~findlib_toolchain =
|
|||
| None -> package ^ ".install"
|
||||
| Some x -> sprintf "%s-%s.install" package x
|
||||
|
||||
module type Persistent_desc = sig
|
||||
type t
|
||||
val name : string
|
||||
val version : int
|
||||
end
|
||||
|
||||
module Persistent(D : Persistent_desc) = struct
|
||||
let magic = sprintf "DUNE-%sv%d:" D.name D.version
|
||||
|
||||
let dump file (v : D.t) =
|
||||
Io.with_file_out file ~f:(fun oc ->
|
||||
output_string oc magic;
|
||||
Marshal.to_channel oc v [])
|
||||
|
||||
let load file =
|
||||
if Path.exists file then
|
||||
Io.with_file_in file ~f:(fun ic ->
|
||||
match really_input_string ic (String.length magic) with
|
||||
| exception End_of_file -> None
|
||||
| s ->
|
||||
if s = magic then
|
||||
Some (Marshal.from_channel ic : D.t)
|
||||
else
|
||||
None)
|
||||
else
|
||||
None
|
||||
end
|
||||
|
||||
module Cached_digest = struct
|
||||
type file =
|
||||
{ mutable digest : Digest.t
|
||||
; mutable timestamp : float
|
||||
; mutable timestamp_checked : bool
|
||||
; mutable timestamp_checked : int
|
||||
}
|
||||
|
||||
let cache = Hashtbl.create 1024
|
||||
type t =
|
||||
{ mutable checked_key : int
|
||||
; mutable table : (Path.t, file) Hashtbl.t
|
||||
}
|
||||
|
||||
let cache =
|
||||
{ checked_key = 0
|
||||
; table = Hashtbl.create 1024
|
||||
}
|
||||
|
||||
let file fn =
|
||||
match Hashtbl.find cache fn with
|
||||
match Hashtbl.find cache.table fn with
|
||||
| Some x ->
|
||||
if x.timestamp_checked then
|
||||
if x.timestamp_checked = cache.checked_key then
|
||||
x.digest
|
||||
else begin
|
||||
let mtime = (Unix.stat (Path.to_string fn)).st_mtime in
|
||||
|
@ -167,55 +203,35 @@ module Cached_digest = struct
|
|||
x.digest <- digest;
|
||||
x.timestamp <- mtime;
|
||||
end;
|
||||
x.timestamp_checked <- true;
|
||||
x.timestamp_checked <- cache.checked_key;
|
||||
x.digest
|
||||
end
|
||||
| None ->
|
||||
let digest = Digest.file (Path.to_string fn) in
|
||||
Hashtbl.add cache fn
|
||||
Hashtbl.add cache.table fn
|
||||
{ digest
|
||||
; timestamp = (Unix.stat (Path.to_string fn)).st_mtime
|
||||
; timestamp_checked = true
|
||||
; timestamp_checked = cache.checked_key
|
||||
};
|
||||
digest
|
||||
|
||||
let remove fn = Hashtbl.remove cache fn
|
||||
let remove fn = Hashtbl.remove cache.table fn
|
||||
|
||||
let db_file = Path.relative Path.build_dir ".digest-db"
|
||||
|
||||
module P = Persistent(struct
|
||||
type nonrec t = t
|
||||
let name = "DIGEST-DB"
|
||||
let version = 1
|
||||
end)
|
||||
|
||||
let dump () =
|
||||
let sexp =
|
||||
Sexp.List (
|
||||
Hashtbl.foldi cache ~init:Path.Map.empty ~f:(fun key data acc ->
|
||||
Path.Map.add acc key data)
|
||||
|> Path.Map.to_list
|
||||
|> List.map ~f:(fun (path, file) ->
|
||||
Sexp.List [ Quoted_string (Path.to_string path)
|
||||
; Atom (Sexp.Atom.of_digest file.digest)
|
||||
; Atom (Sexp.Atom.of_int64
|
||||
(Int64.bits_of_float file.timestamp))
|
||||
]))
|
||||
in
|
||||
if Path.build_dir_exists () then
|
||||
Io.write_file db_file (Sexp.to_string sexp)
|
||||
if Path.build_dir_exists () then P.dump db_file cache
|
||||
|
||||
let load () =
|
||||
if Path.exists db_file then begin
|
||||
let sexp = Io.Sexp.load db_file ~mode:Single in
|
||||
let bindings =
|
||||
let open Sexp.Of_sexp in
|
||||
list
|
||||
(triple
|
||||
Path.t
|
||||
(fun s -> Digest.from_hex (string s))
|
||||
(fun s -> Int64.float_of_bits (Int64.of_string (string s)))
|
||||
) sexp
|
||||
in
|
||||
List.iter bindings ~f:(fun (path, digest, timestamp) ->
|
||||
Hashtbl.add cache path
|
||||
{ digest
|
||||
; timestamp
|
||||
; timestamp_checked = false
|
||||
});
|
||||
end
|
||||
match P.load db_file with
|
||||
| None -> ()
|
||||
| Some c ->
|
||||
cache.checked_key <- c.checked_key + 1;
|
||||
cache.table <- c.table
|
||||
end
|
||||
|
|
|
@ -55,6 +55,18 @@ val install_file
|
|||
-> findlib_toolchain:string option
|
||||
-> string
|
||||
|
||||
module type Persistent_desc = sig
|
||||
type t
|
||||
val name : string
|
||||
val version : int
|
||||
end
|
||||
|
||||
(** Persistent value stored on disk *)
|
||||
module Persistent(D : Persistent_desc) : sig
|
||||
val dump : Path.t -> D.t -> unit
|
||||
val load : Path.t -> D.t option
|
||||
end
|
||||
|
||||
(** Digest files with caching *)
|
||||
module Cached_digest : sig
|
||||
(** Digest the contents of the following file *)
|
||||
|
|
|
@ -9,12 +9,12 @@
|
|||
B $LIB_PREFIX/lib/findlib
|
||||
B $LIB_PREFIX/lib/ocaml
|
||||
B ../_build/default/exe/.x.eobjs
|
||||
B ../lib/.foo.objs
|
||||
B ../_build/default/lib/.foo.objs
|
||||
S $LIB_PREFIX/lib/bytes
|
||||
S $LIB_PREFIX/lib/findlib
|
||||
S $LIB_PREFIX/lib/ocaml
|
||||
S ../_build/default/lib
|
||||
S .
|
||||
S ../lib
|
||||
FLG -w -40
|
||||
# Processing lib/.merlin
|
||||
B $LIB_PREFIX/lib/bytes
|
||||
|
|
Loading…
Reference in New Issue