From eafaa6bbe69ef1d30b19adea3c01d051116e0163 Mon Sep 17 00:00:00 2001 From: Geoff Reedy Date: Wed, 8 Jun 2022 14:59:42 -0600 Subject: [PATCH] Use raise_without_backtrace in Map, Set Map and Set use some exceptions for control flow that were being raised with plain `raise`. This meant that stack traces were being created for these exception that couldn't escape their outer function causing an unfortunate performance loss. Raising these exceptions with `raise_without_backtrace` avoids the performance problem. Signed-off-by: Geoff Reedy --- src/map.ml | 2 +- src/set.ml | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/map.ml b/src/map.ml index f2ec0d01..b9f687d6 100644 --- a/src/map.ml +++ b/src/map.ml @@ -686,7 +686,7 @@ module Tree0 = struct match t with | Empty -> (match f None with - | None -> raise Change_no_op (* equivalent to returning: Empty *) + | None -> Exn.raise_without_backtrace Change_no_op (* equivalent to returning: Empty *) | Some data -> Leaf (key, data), length + 1) | Leaf (v, d) -> let c = compare_key key v in diff --git a/src/set.ml b/src/set.ml index 099c6877..da4ba902 100644 --- a/src/set.ml +++ b/src/set.ml @@ -252,13 +252,13 @@ module Tree0 = struct | Leaf v -> let c = compare_elt x v in if c = 0 - then raise Same + then Exn.raise_without_backtrace Same else if c < 0 then bal (Leaf x) v Empty else bal Empty v (Leaf x) | Node (l, v, r, _, _) -> let c = compare_elt x v in - if c = 0 then raise Same else if c < 0 then bal (aux l) v r else bal l v (aux r) + if c = 0 then Exn.raise_without_backtrace Same else if c < 0 then bal (aux l) v r else bal l v (aux r) in try aux t with | Same -> t @@ -421,8 +421,8 @@ module Tree0 = struct let remove t x ~compare_elt = let rec aux t = match t with - | Empty -> raise Same - | Leaf v -> if compare_elt x v = 0 then Empty else raise Same + | Empty -> Exn.raise_without_backtrace Same + | Leaf v -> if compare_elt x v = 0 then Empty else Exn.raise_without_backtrace Same | Node (l, v, r, _, _) -> let c = compare_elt x v in if c = 0 then merge l r else if c < 0 then bal (aux l) v r else bal l v (aux r) @@ -434,8 +434,8 @@ module Tree0 = struct let remove_index t i ~compare_elt:_ = let rec aux t i = match t with - | Empty -> raise Same - | Leaf _ -> if i = 0 then Empty else raise Same + | Empty -> Exn.raise_without_backtrace Same + | Leaf _ -> if i = 0 then Empty else Exn.raise_without_backtrace Same | Node (l, v, r, _, _) -> let l_size = length l in let c = Poly.compare i l_size in