this repo has no description
Alternative, simpler fix
+36
-55
+36
-55
src/xref2/tools.ml
+36
-55
src/xref2/tools.ml
···
2363
2363
let resolve_class_type_path env p =
2364
2364
resolve_class_type env p >>= fun (p, _) -> Ok p
2365
2365
2366
-
let apply_inner_substs env (sg : Component.Signature.t) : Component.Signature.t
2367
-
=
2366
+
let apply_inner_substs _env (sg : Component.Signature.t) :
2367
+
Component.Signature.t =
2368
2368
let rec inner (items : Component.Signature.item list) :
2369
2369
Component.Signature.item list =
2370
2370
match items with
2371
2371
| Component.Signature.TypeSubstitution (id, typedecl) :: rest -> (
2372
-
let subst =
2373
-
Component.ModuleType.TypeSubst
2374
-
(`Dot (`Root, Ident.Name.type_ id), typedecl.equation)
2372
+
let rest = inner rest in
2373
+
match typedecl.equation.manifest with
2374
+
| Some texpr ->
2375
+
let sub =
2376
+
Subst.add_type_replacement
2377
+
(id :> Ident.type_)
2378
+
texpr typedecl.equation Subst.identity
2379
+
in
2380
+
Subst.apply_sig_map_items sub rest
2381
+
| None -> failwith "apply_inner_substs: TypeSubstitution with no manifest")
2382
+
| Component.Signature.ModuleSubstitution (id, modsubst) :: rest ->
2383
+
let rest = inner rest in
2384
+
let rp =
2385
+
match modsubst.manifest with
2386
+
| `Resolved rp -> rp
2387
+
| `Local (local_id, _) -> (`Local local_id : Cpath.Resolved.module_)
2388
+
| p ->
2389
+
failwith
2390
+
(Format.asprintf
2391
+
"apply_inner_substs: ModuleSubstitution with unresolvable \
2392
+
manifest: %a"
2393
+
(Component.Fmt.module_path Component.Fmt.default) p)
2375
2394
in
2376
-
let rest =
2377
-
Component.Signature.Type
2378
-
(id, Ordinary, Component.Delayed.put (fun () -> typedecl))
2379
-
:: inner rest
2395
+
let sub =
2396
+
Subst.add_module
2397
+
(id :> Ident.module_)
2398
+
(`Resolved rp) rp Subst.identity
2380
2399
in
2381
-
match fragmap env subst { sg with items = rest } with
2382
-
| Ok sg' -> sg'.items
2383
-
| Error _ -> failwith "error")
2384
-
| Component.Signature.ModuleSubstitution (id, modsubst) :: rest -> (
2385
-
let subst =
2386
-
Component.ModuleType.ModuleSubst
2387
-
(`Dot (`Root, Ident.Name.module_ id), modsubst.manifest)
2400
+
Subst.apply_sig_map_items sub rest
2401
+
| Component.Signature.ModuleTypeSubstitution (id, modtypesubst) :: rest ->
2402
+
let rest = inner rest in
2403
+
let sub =
2404
+
Subst.add_module_type_replacement
2405
+
(id :> Ident.module_type)
2406
+
modtypesubst.manifest Subst.identity
2388
2407
in
2389
-
let rest =
2390
-
Component.Signature.Module
2391
-
( id,
2392
-
Ordinary,
2393
-
Component.Delayed.put (fun () ->
2394
-
{
2395
-
Component.Module.source_loc = None;
2396
-
source_loc_jane = None;
2397
-
doc = modsubst.doc;
2398
-
type_ = Alias (modsubst.manifest, None);
2399
-
canonical = None;
2400
-
hidden = false;
2401
-
}) )
2402
-
:: inner rest
2403
-
in
2404
-
match fragmap env subst { sg with items = rest } with
2405
-
| Ok sg' -> sg'.items
2406
-
| Error _ -> failwith "error")
2407
-
| Component.Signature.ModuleTypeSubstitution (id, modtypesubst) :: rest -> (
2408
-
let subst =
2409
-
Component.ModuleType.ModuleTypeSubst
2410
-
(`Dot (`Root, Ident.Name.module_type id), modtypesubst.manifest)
2411
-
in
2412
-
let rest =
2413
-
Component.Signature.ModuleType
2414
-
( id,
2415
-
Component.Delayed.put (fun () ->
2416
-
{
2417
-
Component.ModuleType.source_loc = None;
2418
-
source_loc_jane = None;
2419
-
doc = modtypesubst.doc;
2420
-
expr = Some modtypesubst.manifest;
2421
-
canonical = None;
2422
-
}) )
2423
-
:: inner rest
2424
-
in
2425
-
match fragmap env subst { sg with items = rest } with
2426
-
| Ok sg' -> sg'.items
2427
-
| Error _ -> failwith "error")
2408
+
Subst.apply_sig_map_items sub rest
2428
2409
| x :: rest -> x :: inner rest
2429
2410
| [] -> []
2430
2411
in