Merge pull request #830 from o1-labs/perf/no-js-failwith

Avoid costly errors in JS witness generation

src/base/as_prover0.ml

@@ -60,18 +60,18 @@ module Provider = struct
 
   open Types.Provider
 
-  let run t stack tbl (handler : Request.Handler.t) =
+  let run t tbl (handler : Request.Handler.t) =
     match t with
     | Request rc ->
         let r = run rc tbl in
-        Request.Handler.run handler stack r
+        Request.Handler.run handler r
     | Compute c ->
-        run c tbl
+        Some (run c tbl)
     | Both (rc, c) -> (
         let r = run rc tbl in
-        match Request.Handler.run handler stack r with
-        | exception _ ->
-            run c tbl
+        match Request.Handler.run handler r with
+        | None | (exception _) ->
+            Some (run c tbl)
         | x ->
             x )
 end

src/base/as_prover_intf.ml

@@ -23,10 +23,9 @@ module type Basic = sig
 
     val run :
          ('a, 'f field) t
-      -> string list
       -> ('f field Cvar.t -> 'f field)
       -> Request.Handler.t
-      -> 'a
+      -> 'a option
   end
 
   module Handle : sig

src/base/checked_runner.ml

@@ -256,8 +256,15 @@ struct
           let old = Run_state.as_prover s in
           Run_state.set_as_prover s true ;
           let value =
-            As_prover.Provider.run p (Run_state.stack s) (get_value s)
-              (Run_state.handler s)
+            match
+              As_prover.Provider.run p (get_value s) (Run_state.handler s)
+            with
+            | Some x ->
+                x
+            | None ->
+                failwith
+                  ( "Unhandled request: "
+                  ^ Core_kernel.String.concat ~sep:"\n" (Run_state.stack s) )
           in
           Run_state.set_as_prover s old ;
           let var =

src/base/constraint.ml

@@ -33,7 +33,7 @@ module Basic = struct
 
     val to_basic : ('v, 'f) t -> ('v, 'f) basic
 
-    val of_basic : ('v, 'f) basic -> ('v, 'f) t
+    val of_basic : ('v, 'f) basic -> ('v, 'f) t option
   end
 
   module Entry = struct
@@ -44,20 +44,21 @@ module Basic = struct
 
   let add_case m = cases := m :: !cases
 
-  let case f =
-    List.find_map_exn !cases ~f:(fun m -> Option.try_with (fun () -> f m))
+  let case f = List.find_map_exn !cases ~f:(fun m -> try f m with _ -> None)
 
   let sexp_of_t f1 f2 t =
-    case (fun (module M) -> M.sexp_of_t f1 f2 (M.of_basic t))
+    case (fun (module M) -> M.of_basic t |> Option.map ~f:(M.sexp_of_t f1 f2))
 
   let t_of_sexp f1 f2 s =
-    case (fun (module M) -> M.to_basic (M.t_of_sexp f1 f2 s))
+    case (fun (module M) -> Some (M.to_basic (M.t_of_sexp f1 f2 s)))
 
   let eval (type f) (fm : (module Snarky_intf.Field.S with type t = f))
       (f : 'v -> f) (t : ('v, f) basic) : bool =
-    case (fun (module M) -> M.eval fm f (M.of_basic t))
+    case (fun (module M) -> M.of_basic t |> Option.map ~f:(M.eval fm f))
 
-  let map t ~f = case (fun (module M) -> M.to_basic (M.map (M.of_basic t) ~f))
+  let map t ~f =
+    case (fun (module M) ->
+        M.of_basic t |> Option.map ~f:(fun t -> M.to_basic (M.map t ~f)) )
 end
 
 module Add_kind (C : S) : sig
@@ -70,7 +71,7 @@ end = struct
 
     let to_basic x = T x
 
-    let of_basic = function T x -> x | _ -> failwith "different constructor"
+    let of_basic = function T x -> Some x | _ -> None
   end
 
   let () = Basic.add_case (module M)
@@ -126,7 +127,7 @@ let () =
 
     let t_of_sexp f _ s = Essential.(to_basic (t_of_sexp f s))
 
-    let of_basic = Fn.id
+    let of_basic t = Some t
 
     let to_basic = Fn.id
 

src/base/request.ml

@@ -24,17 +24,15 @@ module Handler = struct
 
   let fail = []
 
-  let run : t -> string list -> 'a req -> 'a =
-   fun stack0 label_stack req0 ->
+  let run : t -> 'a req -> 'a option =
+   fun stack0 req0 ->
     let rec go req = function
       | [] ->
-          failwith
-            ( "Unhandled request: "
-            ^ Core_kernel.String.concat ~sep:"\n" label_stack )
+          None
       | { handle } :: hs -> (
           match handle req with
           | Provide x ->
-              x
+              Some x
           | Delegate req' ->
               go req' hs
           | Unhandled ->

src/base/request.mli

@@ -64,5 +64,5 @@ module Handler : sig
   val push : t -> single -> t
 
   (** Run the handler on a request. Throws an error on failure. *)
-  val run : t -> string list -> 'a req -> 'a
+  val run : t -> 'a req -> 'a option
 end