Skip to content

Commit

Permalink
merlin: add rules regardless of (merlin)
Browse files Browse the repository at this point in the history
Signed-off-by: Javier Chávarri <[email protected]>
  • Loading branch information
jchavarri committed Mar 28, 2024
1 parent 9265e2c commit 37bc4c1
Show file tree
Hide file tree
Showing 14 changed files with 62 additions and 124 deletions.
10 changes: 3 additions & 7 deletions src/dune_rules/action_unexpanded.ml
Original file line number Diff line number Diff line change
Expand Up @@ -507,13 +507,9 @@ let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t =
and+ y = E.target y in
O.Symlink (x, y)
| Copy_and_add_line_directive (x, y) ->
A.with_expander (fun expander ->
Expander.context expander
|> Context.DB.get
|> Memo.map ~f:(fun context ->
let+ x = E.dep x
and+ y = E.target y in
Copy_line_directive.action context ~src:x ~dst:y))
let+ x = E.dep x
and+ y = E.target y in
Copy_line_directive.action ~src:x ~dst:y
| System x ->
let+ x = E.string x in
O.System x
Expand Down
18 changes: 7 additions & 11 deletions src/dune_rules/buildable_rules.ml
Original file line number Diff line number Diff line change
Expand Up @@ -36,20 +36,16 @@ let gen_select_rules sctx ~dir compile_info =
let* src_fn = Resolve.read src_fn in
let src = Path.build (Path.Build.relative dir src_fn) in
let+ () = Action_builder.path src in
let context = Super_context.context sctx in
Action.Full.make (Copy_line_directive.action context ~src ~dst))))
Action.Full.make (Copy_line_directive.action ~src ~dst))))
;;

let with_lib_deps (t : Context.t) compile_info ~dir ~f =
let with_lib_deps compile_info ~dir ~f =
let prefix =
if Context.merlin t
then
Lib.Compile.merlin_ident compile_info
|> Merlin_ident.merlin_file_path dir
|> Path.build
|> Action_builder.path
|> Action_builder.goal
else Action_builder.return ()
Lib.Compile.merlin_ident compile_info
|> Merlin_ident.merlin_file_path dir
|> Path.build
|> Action_builder.path
|> Action_builder.goal
in
Rules.prefix_rules prefix ~f
;;
Expand Down
3 changes: 1 addition & 2 deletions src/dune_rules/buildable_rules.mli
Original file line number Diff line number Diff line change
Expand Up @@ -14,8 +14,7 @@ val gen_select_rules : Super_context.t -> dir:Path.Build.t -> Lib.Compile.t -> u

