@@ -3504,20 +3504,24 @@ let remove (h : _ Hash_set_gen.t) key =
3504
3504
3505
3505
let add (h : _ Hash_set_gen.t ) key =
3506
3506
(* 4103 *) let i = key_index h key in
3507
- if not (Hash_set_gen. small_bucket_mem eq_key key (Array. unsafe_get h.data i)) then
3507
+ let h_data = h.data in
3508
+ let old_bucket = (Array. unsafe_get h_data i) in
3509
+ if not (Hash_set_gen. small_bucket_mem eq_key key old_bucket) then
3508
3510
begin
3509
- h.data.(i) < - key :: h.data.(i );
3511
+ Array. unsafe_set h_data i ( key :: old_bucket );
3510
3512
h.size < - h.size + 1 ;
3511
- if h.size > Array. length h.data lsl 1 then Hash_set_gen. resize key_index h
3513
+ if h.size > Array. length h_data lsl 1 then Hash_set_gen. resize key_index h
3512
3514
end
3513
3515
3514
3516
let check_add (h : _ Hash_set_gen.t ) key =
3515
3517
(* 0 *) let i = key_index h key in
3516
- if not (Hash_set_gen. small_bucket_mem eq_key key (Array. unsafe_get h.data i)) then
3518
+ let h_data = h.data in
3519
+ let old_bucket = (Array. unsafe_get h_data i) in
3520
+ if not (Hash_set_gen. small_bucket_mem eq_key key old_bucket) then
3517
3521
begin
3518
- h.data.(i) < - key :: h.data.(i );
3522
+ Array. unsafe_set h_data i ( key :: old_bucket );
3519
3523
h.size < - h.size + 1 ;
3520
- if h.size > Array. length h.data lsl 1 then Hash_set_gen. resize key_index h;
3524
+ if h.size > Array. length h_data lsl 1 then Hash_set_gen. resize key_index h;
3521
3525
true
3522
3526
end
3523
3527
else false
@@ -3526,7 +3530,7 @@ let check_add (h : _ Hash_set_gen.t) key =
3526
3530
let mem (h : _ Hash_set_gen.t ) key =
3527
3531
(* 3102 *) Hash_set_gen. small_bucket_mem eq_key key (Array. unsafe_get h.data (key_index h key))
3528
3532
3529
- # 106
3533
+ # 110
3530
3534
end
3531
3535
3532
3536
@@ -3641,20 +3645,24 @@ let remove (h : _ Hash_set_gen.t) key =
3641
3645
3642
3646
let add (h : _ Hash_set_gen.t ) key =
3643
3647
(* 15004 *) let i = key_index h key in
3644
- if not (Hash_set_gen. small_bucket_mem eq_key key (Array. unsafe_get h.data i)) then
3648
+ let h_data = h.data in
3649
+ let old_bucket = (Array. unsafe_get h_data i) in
3650
+ if not (Hash_set_gen. small_bucket_mem eq_key key old_bucket) then
3645
3651
begin
3646
- h.data.(i) < - key :: h.data.(i );
3652
+ Array. unsafe_set h_data i ( key :: old_bucket );
3647
3653
h.size < - h.size + 1 ;
3648
- if h.size > Array. length h.data lsl 1 then Hash_set_gen. resize key_index h
3654
+ if h.size > Array. length h_data lsl 1 then Hash_set_gen. resize key_index h
3649
3655
end
3650
3656
3651
3657
let check_add (h : _ Hash_set_gen.t ) key =
3652
3658
(* 0 *) let i = key_index h key in
3653
- if not (Hash_set_gen. small_bucket_mem eq_key key (Array. unsafe_get h.data i)) then
3659
+ let h_data = h.data in
3660
+ let old_bucket = (Array. unsafe_get h_data i) in
3661
+ if not (Hash_set_gen. small_bucket_mem eq_key key old_bucket) then
3654
3662
begin
3655
- h.data.(i) < - key :: h.data.(i );
3663
+ Array. unsafe_set h_data i ( key :: old_bucket );
3656
3664
h.size < - h.size + 1 ;
3657
- if h.size > Array. length h.data lsl 1 then Hash_set_gen. resize key_index h;
3665
+ if h.size > Array. length h_data lsl 1 then Hash_set_gen. resize key_index h;
3658
3666
true
3659
3667
end
3660
3668
else false
@@ -4069,20 +4077,24 @@ let remove (h : _ Hash_set_gen.t) key =
4069
4077
4070
4078
let add (h : _ Hash_set_gen.t ) key =
4071
4079
(* 101 *) let i = key_index h key in
4072
- if not (Hash_set_gen. small_bucket_mem eq_key key (Array. unsafe_get h.data i)) then
4080
+ let h_data = h.data in
4081
+ let old_bucket = (Array. unsafe_get h_data i) in
4082
+ if not (Hash_set_gen. small_bucket_mem eq_key key old_bucket) then
4073
4083
begin
4074
- h.data.(i) < - key :: h.data.(i );
4084
+ Array. unsafe_set h_data i ( key :: old_bucket );
4075
4085
h.size < - h.size + 1 ;
4076
- if h.size > Array. length h.data lsl 1 then Hash_set_gen. resize key_index h
4086
+ if h.size > Array. length h_data lsl 1 then Hash_set_gen. resize key_index h
4077
4087
end
4078
4088
4079
4089
let check_add (h : _ Hash_set_gen.t ) key =
4080
4090
(* 8 *) let i = key_index h key in
4081
- if not (Hash_set_gen. small_bucket_mem eq_key key (Array. unsafe_get h.data i)) then
4091
+ let h_data = h.data in
4092
+ let old_bucket = (Array. unsafe_get h_data i) in
4093
+ if not (Hash_set_gen. small_bucket_mem eq_key key old_bucket) then
4082
4094
begin
4083
- h.data.(i) < - key :: h.data.(i );
4095
+ Array. unsafe_set h_data i ( key :: old_bucket );
4084
4096
h.size < - h.size + 1 ;
4085
- if h.size > Array. length h.data lsl 1 then Hash_set_gen. resize key_index h;
4097
+ if h.size > Array. length h_data lsl 1 then Hash_set_gen. resize key_index h;
4086
4098
true
4087
4099
end
4088
4100
else false
@@ -4319,20 +4331,24 @@ let remove (h : _ Hash_set_gen.t) key =
4319
4331
4320
4332
let add (h : _ Hash_set_gen.t ) key =
4321
4333
(* 0 *) let i = key_index h key in
4322
- if not (Hash_set_gen. small_bucket_mem eq_key key (Array. unsafe_get h.data i)) then
4334
+ let h_data = h.data in
4335
+ let old_bucket = (Array. unsafe_get h_data i) in
4336
+ if not (Hash_set_gen. small_bucket_mem eq_key key old_bucket) then
4323
4337
begin
4324
- h.data.(i) < - key :: h.data.(i );
4338
+ Array. unsafe_set h_data i ( key :: old_bucket );
4325
4339
h.size < - h.size + 1 ;
4326
- if h.size > Array. length h.data lsl 1 then Hash_set_gen. resize key_index h
4340
+ if h.size > Array. length h_data lsl 1 then Hash_set_gen. resize key_index h
4327
4341
end
4328
4342
4329
4343
let check_add (h : _ Hash_set_gen.t ) key =
4330
4344
(* 0 *) let i = key_index h key in
4331
- if not (Hash_set_gen. small_bucket_mem eq_key key (Array. unsafe_get h.data i)) then
4345
+ let h_data = h.data in
4346
+ let old_bucket = (Array. unsafe_get h_data i) in
4347
+ if not (Hash_set_gen. small_bucket_mem eq_key key old_bucket) then
4332
4348
begin
4333
- h.data.(i) < - key :: h.data.(i );
4349
+ Array. unsafe_set h_data i ( key :: old_bucket );
4334
4350
h.size < - h.size + 1 ;
4335
- if h.size > Array. length h.data lsl 1 then Hash_set_gen. resize key_index h;
4351
+ if h.size > Array. length h_data lsl 1 then Hash_set_gen. resize key_index h;
4336
4352
true
4337
4353
end
4338
4354
else false
@@ -4665,10 +4681,10 @@ let stats = Hashtbl_gen.stats
4665
4681
4666
4682
let add (h : _ t ) key info =
4667
4683
(* 2000 *) let i = key_index h key in
4668
- let bucket : _ bucketlist = Cons (key, info, h.data.(i)) in
4669
- h.data.(i) < - bucket ;
4684
+ let h_data = h.data in
4685
+ Array. unsafe_set h_data i ( Cons (key, info, ( Array. unsafe_get h_data i))) ;
4670
4686
h.size < - h.size + 1 ;
4671
- if h.size > Array. length h.data lsl 1 then Hashtbl_gen. resize key_index h
4687
+ if h.size > Array. length h_data lsl 1 then Hashtbl_gen. resize key_index h
4672
4688
4673
4689
(* after upgrade to 4.04 we should provide an efficient [replace_or_init] *)
4674
4690
let modify_or_init (h : _ t ) key modf default =
@@ -4679,86 +4695,98 @@ let modify_or_init (h : _ t) key modf default =
4679
4695
else find_bucket next
4680
4696
| Empty -> (* 0 *) true in
4681
4697
let i = key_index h key in
4682
- if find_bucket h.data.(i) then
4698
+ let h_data = h.data in
4699
+ if find_bucket (Array. unsafe_get h_data i) then
4683
4700
begin
4684
- h.data.(i) < - Cons (key,default () ,h.data.( i));
4701
+ Array. unsafe_set h_data i ( Cons (key,default () , Array. unsafe_get h_data i));
4685
4702
h.size < - h.size + 1 ;
4686
- if h.size > Array. length h.data lsl 1 then Hashtbl_gen. resize key_index h
4703
+ if h.size > Array. length h_data lsl 1 then Hashtbl_gen. resize key_index h
4687
4704
end
4688
4705
4706
+
4707
+ let rec remove_bucket key (h : _ t ) (bucketlist : _ bucketlist ) : _ bucketlist =
4708
+ (* 0 *) match bucketlist with
4709
+ | Empty ->
4710
+ (* 0 *) Empty
4711
+ | Cons (k , i , next ) ->
4712
+ (* 0 *) if eq_key k key
4713
+ then begin h.size < - h.size - 1 ; next end
4714
+ else Cons (k, i, remove_bucket key h next)
4715
+
4689
4716
let remove (h : _ t ) key =
4690
- (* 0 *) let rec remove_bucket (bucketlist : _ bucketlist ) : _ bucketlist = (* 0 *) match bucketlist with
4691
- | Empty ->
4692
- (* 0 *) Empty
4693
- | Cons (k , i , next ) ->
4694
- (* 0 *) if eq_key k key
4695
- then begin h.size < - h.size - 1 ; next end
4696
- else Cons (k, i, remove_bucket next) in
4697
- let i = key_index h key in
4698
- h.data.(i) < - remove_bucket h.data.(i)
4717
+ (* 0 *) let i = key_index h key in
4718
+ let h_data = h.data in
4719
+ let old_h_szie = h.size in
4720
+ let new_bucket = remove_bucket key h (Array. unsafe_get h_data i) in
4721
+ if old_h_szie <> h.size then
4722
+ Array. unsafe_set h_data i new_bucket
4699
4723
4700
4724
let rec find_rec key (bucketlist : _ bucketlist ) = (* 0 *) match bucketlist with
4701
4725
| Empty ->
4702
- (* 0 *) raise Not_found
4726
+ (* 0 *) raise Not_found
4703
4727
| Cons (k , d , rest ) ->
4704
- (* 0 *) if eq_key key k then d else find_rec key rest
4728
+ (* 0 *) if eq_key key k then d else find_rec key rest
4705
4729
4706
4730
let find_exn (h : _ t ) key =
4707
- (* 0 *) match h.data. (key_index h key) with
4731
+ (* 0 *) match Array. unsafe_get h.data (key_index h key) with
4708
4732
| Empty -> (* 0 *) raise Not_found
4709
4733
| Cons (k1 , d1 , rest1 ) ->
4710
- (* 0 *) if eq_key key k1 then d1 else
4734
+ (* 0 *) if eq_key key k1 then d1 else
4711
4735
match rest1 with
4712
4736
| Empty -> (* 0 *) raise Not_found
4713
4737
| Cons (k2 , d2 , rest2 ) ->
4714
- (* 0 *) if eq_key key k2 then d2 else
4738
+ (* 0 *) if eq_key key k2 then d2 else
4715
4739
match rest2 with
4716
4740
| Empty -> (* 0 *) raise Not_found
4717
4741
| Cons (k3 , d3 , rest3 ) ->
4718
- (* 0 *) if eq_key key k3 then d3 else find_rec key rest3
4742
+ (* 0 *) if eq_key key k3 then d3 else find_rec key rest3
4719
4743
4720
4744
let find_opt (h : _ t ) key =
4721
4745
(* 0 *) Hashtbl_gen. small_bucket_opt eq_key key (Array. unsafe_get h.data (key_index h key))
4722
4746
let find_default (h : _ t ) key default =
4723
4747
(* 0 *) Hashtbl_gen. small_bucket_default eq_key key default (Array. unsafe_get h.data (key_index h key))
4724
4748
let find_all (h : _ t ) key =
4725
4749
(* 0 *) let rec find_in_bucket (bucketlist : _ bucketlist ) = (* 0 *) match bucketlist with
4726
- | Empty ->
4750
+ | Empty ->
4727
4751
(* 0 *) []
4728
- | Cons (k , d , rest ) ->
4752
+ | Cons (k , d , rest ) ->
4729
4753
(* 0 *) if eq_key k key
4730
4754
then d :: find_in_bucket rest
4731
4755
else find_in_bucket rest in
4732
- find_in_bucket h.data. (key_index h key)
4756
+ find_in_bucket ( Array. unsafe_get h.data (key_index h key) )
4733
4757
4734
4758
let replace h key info =
4735
4759
(* 2000 *) let rec replace_bucket (bucketlist : _ bucketlist ) : _ bucketlist = (* 4462 *) match bucketlist with
4736
4760
| Empty ->
4737
- (* 1000 *) raise_notrace Not_found
4761
+ (* 1000 *) raise_notrace Not_found
4738
4762
| Cons (k , i , next ) ->
4739
- (* 3462 *) if eq_key k key
4740
- then Cons (key, info, next)
4741
- else Cons (k, i, replace_bucket next) in
4763
+ (* 3462 *) if eq_key k key
4764
+ then Cons (key, info, next)
4765
+ else Cons (k, i, replace_bucket next) in
4742
4766
let i = key_index h key in
4743
- let l = h.data.(i) in
4767
+ let h_data = h.data in
4768
+ let l = Array. unsafe_get h_data i in
4744
4769
try
4745
- h.data.(i) < - replace_bucket l
4770
+ Array. unsafe_set h_data i ( replace_bucket l)
4746
4771
with Not_found ->
4747
- h.data.(i) < - Cons (key, info, l);
4748
- h.size < - h.size + 1 ;
4749
- if h.size > Array. length h.data lsl 1 then Hashtbl_gen. resize key_index h
4772
+ begin
4773
+ Array. unsafe_set h_data i (Cons (key, info, l));
4774
+ h.size < - h.size + 1 ;
4775
+ if h.size > Array. length h_data lsl 1 then Hashtbl_gen. resize key_index h;
4776
+ end
4750
4777
4751
4778
let mem (h : _ t ) key =
4752
4779
(* 0 *) let rec mem_in_bucket (bucketlist : _ bucketlist ) = (* 0 *) match bucketlist with
4753
- | Empty ->
4780
+ | Empty ->
4754
4781
(* 0 *) false
4755
- | Cons (k , d , rest ) ->
4782
+ | Cons (k , d , rest ) ->
4756
4783
(* 0 *) eq_key k key || mem_in_bucket rest in
4757
- mem_in_bucket h.data. (key_index h key)
4784
+ mem_in_bucket ( Array. unsafe_get h.data (key_index h key) )
4758
4785
4759
4786
4760
4787
let of_list2 ks vs =
4761
- (* 0 *) let map = create 51 in
4788
+ (* 0 *) let len = List. length ks in
4789
+ let map = create len in
4762
4790
List. iter2 (fun k v -> (* 0 *) add map k v) ks vs ;
4763
4791
map
4764
4792
0 commit comments