From 121b7352f94d3f93f2c6a583ccc5eee8bfbce048 Mon Sep 17 00:00:00 2001 From: David Pichardie Date: Thu, 26 Mar 2020 08:28:54 -0700 Subject: [PATCH] More powerful version of Instrs.map_changed Summary: Introducing a generalization of map_changed that can now use a context on each instruction. The context is computed with the previous instructions in the collection. Reviewed By: skcho, jvillard Differential Revision: D20669993 fbshipit-source-id: 58fdee1d9 --- infer/src/IR/Instrs.ml | 35 +++++++++++++++++++++-------------- infer/src/IR/Instrs.mli | 22 +++++++++++----------- infer/src/IR/Procdesc.ml | 4 ++-- 3 files changed, 34 insertions(+), 27 deletions(-) diff --git a/infer/src/IR/Instrs.ml b/infer/src/IR/Instrs.ml index 55b3aec15..9a35b0315 100644 --- a/infer/src/IR/Instrs.ml +++ b/infer/src/IR/Instrs.ml @@ -70,34 +70,41 @@ let of_rev_list l = NotReversed (Array.of_list_rev l) let filter_map (NotReversed instrs) ~f = NotReversed (Array.filter_map instrs ~f) -let map_changed = - let aux_changed arr ~f i = - for i = i to Array.length arr - 1 do - Array.unsafe_get arr i |> f |> Array.unsafe_set arr i - done ; - arr +let map_and_fold = + let rec aux_changed arr ~f current i = + if i >= Array.length arr then arr + else + let e = Array.unsafe_get arr i in + let next, e' = f current e in + Array.unsafe_set arr i e' ; + aux_changed arr ~f next (i + 1) in - let rec aux_unchanged ~equal arr ~f i = + let rec aux_unchanged arr ~f current i = if i >= Array.length arr then arr else let e = Array.unsafe_get arr i in - let e' = f e in - if equal e e' then aux_unchanged ~equal arr ~f (i + 1) + let next, e' = f current e in + if phys_equal e e' then aux_unchanged arr ~f next (i + 1) else let arr = Array.copy arr in Array.unsafe_set arr i e' ; - aux_changed arr ~f (i + 1) + aux_changed arr ~f next (i + 1) in - fun ~equal (NotReversed instrs as t) ~f -> - let instrs' = aux_unchanged ~equal instrs ~f 0 in + fun (NotReversed instrs as t) ~f ~init -> + let instrs' = aux_unchanged instrs ~f init 0 in if phys_equal instrs instrs' then t else NotReversed instrs' -let concat_map_changed ~equal (NotReversed instrs as t) ~f = +let map (NotReversed _instrs as t) ~f = + let f () e = ((), f e) in + map_and_fold t ~f ~init:() + + +let concat_map (NotReversed instrs as t) ~f = let instrs' = Array.concat_map ~f instrs in if Int.equal (Array.length instrs) (Array.length instrs') - && Array.for_all2_exn ~f:equal instrs instrs' + && Array.for_all2_exn ~f:phys_equal instrs instrs' then t else NotReversed instrs' diff --git a/infer/src/IR/Instrs.mli b/infer/src/IR/Instrs.mli index 0b36959a0..1842b7b12 100644 --- a/infer/src/IR/Instrs.mli +++ b/infer/src/IR/Instrs.mli @@ -27,17 +27,17 @@ val of_rev_list : Sil.instr list -> not_reversed_t val filter_map : not_reversed_t -> f:(Sil.instr -> Sil.instr option) -> not_reversed_t -val map_changed : - equal:(Sil.instr -> Sil.instr -> bool) - -> not_reversed_t - -> f:(Sil.instr -> Sil.instr) - -> not_reversed_t - -val concat_map_changed : - equal:(Sil.instr -> Sil.instr -> bool) - -> not_reversed_t - -> f:(Sil.instr -> Sil.instr array) - -> not_reversed_t +val map : not_reversed_t -> f:(Sil.instr -> Sil.instr) -> not_reversed_t +(** replace every instruction [instr] with [f instr]. Preserve physical equality. **) + +val map_and_fold : + not_reversed_t -> f:('a -> Sil.instr -> 'a * Sil.instr) -> init:'a -> not_reversed_t +(** replace every instruction [instr] with [snd (f context instr)]. The context is computed by + folding [f] on [init] and previous instructions (before [instr]) in the collection. Preserve + physical equality. **) + +val concat_map : not_reversed_t -> f:(Sil.instr -> Sil.instr array) -> not_reversed_t +(** replace every instruction [instr] with the list [f instr]. Preserve physical equality. **) val reverse_order : not_reversed_t -> reversed t diff --git a/infer/src/IR/Procdesc.ml b/infer/src/IR/Procdesc.ml index 4b9646f97..9e2e060ae 100644 --- a/infer/src/IR/Procdesc.ml +++ b/infer/src/IR/Procdesc.ml @@ -246,7 +246,7 @@ module Node = struct (** Map and replace the instructions to be executed *) let replace_instrs node ~f = - let instrs' = Instrs.map_changed ~equal:phys_equal node.instrs ~f:(f node) in + let instrs' = Instrs.map node.instrs ~f:(f node) in if phys_equal instrs' node.instrs then false else ( node.instrs <- instrs' ; @@ -255,7 +255,7 @@ module Node = struct (** Like [replace_instrs], but 1 instr gets replaced by 0, 1, or more instructions. *) let replace_instrs_by node ~f = - let instrs' = Instrs.concat_map_changed ~equal:phys_equal node.instrs ~f:(f node) in + let instrs' = Instrs.concat_map node.instrs ~f:(f node) in if phys_equal instrs' node.instrs then false else ( node.instrs <- instrs' ;