(** Generate the rules for the [(select ...)] forms in library dependencies *)
val with_lib_deps
: Context.t
-> Lib.Compile.t
: Lib.Compile.t
-> dir:Path.Build.t
-> f:(unit -> 'a Memo.t)
-> 'a Memo.t
Expand Down
47 changes: 19 additions & 28 deletions src/dune_rules/check_rules.ml
Original file line number Diff line number Diff line change
Expand Up @@ -6,37 +6,28 @@ let dev_files =
|> Glob.matching_extensions
;;

let add_obj_dir sctx ~obj_dir mode =
if Super_context.context sctx |> Context.merlin
then (
let dir_glob =
let dir =
Path.build
(match mode with
| Lib_mode.Melange -> Obj_dir.melange_dir obj_dir
| Ocaml _ -> Obj_dir.byte_dir obj_dir)
in
File_selector.of_glob ~dir dev_files
let add_obj_dir ~obj_dir mode =
let dir_glob =
let dir =
Path.build
(match mode with
| Lib_mode.Melange -> Obj_dir.melange_dir obj_dir
| Ocaml _ -> Obj_dir.byte_dir obj_dir)
in
Rules.Produce.Alias.add_deps
(Alias.make Alias0.check ~dir:(Obj_dir.dir obj_dir))
(Action_builder.paths_matching_unit ~loc:(Loc.of_pos __POS__) dir_glob))
else Memo.return ()
File_selector.of_glob ~dir dev_files
in
Rules.Produce.Alias.add_deps
(Alias.make Alias0.check ~dir:(Obj_dir.dir obj_dir))
(Action_builder.paths_matching_unit ~loc:(Loc.of_pos __POS__) dir_glob)
;;

let add_files sctx ~dir files =
if Super_context.context sctx |> Context.merlin
then (
let alias = Alias.make Alias0.check ~dir in
let files = Path.Set.of_list files in
Rules.Produce.Alias.add_deps alias (Action_builder.path_set files))
else Memo.return ()
let add_files ~dir files =
let alias = Alias.make Alias0.check ~dir in
let files = Path.Set.of_list files in
Rules.Produce.Alias.add_deps alias (Action_builder.path_set files)
;;

let add_cycle_check sctx ~dir modules =
if Super_context.context sctx |> Context.merlin
then (
let alias = Alias.make Alias0.check ~dir in
Rules.Produce.Alias.add_deps alias (Action_builder.ignore modules))
else Memo.return ()
let add_cycle_check ~dir modules =
let alias = Alias.make Alias0.check ~dir in
Rules.Produce.Alias.add_deps alias (Action_builder.ignore modules)
;;
16 changes: 3 additions & 13 deletions src/dune_rules/check_rules.mli
Original file line number Diff line number Diff line change
@@ -1,15 +1,5 @@
open Import

val add_obj_dir
: Super_context.t
-> obj_dir:Path.Build.t Obj_dir.t
-> Lib_mode.t
-> unit Memo.t

val add_files : Super_context.t -> dir:Path.Build.t -> Path.t list -> unit Memo.t

val add_cycle_check
: Super_context.t
-> dir:Path.Build.t
-> Module.t list Action_builder.t
-> unit Memo.t
val add_obj_dir : obj_dir:Path.Build.t Obj_dir.t -> Lib_mode.t -> unit Memo.t
val add_files : dir:Path.Build.t -> Path.t list -> unit Memo.t
val add_cycle_check : dir:Path.Build.t -> Module.t list Action_builder.t -> unit Memo.t
20 changes: 4 additions & 16 deletions src/dune_rules/context.ml
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,6 @@ end

type builder =
{ profile : Profile.t
; merlin : bool
; instrument_with : Lib_name.t list
; fdo_target_exe : Path.t option
; dynamically_linked_foreign_archives : bool
Expand Down Expand Up @@ -96,7 +95,6 @@ module Builder = struct

let empty =
{ profile = Profile.Dev
; merlin = false
; instrument_with = []
; fdo_target_exe = None
; dynamically_linked_foreign_archives = false
Expand Down Expand Up @@ -142,16 +140,15 @@ module Builder = struct
; fdo_target_exe
; dynamically_linked_foreign_archives
; instrument_with
; merlin
; merlin = _
}
=
let env =
let env = Global.env () in
extend_paths ~env paths
in
{ t with
merlin
; profile
profile
; dynamically_linked_foreign_archives
; instrument_with
; fdo_target_exe
Expand Down Expand Up @@ -182,7 +179,6 @@ let dynamically_linked_foreign_archives t =

let fdo_target_exe t = t.builder.fdo_target_exe
let instrument_with t = t.builder.instrument_with
let merlin t = t.builder.merlin
let profile t = t.builder.profile
let equal x y = Context_name.equal x.builder.name y.builder.name
let hash t = Context_name.hash t.builder.name
Expand All @@ -207,7 +203,6 @@ let to_dyn t : Dyn.t =
[ "name", Context_name.to_dyn t.builder.name
; "kind", Kind.to_dyn t.kind
; "profile", Profile.to_dyn t.builder.profile
; "merlin", Bool t.builder.merlin
; "fdo_target_exe", option path t.builder.fdo_target_exe
; "build_dir", Path.Build.to_dyn t.build_dir
; "instrument_with", (list Lib_name.to_dyn) t.builder.instrument_with
Expand Down Expand Up @@ -522,11 +517,7 @@ module Group = struct
in
let targets =
let builder =
{ builder with
implicit = false
; merlin = false
; for_host = Some (name, Memo.Lazy.force native)
}
{ builder with implicit = false; for_host = Some (name, Memo.Lazy.force native) }
in
List.filter_map targets ~f:(function
| Native -> None
Expand Down Expand Up @@ -608,10 +599,7 @@ module Group = struct
in
match context with
| Opam opam -> Builder.set_workspace_base builder opam.base
| Default default ->
let builder = Builder.set_workspace_base builder default.base in
let merlin = workspace.merlin_context = Some (Workspace.Context.name context) in
{ builder with merlin }
| Default default -> Builder.set_workspace_base builder default.base
in
match context with
| Opam { base; switch } ->
Expand Down
1 change: 0 additions & 1 deletion src/dune_rules/context.mli
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,6 @@ val default_ocamlpath : t -> Path.t list Memo.t
val findlib_toolchain : t -> Context_name.t option
val instrument_with : t -> Lib_name.t list
val profile : t -> Profile.t
val merlin : t -> bool
val equal : t -> t -> bool
val hash : t -> int
val to_dyn : t -> Dyn.t
Expand Down
36 changes: 10 additions & 26 deletions src/dune_rules/copy_line_directive.ml
Original file line number Diff line number Diff line change
Expand Up @@ -58,62 +58,46 @@ let line_directive ~filename:fn ~line_number =
;;

module Spec = struct
type merlin =
| Yes
| No

let bool_of_merlin = function
| Yes -> true
| No -> false
;;

type ('path, 'target) t = 'path * 'target * merlin
type ('path, 'target) t = 'path * 'target

let name = "copy-line-directive"
let version = 1
let bimap (src, dst, merlin) f g = f src, g dst, merlin
let bimap (src, dst) f g = f src, g dst
let is_useful_to ~memoize = memoize

let encode (src, dst, merlin) path target : Dune_lang.t =
List
[ Dune_lang.atom_or_quoted_string "copy-line-directive"
; path src
; target dst
; Dune_lang.atom_or_quoted_string (Bool.to_string (bool_of_merlin merlin))
]
let encode (src, dst) path target : Dune_lang.t =
List [ Dune_lang.atom_or_quoted_string "copy-line-directive"; path src; target dst ]
;;

let action (src, dst, merlin) ~ectx:_ ~eenv:_ =
let action (src, dst) ~ectx:_ ~eenv:_ =
Io.with_file_in src ~f:(fun ic ->
Path.build dst
|> Io.with_file_out ~f:(fun oc ->
let fn = Path.drop_optional_build_context_maybe_sandboxed src in
output_string oc (line_directive ~filename:(Path.to_string fn) ~line_number:1);
Io.copy_channels ic oc));
(match merlin with
| No -> ()
| Yes -> Path.as_in_build_dir src |> Option.iter ~f:(fun src -> DB.set ~src ~dst));
Path.as_in_build_dir src |> Option.iter ~f:(fun src -> DB.set ~src ~dst);
Fiber.return ()
;;
end

let action (context : Context.t) ~src ~dst =
let action ~src ~dst =
let module M = struct
type path = Path.t
type target = Path.Build.t

module Spec = Spec

let v = src, dst, if Context.merlin context then Spec.Yes else No
let v = src, dst
end
in
Action.Extension (module M)
;;

let builder context ~src ~dst =
let builder ~src ~dst =
let open Action_builder.O in
Action_builder.with_file_targets
~file_targets:[ dst ]
(Action_builder.path src
>>> Action_builder.return (Action.Full.make (action context ~src ~dst)))
>>> Action_builder.return (Action.Full.make (action ~src ~dst)))
;;
5 changes: 2 additions & 3 deletions src/dune_rules/copy_line_directive.mli
Original file line number Diff line number Diff line change
Expand Up @@ -4,10 +4,9 @@ module DB : sig
val follow_while : Path.Build.t -> f:(Path.Build.t -> 'a option) -> 'a option
end

val action : Context.t -> src:Path.t -> dst:Path.Build.t -> Action.t
val action : src:Path.t -> dst:Path.Build.t -> Action.t

val builder
: Context.t
-> src:Path.t
: src:Path.t
-> dst:Path.Build.t
-> Action.Full.t Action_builder.With_targets.t
8 changes: 4 additions & 4 deletions src/dune_rules/exe_rules.ml
Original file line number Diff line number Diff line change
Expand Up @@ -129,7 +129,7 @@ let executables_rules
Dir_contents.ocaml dir_contents
>>| Ml_sources.modules_and_obj_dir ~for_:(Exe { first_exe })
in
let* () = Check_rules.add_obj_dir sctx ~obj_dir (Ocaml Byte) in
let* () = Check_rules.add_obj_dir ~obj_dir (Ocaml Byte) in
let ctx = Super_context.context sctx in
let* ocaml = Context.ocaml ctx in
let project = Scope.project scope in
Expand Down Expand Up @@ -220,7 +220,7 @@ let executables_rules
let* o_files =
o_files sctx ~dir ~expander ~exes ~linkages ~dir_contents ~requires_compile
in
let* () = Check_rules.add_files sctx ~dir @@ Mode.Map.Multi.to_flat_list o_files in
let* () = Check_rules.add_files ~dir @@ Mode.Map.Multi.to_flat_list o_files in
let buildable = exes.buildable in
match buildable.ctypes with
| None ->
Expand Down Expand Up @@ -257,7 +257,7 @@ let executables_rules
link
in
let+ () =
Memo.parallel_iter dep_graphs.for_exes ~f:(Check_rules.add_cycle_check sctx ~dir)
Memo.parallel_iter dep_graphs.for_exes ~f:(Check_rules.add_cycle_check ~dir)
in
( cctx
, Merlin.make
Expand Down Expand Up @@ -315,5 +315,5 @@ let rules ~sctx ~dir ~dir_contents ~scope ~expander (exes : Executables.t) =
let requires_link = Lib.Compile.requires_link compile_info in
Bootstrap_info.gen_rules sctx exes ~dir ~requires_link
in
Buildable_rules.with_lib_deps (Super_context.context sctx) compile_info ~dir ~f
Buildable_rules.with_lib_deps compile_info ~dir ~f
;;
10 changes: 5 additions & 5 deletions src/dune_rules/lib_rules.ml
Original file line number Diff line number Diff line change
Expand Up @@ -257,7 +257,7 @@ let foreign_rules (library : Foreign.Library.t) ~sctx ~expander ~dir ~dir_conten
in
Mode.Map.Multi.for_all_modes o_files_by_mode
in
let* () = Check_rules.add_files sctx ~dir o_files in
let* () = Check_rules.add_files ~dir o_files in
let* standard =
let+ project = Dune_load.find_project ~dir in
match Dune_project.use_standard_c_and_cxx_flags project with
Expand Down Expand Up @@ -305,7 +305,7 @@ let build_stubs lib ~cctx ~dir ~expander ~requires ~dir_contents ~vlib_stubs_o_f
Mode.Map.Multi.add_all tbl Mode.Select.All lib_foreign_o_files
in
let all_o_files = Mode.Map.Multi.to_flat_list o_files in
let* () = Check_rules.add_files sctx ~dir all_o_files in
let* () = Check_rules.add_files ~dir all_o_files in
if List.for_all ~f:List.is_empty [ all_o_files; vlib_stubs_o_files ]
then Memo.return ()
else (
Expand Down Expand Up @@ -588,7 +588,7 @@ let library_rules
Memo.Option.iter vimpl ~f:(Virtual_rules.setup_copy_rules_for_impl ~sctx ~dir)
in
let* expander = Super_context.expander sctx ~dir in
let* () = Check_rules.add_cycle_check sctx ~dir top_sorted_modules in
let* () = Check_rules.add_cycle_check ~dir top_sorted_modules in
let* () = gen_wrapped_compat_modules lib cctx
and* () = Module_compilation.build_all cctx
and* lib_info =
Expand All @@ -601,7 +601,7 @@ let library_rules
~lib_config
in
let mode = Lib_mode.Map.Set.for_merlin (Lib_info.modes info) in
let+ () = Check_rules.add_obj_dir sctx ~obj_dir mode in
let+ () = Check_rules.add_obj_dir ~obj_dir mode in
info
in
let+ () =
Expand Down Expand Up @@ -673,5 +673,5 @@ let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope =
~ctx_dir:dir
in
let* () = Buildable_rules.gen_select_rules sctx compile_info ~dir in
Buildable_rules.with_lib_deps (Super_context.context sctx) compile_info ~dir ~f
Buildable_rules.with_lib_deps compile_info ~dir ~f
;;
Loading

0 comments on commit 37bc4c1

Please sign in to comment.