Seq: fix two traversal bugs

perf bug in block: stop traversal as soon as possible
bug in prepare_shared: put shareable tag
This commit is contained in:
Frédéric Bour 2020-05-06 15:30:39 +02:00 committed by Frédéric Bour
parent 07d92b205b
commit 66af463b2e
1 changed files with 10 additions and 3 deletions

View File

@ -113,13 +113,15 @@ module Reducer = struct
| Nil -> () | Nil -> ()
| Leaf t' -> | Leaf t' ->
let mark = t'.mark in let mark = t'.mark in
if mark land both_mask <> both_mask then ( if mark land both_mask <> both_mask && mark land both_mask <> 0
then (
new_blocked stats; new_blocked stats;
t'.mark <- mark lor both_mask t'.mark <- mark lor both_mask
) )
| Join t' -> | Join t' ->
let mark = t'.mark in let mark = t'.mark in
if mark land both_mask <> both_mask then ( if mark land both_mask <> both_mask && mark land both_mask <> 0
then (
new_blocked stats; new_blocked stats;
t'.mark <- mark lor both_mask; t'.mark <- mark lor both_mask;
block stats t'.l; block stats t'.l;
@ -275,7 +277,12 @@ module Reducer = struct
let prepare_shared st = let prepare_shared st =
for i = 0 to st.shared_index - 1 do for i = 0 to st.shared_index - 1 do
match st.shared_x.(i) with begin match st.shared.(i) with
| Nil -> ()
| Leaf t -> t.mark <- t.mark lor both_mask
| Join t -> t.mark <- t.mark lor both_mask
end;
begin match st.shared_x.(i) with
| [] -> assert false | [] -> assert false
| [_] -> () | [_] -> ()
| xs -> st.shared_x.(i) <- List.rev xs | xs -> st.shared_x.(i) <- List.rev xs