this repo has no description
Replace O(n^2) shadow detection with O(n) hash counting
value_name_exists, type_name_exists, etc. did a linear List.exists
scan of remaining items for each item processed — O(n^2) total.
Callgrind showed this as 16% of CPU on Container_intf (150K items).
Replace with a single pre-pass that counts names per kind in a
Hashtbl, then O(1) check-and-decrement during processing.
Result: read_impl drops from 3.77s to 2.87s (-24%) on Container_intf.
The function disappears entirely from the callgrind profile.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+57
-11
+57
-11
src/loader/ident_env.cppo.ml
+57
-11
src/loader/ident_env.cppo.ml
···
492
492
| `ClassType _ as x -> [x]
493
493
| `Include xs -> xs) items |> List.flatten
494
494
495
-
let type_name_exists name items =
495
+
(* Shadow detection: pre-count names by kind in one pass, then check
496
+
remaining count during processing. O(n) total instead of O(n²). *)
497
+
type shadow_counts = {
498
+
sc_types : (string, int) Hashtbl.t;
499
+
sc_values : (string, int) Hashtbl.t;
500
+
sc_modules : (string, int) Hashtbl.t;
501
+
sc_module_types : (string, int) Hashtbl.t;
502
+
sc_classes : (string, int) Hashtbl.t;
503
+
sc_class_types : (string, int) Hashtbl.t;
504
+
}
505
+
506
+
let build_shadow_counts items =
507
+
let bump tbl name =
508
+
match Hashtbl.find_opt tbl name with
509
+
| Some n -> Hashtbl.replace tbl name (n + 1)
510
+
| None -> Hashtbl.add tbl name 1
511
+
in
512
+
let counts = {
513
+
sc_types = Hashtbl.create 64;
514
+
sc_values = Hashtbl.create 64;
515
+
sc_modules = Hashtbl.create 64;
516
+
sc_module_types = Hashtbl.create 64;
517
+
sc_classes = Hashtbl.create 64;
518
+
sc_class_types = Hashtbl.create 64;
519
+
} in
520
+
List.iter (fun item ->
521
+
match item with
522
+
| `Type (id, _, _) -> bump counts.sc_types (Ident.name id)
523
+
| `Value (id, _, _) -> bump counts.sc_values (Ident.name id)
524
+
| `Module (id, _, _) -> bump counts.sc_modules (Ident.name id)
525
+
| `ModuleType (id, _, _) -> bump counts.sc_module_types (Ident.name id)
526
+
| `Class (id, _, _, _, _, _) -> bump counts.sc_classes (Ident.name id)
527
+
| `ClassType (id, _, _, _, _) -> bump counts.sc_class_types (Ident.name id)
528
+
| `Constructor _ | `Exception _ | `Extension _ | `Field _ -> ()
529
+
) items;
530
+
counts
531
+
532
+
(* Decrement and return true if remaining count > 0 (i.e., shadowed). *)
533
+
let check_and_decrement tbl name =
534
+
match Hashtbl.find_opt tbl name with
535
+
| Some n when n > 1 -> Hashtbl.replace tbl name (n - 1); true
536
+
| Some _ -> Hashtbl.remove tbl name; false
537
+
| None -> false
538
+
539
+
(* Legacy linear scan functions — kept for reference but no longer used *)
540
+
let _type_name_exists name items =
496
541
List.exists (function | `Type (id', _, _) when Ident.name id' = name -> true | _ -> false) items
497
542
498
-
let value_name_exists name items =
543
+
let _value_name_exists name items =
499
544
List.exists (function | `Value (id', _, _) when Ident.name id' = name -> true | _ -> false) items
500
545
501
-
let module_name_exists name items =
546
+
let _module_name_exists name items =
502
547
List.exists (function | `Module (id', _, _) when Ident.name id' = name -> true | _ -> false) items
503
548
504
-
let module_type_name_exists name items =
549
+
let _module_type_name_exists name items =
505
550
List.exists (function | `ModuleType (id', _, _) when Ident.name id' = name -> true | _ -> false) items
506
551
507
-
let class_name_exists name items =
552
+
let _class_name_exists name items =
508
553
List.exists (function | `Class (id',_,_,_,_,_) when Ident.name id' = name -> true | _ -> false) items
509
554
510
555
let class_type_name_exists name items =
···
512
557
513
558
let add_items : Id.Signature.t -> item list -> t -> t = fun parent items env ->
514
559
let open Odoc_model.Paths.Identifier in
560
+
let counts = build_shadow_counts items in
515
561
let rec inner items env =
516
562
match items with
517
563
| `Type (t, is_hidden_item, loc) :: rest ->
518
564
let name = Ident.name t in
519
-
let is_shadowed = type_name_exists name rest in
565
+
let is_shadowed = check_and_decrement counts.sc_types name in
520
566
let identifier, shadowed =
521
567
if is_shadowed
522
568
then Mk.type_(parent, TypeName.shadowed_of_string name), t :: env.shadowed
···
552
598
553
599
| `Value (t, is_hidden_item, loc) :: rest ->
554
600
let name = Ident.name t in
555
-
let is_shadowed = value_name_exists name rest in
601
+
let is_shadowed = check_and_decrement counts.sc_values name in
556
602
let identifier, shadowed =
557
603
if is_shadowed
558
604
then Mk.value(parent, ValueName.shadowed_of_string name), t :: env.shadowed
···
564
610
565
611
| `ModuleType (t, is_hidden_item, loc) :: rest ->
566
612
let name = Ident.name t in
567
-
let is_shadowed = module_type_name_exists name rest in
613
+
let is_shadowed = check_and_decrement counts.sc_module_types name in
568
614
let identifier, shadowed =
569
615
if is_shadowed
570
616
then Mk.module_type(parent, ModuleTypeName.shadowed_of_string name), t :: env.shadowed
···
576
622
577
623
| `Module (t, is_hidden_item, loc) :: rest ->
578
624
let name = Ident.name t in
579
-
let is_shadowed = module_name_exists name rest in
625
+
let is_shadowed = check_and_decrement counts.sc_modules name in
580
626
let identifier, shadowed =
581
627
if is_shadowed
582
628
then Mk.module_(parent, ModuleName.shadowed_of_string name), t :: env.shadowed
···
590
636
591
637
| `Class (t,t2,t3,t4, is_hidden_item, loc) :: rest ->
592
638
let name = Ident.name t in
593
-
let is_shadowed = class_name_exists name rest in
639
+
let is_shadowed = check_and_decrement counts.sc_classes name in
594
640
let class_types = match t4 with
595
641
| None -> [t;t2;t3]
596
642
| Some t4 -> [t;t2;t3;t4]
···
611
657
612
658
| `ClassType (t,t2,t3, is_hidden_item, loc) :: rest ->
613
659
let name = Ident.name t in
614
-
let is_shadowed = class_type_name_exists name rest in
660
+
let is_shadowed = check_and_decrement counts.sc_class_types name in
615
661
let class_types = match t3 with
616
662
| None -> [t;t2]
617
663
| Some t3 -> [t;t2;t3]