forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Better source rendering
+52
-9
+51
-8
odoc/src/loader/implementation.cppo.ml
+51
-8
odoc/src/loader/implementation.cppo.ml
···
300
300
301
301
(* Extract [Typedtree_traverse] occurrence information and turn them into proper
302
302
source infos *)
303
-
let process_occurrences env poses loc_to_id local_ident_to_loc =
303
+
let rec read_module_path_fallback ~root p =
304
+
let open Odoc_model.Names in
305
+
match (p : Path.t) with
306
+
| Pident id -> `Dot (`Root (ModuleName.make_std root), ModuleName.make_std (Ident.name id))
307
+
| Pdot (p, s) -> `Dot (read_module_path_fallback ~root p, ModuleName.make_std s)
308
+
| Papply (p, arg) -> `Apply (read_module_path_fallback ~root p, read_module_path_fallback ~root arg)
309
+
#if OCAML_VERSION >= (5,1,0)
310
+
| Pextra_ty _ -> assert false
311
+
#endif
312
+
313
+
let process_occurrences ~module_name env poses loc_to_id local_ident_to_loc =
304
314
let open Odoc_model.Lang.Source_info in
305
315
(* Ensure source infos are not repeated by putting them in a Set (a unit hashtbl) *)
306
316
let occ_tbl = AnnotHashtbl.create 100 in
307
-
let process p find_in_env =
317
+
let fallback_read_value p =
318
+
let open Odoc_model.Names in
319
+
match (p : Path.t) with
320
+
| Pdot (parent, s) -> Some (`DotV (read_module_path_fallback ~root:module_name parent, ValueName.make_std s))
321
+
| _ -> None
322
+
in
323
+
let fallback_read_module p =
324
+
Some (read_module_path_fallback ~root:module_name p)
325
+
in
326
+
let fallback_read_module_type p =
327
+
let open Odoc_model.Names in
328
+
match (p : Path.t) with
329
+
| Pdot (parent, s) -> Some (`DotMT (read_module_path_fallback ~root:module_name parent, ModuleTypeName.make_std s))
330
+
| _ -> None
331
+
in
332
+
let fallback_read_type p =
333
+
let open Odoc_model.Names in
334
+
match (p : Path.t) with
335
+
| Pdot (parent, s) -> Some (`DotT (read_module_path_fallback ~root:module_name parent, TypeName.make_std s))
336
+
| _ -> None
337
+
in
338
+
let process p find_in_env fallback =
308
339
match p with
309
340
| Path.Pident id when IdentHashtbl.mem local_ident_to_loc id -> (
310
341
match
···
321
352
let documentation = if is_persistent p then Some path else None
322
353
and implementation = Some (Unresolved path) in
323
354
Some { documentation; implementation }
324
-
| exception _ -> None)
355
+
| exception _ ->
356
+
if not (is_persistent p) then
357
+
match fallback p with
358
+
| Some path ->
359
+
let documentation = None
360
+
and implementation = Some (Unresolved path) in
361
+
Some { documentation; implementation }
362
+
| None -> None
363
+
else None)
325
364
in
326
365
List.iter
327
366
(function
328
367
| Typedtree_traverse.Analysis.Value p, loc ->
329
-
process p Ident_env.Path.read_value
368
+
process p Ident_env.Path.read_value fallback_read_value
330
369
|> Option.iter @@ fun l ->
331
370
AnnotHashtbl.replace occ_tbl (Value l, pos_of_loc loc) ()
332
371
| Module p, loc ->
333
-
process p Ident_env.Path.read_module
372
+
process p Ident_env.Path.read_module fallback_read_module
334
373
|> Option.iter @@ fun l ->
335
374
AnnotHashtbl.replace occ_tbl (Module l, pos_of_loc loc) ()
336
375
| ModuleType p, loc ->
337
-
process p Ident_env.Path.read_module_type
376
+
process p Ident_env.Path.read_module_type fallback_read_module_type
338
377
|> Option.iter @@ fun l ->
339
378
AnnotHashtbl.replace occ_tbl (ModuleType l, pos_of_loc loc) ()
340
379
| Type p, loc ->
341
-
process p Ident_env.Path.read_type
380
+
process p Ident_env.Path.read_type fallback_read_type
342
381
|> Option.iter @@ fun l ->
343
382
AnnotHashtbl.replace occ_tbl (Type l, pos_of_loc loc) ()
344
383
| LocalDefinition _, _ -> ())
···
378
417
local_ident_to_loc;
379
418
populate_global_defs env source_id loc_to_id uid_to_loc uid_to_id
380
419
in
420
+
let module_name =
421
+
Odoc_model.Root.Odoc_file.name root.Odoc_model.Root.file
422
+
in
381
423
let source_infos =
382
-
process_occurrences env traverse_infos loc_to_id local_ident_to_loc
424
+
process_occurrences ~module_name env traverse_infos loc_to_id
425
+
local_ident_to_loc
383
426
|> add_definitions loc_to_id
384
427
in
385
428
let shape_info = Some (shape, Shape.Uid.Tbl.to_map uid_to_id) in
+1
-1
odoc/src/odoc/resolver.ml
+1
-1
odoc/src/odoc/resolver.ml
···
563
563
lookup_unit ~important_digests ~imports_map extended_ap ~libs ~hierarchy
564
564
and lookup_page = lookup_page ap ~pages ~hierarchy
565
565
and lookup_asset = lookup_asset ~pages ~hierarchy
566
-
and lookup_impl = lookup_impl ap in
566
+
and lookup_impl = lookup_impl extended_ap in
567
567
{ Env.open_units; lookup_unit; lookup_page; lookup_impl; lookup_asset }
568
568
569
569
let build_compile_env_for_impl t i =