Less invasive instrumentation for applications

Fixes #319.

src/ppx/instrument.ml

@@ -167,9 +167,7 @@ struct
             [@metaloc point_loc]
         else
           [%expr
-            let ___bisect_result___ = [%e e] in
-            ___bisect_visit___ [%e point_index];
-            ___bisect_result___]
+            ___bisect_post_visit___ [%e point_index] [%e e]]
             [@metaloc point_loc]
 
     and choose_location_of_point ~override_loc ~use_loc_of e =
@@ -916,12 +914,24 @@ struct
           [@metaloc loc]
       in
 
+      let bisect_post_visit =
+        [%stri
+          let ___bisect_post_visit___ point_index result =
+            ___bisect_visit___ point_index;
+            result
+        ]
+          [@metaloc loc]
+      in
+
       let open Ast.Ast_helper in
 
       Str.module_ ~loc @@
         Mb.mk ~loc
           (Location.mkloc (Some mangled_module_name) loc)
-          (Mod.structure ~loc [bisect_visit_function])
+          (Mod.structure ~loc [
+            bisect_visit_function;
+            bisect_post_visit;
+          ])
     in
 
     let module_open =

test/unit/fixtures/attributes/expression.reference.ml

@@ -8,47 +8,32 @@ module Bisect_visit___expression___ml =
         Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None
           "expression.ml" ~point_count:24 ~point_definitions in
       cb
+    let ___bisect_post_visit___ point_index result =
+      ___bisect_visit___ point_index; result
   end
 open Bisect_visit___expression___ml
 [@@@ocaml.text "/*"]
 let fn _ = ___bisect_visit___ 0; ()
 let () =
   if true
   then ((fn 1)[@coverage off])
-  else
-    (___bisect_visit___ 2;
-     (let ___bisect_result___ = fn 2 in
-      ___bisect_visit___ 1; ___bisect_result___))
-;;let ___bisect_result___ = fn 3 in ___bisect_visit___ 3; ___bisect_result___
+  else (___bisect_visit___ 2; ___bisect_post_visit___ 1 (fn 2))
+;;___bisect_post_visit___ 3 (fn 3)
 ;;((fn 4)[@coverage off])
 ;;((fn (if true then 5 else 6))[@coverage off])
-let () =
-  let ___bisect_result___ = fn () in
-  ___bisect_visit___ 4; ___bisect_result___
+let () = ___bisect_post_visit___ 4 (fn ())
 let () = ((fn)[@coverage off]) ()
-let () =
-  (let ___bisect_result___ = fn () in
-   ___bisect_visit___ 5; ___bisect_result___);
-  ()
+let () = ___bisect_post_visit___ 5 (fn ()); ()
 let () = fn (); ((())[@coverage off])
-let () =
-  let ___bisect_result___ = fn @@ () in
-  ___bisect_visit___ 6; ___bisect_result___
+let () = ___bisect_post_visit___ 6 (fn @@ ())
 let () = ((fn)[@coverage off]) @@ ()
-let () =
-  let ___bisect_result___ = () |> fn in
-  ___bisect_visit___ 7; ___bisect_result___
+let () = ___bisect_post_visit___ 7 (() |> fn)
 let () = () |> ((fn)[@coverage off])
 let fn' _ _ = ___bisect_visit___ 8; ()
