Skip to content

Commit 619ea9d

Browse files
jchavarrijchavarri
committed
attempt to deal with public libs
Signed-off-by: Javier Chávarri <javier.chavarri@gmail.com>
1 parent 70e6ea7 commit 619ea9d

3 files changed

Lines changed: 40 additions & 14 deletions

File tree

‎src/dune_rules/lib.ml‎

Lines changed: 29 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -422,7 +422,7 @@ and resolve_result =
422422
| Hidden of Lib_info.external_ Hidden.t
423423
| Invalid of User_message.t
424424
| Ignore
425-
| Redirect_in_the_same_db of (Loc.t * Lib_name.t)
425+
| Redirect_in_the_same_db of (Loc.t * Lib_name.t) list
426426
| Redirect of db * (Loc.t * Lib_name.t)
427427

428428
let lib_config (t : lib) = t.lib_config
@@ -1167,7 +1167,28 @@ end = struct
11671167
db.resolve name
11681168
>>= function
11691169
| Ignore -> Memo.return Status.Ignore
1170-
| Redirect_in_the_same_db (_, name') -> find_internal db name'
1170+
| Redirect_in_the_same_db redirects ->
1171+
let result = List.map ~f:(fun (_, name') -> find_internal db name') redirects in
1172+
let* statuses =
1173+
Memo.List.map result ~f:(fun redirect ->
1174+
let* r = redirect in
1175+
Memo.return r)
1176+
in
1177+
Memo.return
1178+
(List.fold_left statuses ~init:Status.Not_found ~f:(fun acc status ->
1179+
match acc, status with
1180+
| Status.Found a, Status.Found b ->
1181+
let a = info a in
1182+
let b = info b in
1183+
let loc = Lib_info.loc b in
1184+
let dir_a = Lib_info.src_dir a in
1185+
let dir_b = Lib_info.src_dir b in
1186+
Status.Invalid (Error.duplicated ~loc ~name ~dir_a ~dir_b)
1187+
| Invalid _, _ -> acc
1188+
| (Found _ as lib), (Hidden _ | Ignore | Not_found | Invalid _)
1189+
| (Hidden _ | Ignore | Not_found), (Found _ as lib) -> lib
1190+
| (Hidden _ | Ignore | Not_found), (Hidden _ | Ignore | Not_found | Invalid _)
1191+
-> acc))
11711192
| Redirect (db', (_, name')) -> find_internal db' name'
11721193
| Found libs ->
11731194
(match libs with
@@ -1860,7 +1881,7 @@ module DB = struct
18601881
| Hidden of Lib_info.external_ Hidden.t
18611882
| Invalid of User_message.t
18621883
| Ignore
1863-
| Redirect_in_the_same_db of (Loc.t * Lib_name.t)
1884+
| Redirect_in_the_same_db of (Loc.t * Lib_name.t) list
18641885
| Redirect of db * (Loc.t * Lib_name.t)
18651886

18661887
let found f = Found f
@@ -1877,8 +1898,10 @@ module DB = struct
18771898
| Hidden h -> variant "Hidden" [ Hidden.to_dyn (Lib_info.to_dyn Path.to_dyn) h ]
18781899
| Ignore -> variant "Ignore" []
18791900
| Redirect (_, (_, name)) -> variant "Redirect" [ Lib_name.to_dyn name ]
1880-
| Redirect_in_the_same_db (_, name) ->
1881-
variant "Redirect_in_the_same_db" [ Lib_name.to_dyn name ]
1901+
| Redirect_in_the_same_db redirects ->
1902+
variant
1903+
"Redirect_in_the_same_db"
1904+
[ (Dyn.list (fun (_, name) -> Lib_name.to_dyn name)) redirects ]
18821905
;;
18831906
end
18841907

@@ -1911,7 +1934,7 @@ module DB = struct
19111934
>>| function
19121935
| Ok (Library pkg) -> Found [ Dune_package.Lib.info pkg ]
19131936
| Ok (Deprecated_library_name d) ->
1914-
Redirect_in_the_same_db (d.loc, d.new_public_name)
1937+
Redirect_in_the_same_db [ d.loc, d.new_public_name ]
19151938
| Ok (Hidden_library pkg) -> Hidden (Hidden.unsatisfied_exist_if pkg)
19161939
| Error e ->
19171940
(match e with

‎src/dune_rules/lib.mli‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,7 @@ module DB : sig
101101
val found : Lib_info.external_ list -> t
102102
val to_dyn : t Dyn.builder
103103
val redirect : db -> Loc.t * Lib_name.t -> t
104-
val redirect_in_the_same_db : Loc.t * Lib_name.t -> t
104+
val redirect_in_the_same_db : (Loc.t * Lib_name.t) list -> t
105105
end
106106

107107
(** Create a new library database. [resolve] is used to resolve library names

‎src/dune_rules/scope.ml‎

Lines changed: 10 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -26,21 +26,23 @@ module DB = struct
2626
module Found_or_redirect : sig
2727
type t = private
2828
| Found of Lib_info.external_ list
29-
| Redirect of (Loc.t * Lib_name.t)
29+
| Redirect of (Loc.t * Lib_name.t) list
3030

3131
val redirect : Lib_name.t -> Loc.t * Lib_name.t -> Lib_name.t * t
32+
val redirect_many : (Loc.t * Lib_name.t) list -> t
3233
val found : Lib_info.external_ list -> t
3334
end = struct
3435
type t =
3536
| Found of Lib_info.external_ list
36-
| Redirect of (Loc.t * Lib_name.t)
37+
| Redirect of (Loc.t * Lib_name.t) list
3738

3839
let redirect from (loc, to_) =
3940
if Lib_name.equal from to_
4041
then Code_error.raise ~loc "Invalid redirect" [ "to_", Lib_name.to_dyn to_ ]
41-
else from, Redirect (loc, to_)
42+
else from, Redirect [ loc, to_ ]
4243
;;
4344

45+
let redirect_many x = Redirect x
4446
let found x = Found x
4547
end
4648

@@ -69,11 +71,12 @@ module DB = struct
6971
match v1, v2 with
7072
| Found info1, Found info2 ->
7173
Ok (Found_or_redirect.found (List.rev_append info1 info2))
72-
| Found info, Redirect (loc, _) | Redirect (loc, _), Found info ->
74+
| Found info, Redirect redirect | Redirect redirect, Found info ->
75+
let loc, _ = List.hd redirect in
7376
(* todo: should this not be an error? *)
7477
Error (loc, Lib_info.loc (List.hd info))
75-
| Redirect (loc1, lib1), Redirect (loc2, lib2) ->
76-
if Lib_name.equal lib1 lib2 then Ok v1 else Error (loc1, loc2)
78+
| Redirect redirect1, Redirect redirect2 ->
79+
Ok (Found_or_redirect.redirect_many (List.rev_append redirect1 redirect2))
7780
in
7881
match res with
7982
| Ok x -> x
@@ -121,7 +124,7 @@ module DB = struct
121124
| Some (Project project) ->
122125
let scope = find_by_project (Fdecl.get t) project in
123126
Lib.DB.Resolve_result.redirect scope.db (Loc.none, name)
124-
| Some (Name name) -> Lib.DB.Resolve_result.redirect_in_the_same_db name
127+
| Some (Name name) -> Lib.DB.Resolve_result.redirect_in_the_same_db [ name ]
125128
;;
126129

127130
let public_theories ~find_db ~installed_theories coq_stanzas =

0 commit comments

Comments
 (0)