Skip to content

Commit

Permalink
refactor: improve "dune describe external-lib-deps"
Browse files Browse the repository at this point in the history
    Instead of having only external dependencies, we could also add the
    internal dependencies for more information.

    Add the extensions of executables

Signed-off-by: Alpha DIALLO <moyodiallo@gmail.com>
  • Loading branch information
moyodiallo committed Jun 27, 2023
1 parent 1b4c41a commit 7fc23e1
Show file tree
Hide file tree
Showing 4 changed files with 93 additions and 48 deletions.
106 changes: 63 additions & 43 deletions bin/describe/describe_external_lib_deps.ml
Original file line number Diff line number Diff line change
Expand Up @@ -11,12 +11,12 @@ module Kind = struct
| Optional -> String "optional"
end

type external_lib_dep =
type lib_dep =
{ name : Lib_name.t
; kind : Kind.t
}

let external_lib_dep_to_dyn t =
let lib_dep_to_dyn t =
let open Dyn in
List [ String (Lib_name.to_string t.name); Kind.to_dyn t.kind ]

Expand All @@ -36,25 +36,33 @@ module Item = struct
type t =
{ kind : Kind.t
; dir : Path.Source.t
; external_deps : external_lib_dep list
; external_deps : lib_dep list
; internal_deps : lib_dep list
; names : string list
; package : Package.t option
; extensions : string list
}

let to_dyn t =
let open Dyn in
let record =
record
[ ("names", (list string) t.names)
; ("extensions", (list string) t.extensions)
; ( "package"
, option Package.Name.to_dyn (Option.map ~f:Package.name t.package) )
; ("source_dir", String (Path.Source.to_string t.dir))
; ("external_deps", list external_lib_dep_to_dyn t.external_deps)
; ("external_deps", list lib_dep_to_dyn t.external_deps)
; ("internal_deps", list lib_dep_to_dyn t.internal_deps)
]
in
Variant (Kind.to_string t.kind, [ record ])
end

type dep =
| Local of lib_dep
| External of lib_dep

let is_external db name =
let open Memo.O in
let+ lib = Dune_rules.Lib.DB.find_even_when_hidden db name in
Expand All @@ -65,53 +73,59 @@ let is_external db name =
| Installed_private | Public _ | Private _ -> false
| Installed -> true)

let external_lib_pps db preprocess =
let resolve_lib db name kind =
let open Memo.O in
let+ is_external = is_external db name in
if is_external then External { name; kind } else Local { name; kind }

let resolve_lib_pps db preprocess =
let open Memo.O in
let* pps =
Resolve.Memo.read_memo
(Dune_rules.Preprocess.Per_module.with_instrumentation preprocess
~instrumentation_backend:(Dune_rules.Lib.DB.instrumentation_backend db))
>>| Dune_rules.Preprocess.Per_module.pps
in
Memo.parallel_map
~f:(fun (_, name) ->
let+ is_external = is_external db name in
if is_external then Some { name; kind = Kind.Required } else None)
pps
>>| List.filter_opt

let external_resolve db name kind =
let open Memo.O in
let+ is_external = is_external db name in
if is_external then Some { name; kind } else None
Memo.parallel_map ~f:(fun (_, name) -> resolve_lib db name Kind.Required) pps

