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,11 @@ 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)
+ As_prover.Provider.run p (get_value s) (Run_state.handler s)
+ |> Option.value_exn
+ ~message:
+ ( "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