matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove duplicate check for merlin context (#175) 

This check is done in add_rules and dot_merlin. Only of those checks is
necessary. The check in dot_merlin is removed.
This commit is contained in:
Rudi Grinberg 2017-06-30 18:03:11 +07:00 committed by Jérémie Dimino
parent 06a179df99
commit 97a855524c
1 changed files with 49 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
src/merlin.ml
View File

@ -27,56 +27,55 @@ let ppx_flags sctx ~dir ~src_dir { preprocess; libname; _ } =
| _ -> [] | _ -> []
let dot_merlin sctx ~dir ({ requires; flags; _ } as t) = let dot_merlin sctx ~dir ({ requires; flags; _ } as t) =
if (SC.context sctx).merlin then match Path.extract_build_context dir with
match Path.extract_build_context dir with | Some (_, remaindir) ->
| Some (_, remaindir) -> let path = Path.relative remaindir ".merlin" in
let path = Path.relative remaindir ".merlin" in SC.add_rule sctx
SC.add_rule sctx (Build.path path
(Build.path path >>>
>>> Build.update_file (Path.relative dir ".merlin-exists") "");
Build.update_file (Path.relative dir ".merlin-exists") ""); SC.add_rule sctx (
SC.add_rule sctx ( requires
requires >>^ (fun libs ->
>>^ (fun libs -> let ppx_flags = ppx_flags sctx ~dir ~src_dir:remaindir t in
let ppx_flags = ppx_flags sctx ~dir ~src_dir:remaindir t in let internals, externals =
let internals, externals = List.fold_left libs ~init:([], []) ~f:(fun (internals, externals) ->
List.fold_left libs ~init:([], []) ~f:(fun (internals, externals) -> function
function | Lib.Internal (path, _) ->
| Lib.Internal (path, _) -> let spath =
let spath = Path.drop_build_context path
Path.drop_build_context path |> Path.reach ~from:remaindir
|> Path.reach ~from:remaindir in
in let bpath = Path.reach path ~from:remaindir in
let bpath = Path.reach path ~from:remaindir in ("S " ^ spath) :: ("B " ^ bpath) :: internals, externals
("S " ^ spath) :: ("B " ^ bpath) :: internals, externals | Lib.External pkg ->
| Lib.External pkg -> internals, ("PKG " ^ pkg.name) :: externals
internals, ("PKG " ^ pkg.name) :: externals )
) in
in let flags =
let flags = match flags with
match flags with | [] -> []
| [] -> [] | _ -> ["FLG " ^ String.concat flags ~sep:" "]
| _ -> ["FLG " ^ String.concat flags ~sep:" "] in
in let dot_merlin =
let dot_merlin = List.concat
List.concat [ [ "B " ^ (Path.reach dir ~from:remaindir) ]
[ [ "B " ^ (Path.reach dir ~from:remaindir) ] ; internals
; internals ; externals
; externals ; flags
; flags ; ppx_flags
; ppx_flags ]
] in
in dot_merlin
dot_merlin |> String_set.of_list
|> String_set.of_list |> String_set.elements
|> String_set.elements |> List.map ~f:(Printf.sprintf "%s\n")
|> List.map ~f:(Printf.sprintf "%s\n") |> String.concat ~sep:"")
|> String.concat ~sep:"") >>>
>>> Build.update_file_dyn path
Build.update_file_dyn path )
) | _ ->
| _ -> ()
()
let merge_two a b = let merge_two a b =
{ requires = { requires =