let external_lib_deps db lib_deps =
let resolve_lib_deps db lib_deps =
let open Memo.O in
Memo.parallel_map lib_deps ~f:(fun lib ->
Memo.parallel_map lib_deps ~f:(fun (lib : Dune_rules.Lib_dep.t) ->
match lib with
| Dune_rules.Lib_dep.Direct (_, name) | Re_export (_, name) -> (
let+ v = external_resolve db name Kind.Required in
match v with
| Some x -> [ x ]
| None -> [])
| Direct (_, name) | Re_export (_, name) ->
let+ v = resolve_lib db name Kind.Required in
[ v ]
| Select select ->
Memo.parallel_map select.choices
~f:(fun (choice : Dune_rules.Lib_dep.Select.Choice.t) ->
Memo.parallel_map
(Lib_name.Set.to_string_list choice.required
@ Lib_name.Set.to_string_list choice.forbidden)
~f:(fun name ->
external_resolve db (Lib_name.of_string name) Kind.Optional)
>>| List.filter_opt)
select.choices
|> Memo.parallel_map
~f:(fun (choice : Dune_rules.Lib_dep.Select.Choice.t) ->
Lib_name.Set.to_string_list choice.required
@ Lib_name.Set.to_string_list choice.forbidden
|> Memo.parallel_map ~f:(fun name ->
let name = Lib_name.of_string name in
resolve_lib db name Kind.Optional))
>>| List.concat)
>>| List.concat

let external_libs db dir libraries preprocess names package kind =
let resolve_libs db dir libraries preprocess names package kind extensions =
let open Memo.O in
let open Item in
let* lib_deps = external_lib_deps db libraries in
let+ lib_pps = external_lib_pps db preprocess in
Some { kind; dir; names; package; external_deps = lib_deps @ lib_pps }
let* lib_deps = resolve_lib_deps db libraries in
let+ lib_pps = resolve_lib_pps db preprocess in
let deps = lib_deps @ lib_pps in
let internal_deps, external_deps =
deps
|> List.partition_map ~f:(function
| Local lib -> Either.Left lib
| External lib -> Either.Right lib)
in
{ external_deps; internal_deps; kind; names; package; dir; extensions }

let exes_extensions (ctx : Context.t) modes =
Dune_rules.Dune_file.Executables.Link_mode.Map.to_list modes
|> List.map ~f:(fun (m, loc) ->
Dune_rules.Dune_file.Executables.Link_mode.extension m ~loc
~ext_obj:ctx.lib_config.ext_obj ~ext_dll:ctx.lib_config.ext_dll)

let libs db (context : Context.t) (build_system : Dune_rules.Main.build_system)
=
Expand All @@ -125,24 +139,30 @@ let libs db (context : Context.t) (build_system : Dune_rules.Main.build_system)
let dir = dune_file.dir in
match stanza with
| Dune_rules.Dune_file.Executables exes ->
external_libs db dir exes.buildable.libraries
resolve_libs db dir exes.buildable.libraries
exes.buildable.preprocess
(List.map exes.names ~f:snd)
exes.package Item.Kind.Executables
(exes_extensions context exes.modes)
>>| List.singleton
| Dune_rules.Dune_file.Library lib ->
external_libs db dir lib.buildable.libraries
lib.buildable.preprocess
resolve_libs db dir lib.buildable.libraries lib.buildable.preprocess
[ Dune_rules.Dune_file.Library.best_name lib |> Lib_name.to_string
]
(Dune_rules.Dune_file.Library.package lib)
Item.Kind.Library
Item.Kind.Library []
>>| List.singleton
| Dune_rules.Dune_file.Tests tests ->
external_libs db dir tests.exes.buildable.libraries
resolve_libs db dir tests.exes.buildable.libraries
tests.exes.buildable.preprocess
(List.map tests.exes.names ~f:snd)
tests.exes.package Item.Kind.Tests
| _ -> Memo.return None)
>>| List.filter_opt)
(if Option.is_none tests.package then tests.exes.package
else tests.package)
Item.Kind.Tests
(exes_extensions context tests.exes.modes)
>>| List.singleton
| _ -> Memo.return [])
>>| List.concat)
>>| List.concat

let external_resolved_libs setup super_context =
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -6,11 +6,15 @@ print only the external libraries by dir.
(default
((library
((names (foo))
(extensions ())
(package ())
(source_dir .)
(external_deps ((a required)))))
(external_deps ((a required)))
(internal_deps ((inter_lib required)))))
(library
((names (inter_lib))
(extensions ())
(package ())
(source_dir lib)
(external_deps ((a required)))))))
(external_deps ((a required)))
(internal_deps ())))))
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ Expected: To get all required and pps packages
(default
((library
((names (foo))
(extensions ())
(package ())
(source_dir .)
(external_deps
Expand All @@ -12,12 +13,16 @@ Expected: To get all required and pps packages
(c________ required)
(f________ required)
(e________ required)
(d________ required)))))
(d________ required)))
(internal_deps ())))
(executables
((names (prog))
(extensions
(.bc .exe))
(package ())
(source_dir .)
(external_deps
((h________ required)
(i________ required)
(j________ required)))))))
(j________ required)))
(internal_deps ())))))
18 changes: 17 additions & 1 deletion test/blackbox-tests/test-cases/external-lib-deps/simple.t/run.t
Original file line number Diff line number Diff line change
Expand Up @@ -6,11 +6,27 @@ external library dependencies of a simple project
> (library
> (public_name dummypkg)
> (libraries base doesnotexist.foo))
> (test
> (package dummypkg)
> (name test)
> (libraries base))
> EOF
$ dune describe external-lib-deps
(default
((library
((names (dummypkg))
(extensions ())
(package (dummypkg))
(source_dir .)
(external_deps ((base required) (doesnotexist.foo required)))))))
(external_deps
((base required)
(doesnotexist.foo required)))
(internal_deps ())))
(tests
((names (test))
(extensions
(.bc .exe))
(package (dummypkg))
(source_dir .)
(external_deps ((base required)))
(internal_deps ())))))

0 comments on commit 7fc23e1

Please sign in to comment.