-let () =
-  let ___bisect_result___ = () |> (fn' ()) in
-  ___bisect_visit___ 9; ___bisect_result___
+let () = ___bisect_post_visit___ 9 (() |> (fn' ()))
 let () = () |> ((fn' ())[@coverage off])
 let () = () |> (((fn')[@coverage off]) ())
-let () =
-  (let ___bisect_result___ = () |> fn in
-   ___bisect_visit___ 10; ___bisect_result___);
-  ()
+let () = ___bisect_post_visit___ 10 (() |> fn); ()
 let () = () |> fn; ((())[@coverage off])
 let _ =
   if true
@@ -83,21 +68,11 @@ let _ =
     then true
     else false
 class foo = object method bar = ___bisect_visit___ 19; () end
-let () =
-  let _ =
-    let ___bisect_result___ = new foo in
-    ___bisect_visit___ 20; ___bisect_result___ in
-  ()
+let () = let _ = ___bisect_post_visit___ 20 (new foo) in ()
 let () = let _ = new foo in ((())[@coverage off])
 let () =
-  let o =
-    let ___bisect_result___ = new foo in
-    ___bisect_visit___ 22; ___bisect_result___ in
-  (let ___bisect_result___ = o#bar in
-   ___bisect_visit___ 21; ___bisect_result___);
-  ()
+  let o = ___bisect_post_visit___ 22 (new foo) in
+  ___bisect_post_visit___ 21 o#bar; ()
 let () =
-  let o =
-    let ___bisect_result___ = new foo in
-    ___bisect_visit___ 23; ___bisect_result___ in
+  let o = ___bisect_post_visit___ 23 (new foo) in
   o#bar; ((())[@coverage off])

test/unit/fixtures/attributes/floating.reference.ml

@@ -8,6 +8,8 @@ module Bisect_visit___floating___ml =
         Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None
           "floating.ml" ~point_count:0 ~point_definitions in
       cb
+    let ___bisect_post_visit___ point_index result =
+      ___bisect_visit___ point_index; result
   end
 open Bisect_visit___floating___ml
 [@@@ocaml.text "/*"]

test/unit/fixtures/attributes/include.reference.ml

@@ -8,6 +8,8 @@ module Bisect_visit___include___ml =
         Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None
           "include.ml" ~point_count:0 ~point_definitions in
       cb
+    let ___bisect_post_visit___ point_index result =
+      ___bisect_visit___ point_index; result
   end
 open Bisect_visit___include___ml
 [@@@ocaml.text "/*"]

test/unit/fixtures/attributes/let.reference.ml

@@ -8,6 +8,8 @@ module Bisect_visit___let___ml =
         Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None
           "let.ml" ~point_count:0 ~point_definitions in
       cb
+    let ___bisect_post_visit___ point_index result =
+      ___bisect_visit___ point_index; result
   end
 open Bisect_visit___let___ml
 [@@@ocaml.text "/*"]

test/unit/fixtures/exclude-file/source.reference.ml

@@ -8,16 +8,16 @@ module Bisect_visit___source___ml =
         Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None
           "source.ml" ~point_count:3 ~point_definitions in
       cb
+    let ___bisect_post_visit___ point_index result =
+      ___bisect_visit___ point_index; result
   end
 open Bisect_visit___source___ml
 [@@@ocaml.text "/*"]
 let f1 x y = if x = y then x + y else x - y
 let g s =
   ___bisect_visit___ 2;
   for i = 1 to 5 do
-    (___bisect_visit___ 1;
-     (let ___bisect_result___ = print_endline s in
-      ___bisect_visit___ 0; ___bisect_result___))
+    (___bisect_visit___ 1; ___bisect_post_visit___ 0 (print_endline s))
   done
 let f2 b x = if b then x * x else x
 let f3 : type a. a -> string = fun _ -> "Hello"

test/unit/fixtures/instrument/apply.reference.ml

@@ -8,33 +8,23 @@ module Bisect_visit___apply___ml =
         Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None
           "apply.ml" ~point_count:20 ~point_definitions in
       cb
+    let ___bisect_post_visit___ point_index result =
+      ___bisect_visit___ point_index; result
   end
 open Bisect_visit___apply___ml
 [@@@ocaml.text "/*"]
-let () =
-  let ___bisect_result___ = print_endline "foo" in
-  ___bisect_visit___ 0; ___bisect_result___
+let () = ___bisect_post_visit___ 0 (print_endline "foo")
 let f () = ___bisect_visit___ 1; print_endline "foo"
 let helper () = ___bisect_visit___ 2; print_endline
 let () =
-  let ___bisect_result___ =
-    (let ___bisect_result___ = helper () in
-     ___bisect_visit___ 3; ___bisect_result___) "foo" in
-  ___bisect_visit___ 3; ___bisect_result___
-let () =
-  let ___bisect_result___ = helper () "foo" in
-  ___bisect_visit___ 4; ___bisect_result___
+  ___bisect_post_visit___ 3 ((___bisect_post_visit___ 3 (helper ())) "foo")
+let () = ___bisect_post_visit___ 4 (helper () "foo")
 let helper () = ___bisect_visit___ 5; "foo"
 let () =
-  let ___bisect_result___ =
-    print_endline
-      (let ___bisect_result___ = helper () in
-       ___bisect_visit___ 6; ___bisect_result___) in
-  ___bisect_visit___ 7; ___bisect_result___
+  ___bisect_post_visit___ 7
+    (print_endline (___bisect_post_visit___ 6 (helper ())))
 let helper ?foo  ~bar  () = ___bisect_visit___ 8; ()
-let () =
-  let ___bisect_result___ = (helper ~bar:()) @@ () in
-  ___bisect_visit___ 9; ___bisect_result___
+let () = ___bisect_post_visit___ 9 ((helper ~bar:()) @@ ())
 let f : unit -> unit = helper ~bar:()
 let _ =
   if false
@@ -47,15 +37,9 @@ let _ =
 let _ = true && (___bisect_visit___ 14; true)
 let _ = true & (___bisect_visit___ 15; true)
 let _ =
-  if
-    ((let ___bisect_result___ = print_endline "foo" in
-      ___bisect_visit___ 19; ___bisect_result___);
-     false)
+  if (___bisect_post_visit___ 19 (print_endline "foo"); false)
   then (___bisect_visit___ 16; true)
   else
-    if
-      ((let ___bisect_result___ = print_endline "bar" in
-        ___bisect_visit___ 18; ___bisect_result___);
-       true)
+    if (___bisect_post_visit___ 18 (print_endline "bar"); true)
     then (___bisect_visit___ 17; true)
     else false

test/unit/fixtures/instrument/array.reference.ml

@@ -8,11 +8,11 @@ module Bisect_visit___array___ml =
         Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None
           "array.ml" ~point_count:2 ~point_definitions in
       cb
+    let ___bisect_post_visit___ point_index result =
+      ___bisect_visit___ point_index; result
   end
 open Bisect_visit___array___ml
 [@@@ocaml.text "/*"]
 let _ =
-  [|(((let ___bisect_result___ = print_endline "foo" in
-       ___bisect_visit___ 0; ___bisect_result___)),
-      ((let ___bisect_result___ = print_endline "bar" in
-        ___bisect_visit___ 1; ___bisect_result___)))|]
+  [|((___bisect_post_visit___ 0 (print_endline "foo")),
+      (___bisect_post_visit___ 1 (print_endline "bar")))|]

test/unit/fixtures/instrument/assert.reference.ml

@@ -8,16 +8,14 @@ module Bisect_visit___assert___ml =
         Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None
           "assert.ml" ~point_count:1 ~point_definitions in
       cb
+    let ___bisect_post_visit___ point_index result =
+      ___bisect_visit___ point_index; result
   end
 open Bisect_visit___assert___ml
 [@@@ocaml.text "/*"]
 let () = assert true
 let f () = assert true
-let () =
-  assert
-    ((let ___bisect_result___ = print_endline "foo" in
-      ___bisect_visit___ 0; ___bisect_result___);
-     true)
+let () = assert (___bisect_post_visit___ 0 (print_endline "foo"); true)
 let () = assert false
 let f = function | `A -> assert false
 let () = match `A with | `A -> assert false

test/unit/fixtures/instrument/attribute.reference.ml

@@ -8,6 +8,8 @@ module Bisect_visit___attribute___ml =
         Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None
           "attribute.ml" ~point_count:0 ~point_definitions in
       cb
+    let ___bisect_post_visit___ point_index result =
+      ___bisect_visit___ point_index; result
   end
 open Bisect_visit___attribute___ml
 [@@@ocaml.text "/*"]

test/unit/fixtures/instrument/cases.reference.ml

@@ -8,6 +8,8 @@ module Bisect_visit___cases___ml =
         Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None
           "cases.ml" ~point_count:54 ~point_definitions in
       cb
+    let ___bisect_post_visit___ point_index result =
+      ___bisect_visit___ point_index; result
   end
 open Bisect_visit___cases___ml
 [@@@ocaml.text "/*"]
@@ -17,15 +19,12 @@ type ('a, 'b) record = {
 let () =
   match `A with
   | `A ->
-      (___bisect_visit___ 1;
-       (let ___bisect_result___ = print_endline "foo" in
-        ___bisect_visit___ 0; ___bisect_result___))
+      (___bisect_visit___ 1; ___bisect_post_visit___ 0 (print_endline "foo"))
 let () =
   match `A with
   | `A when
       ___bisect_visit___ 4;
-      (let ___bisect_result___ = print_endline "foo" in
-       ___bisect_visit___ 2; ___bisect_result___);
+      ___bisect_post_visit___ 2 (print_endline "foo");
       true -> (___bisect_visit___ 3; ())
   | _ -> (___bisect_visit___ 5; ())
 let () = match `A with | `A -> assert false
@@ -157,24 +156,21 @@ let () =
          | `B -> (___bisect_visit___ 41; ())
          | _ -> ()))
       [@ocaml.warning "-4-8-9-11-26-27-28"]);
-      (let ___bisect_result___ = print_endline "foo" in
-       ___bisect_visit___ 39; ___bisect_result___);
+      ___bisect_post_visit___ 39 (print_endline "foo");
       true -> (___bisect_visit___ 42; ())
   | _ -> (___bisect_visit___ 43; ())
 let () =
   match `A with
   | `A -> (___bisect_visit___ 45; ())
   | exception Exit ->
       (___bisect_visit___ 46;
-       (let ___bisect_result___ = print_endline "foo" in
-        ___bisect_visit___ 44; ___bisect_result___))
+       ___bisect_post_visit___ 44 (print_endline "foo"))
 let () =
   match `A with
   | `A -> (___bisect_visit___ 48; ())
   | exception Exit when
       ___bisect_visit___ 50;
-      (let ___bisect_result___ = print_endline "foo" in
-       ___bisect_visit___ 47; ___bisect_result___);
+      ___bisect_post_visit___ 47 (print_endline "foo");
       true -> (___bisect_visit___ 49; ())
 let () =
   match `A with

test/unit/fixtures/instrument/class.reference.ml

@@ -8,26 +8,19 @@ module Bisect_visit___class___ml =
         Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None
           "class.ml" ~point_count:11 ~point_definitions in
       cb
+    let ___bisect_post_visit___ point_index result =
+      ___bisect_visit___ point_index; result
   end
 open Bisect_visit___class___ml
 [@@@ocaml.text "/*"]
 class default ?(foo= ___bisect_visit___ 0; ())  () = object  end
 class applied = ((default)
-  ~foo:(let ___bisect_result___ = print_endline "foo" in
-        ___bisect_visit___ 1; ___bisect_result___)
-  (let ___bisect_result___ = print_endline "bar" in
-   ___bisect_visit___ 2; ___bisect_result___))
-class let_ =
-  let foo =
-    let ___bisect_result___ = print_endline "foo" in
-    ___bisect_visit___ 3; ___bisect_result___
-  in ((default) foo)
+  ~foo:(___bisect_post_visit___ 1 (print_endline "foo"))
+  (___bisect_post_visit___ 2 (print_endline "bar")))
+class let_ = let foo = ___bisect_post_visit___ 3 (print_endline "foo") in
+  ((default) foo)
 class val_ =
-  object
-    val foo =
-      let ___bisect_result___ = print_endline "foo" in
-      ___bisect_visit___ 4; ___bisect_result___
-  end
+  object val foo = ___bisect_post_visit___ 4 (print_endline "foo") end
 class method_1 =
   object method foo = ___bisect_visit___ 5; print_endline "foo" end
 class method_2 =
@@ -40,7 +33,5 @@ class method_4 =
 class initializer_ =
   object
     initializer
-      ___bisect_visit___ 10;
-      (let ___bisect_result___ = print_endline "foo" in
-       ___bisect_visit___ 9; ___bisect_result___)
+      ___bisect_visit___ 10; ___bisect_post_visit___ 9 (print_endline "foo")
   end

test/unit/fixtures/instrument/coerce.reference.ml

@@ -8,10 +8,10 @@ module Bisect_visit___coerce___ml =
         Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None
           "coerce.ml" ~point_count:1 ~point_definitions in
       cb
+    let ___bisect_post_visit___ point_index result =
+      ___bisect_visit___ point_index; result
   end
 open Bisect_visit___coerce___ml
 [@@@ocaml.text "/*"]
-let () =
-  (let ___bisect_result___ = print_endline "foo" in
-   ___bisect_visit___ 0; ___bisect_result___ : unit  :> unit)
+let () = (___bisect_post_visit___ 0 (print_endline "foo") : unit  :> unit)
 let f () = (print_endline "foo" : unit  :> unit)

test/unit/fixtures/instrument/constant.reference.ml

@@ -8,6 +8,8 @@ module Bisect_visit___constant___ml =
         Bisect.Runtime.register_file ~bisect_file:None ~bisect_silent:None
           "constant.ml" ~point_count:0 ~point_definitions in
       cb
+    let ___bisect_post_visit___ point_index result =
+      ___bisect_visit___ point_index; result
   end
 open Bisect_visit___constant___ml
 [@@@ocaml.text "/*"]