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

@@ -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 map_and_fold =
-  let aux_changed arr ~f i =
+  let rec aux_changed arr ~f current i =
-    for i = i to Array.length arr - 1 do
+    if i >= Array.length arr then arr
-      Array.unsafe_get arr i |> f |> Array.unsafe_set arr i
+    else
-    done ;
+      let e = Array.unsafe_get arr i in
-    arr
+      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
+      let next, e' = f current e in
-      if equal e e' then aux_unchanged ~equal arr ~f (i + 1)
+      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 ->
+  fun (NotReversed instrs as t) ~f ~init ->
-    let instrs' = aux_unchanged ~equal instrs ~f 0 in
+    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'
 

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 :
+val map : not_reversed_t -> f:(Sil.instr -> Sil.instr) -> not_reversed_t
-     equal:(Sil.instr -> Sil.instr -> bool)
+(** replace every instruction [instr] with [f instr]. Preserve physical equality. **)
-  -> not_reversed_t
+
-  -> f:(Sil.instr -> Sil.instr)
+val map_and_fold :
-  -> not_reversed_t
+  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
-val concat_map_changed :
+    folding [f] on [init] and previous instructions (before [instr]) in the collection. Preserve
-     equal:(Sil.instr -> Sil.instr -> bool)
+    physical equality. **)
-  -> not_reversed_t
+
-  -> f:(Sil.instr -> Sil.instr array)
+val concat_map : not_reversed_t -> f:(Sil.instr -> Sil.instr array) -> not_reversed_t
-  -> not_reversed_t
+(** replace every instruction [instr] with the list [f instr]. Preserve physical equality. **)
 
 val reverse_order : not_reversed_t -> reversed t
 

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' ;