diff --git a/src/base/as_prover0.ml b/src/base/as_prover0.ml index 4c1c93d8e..2c22b8334 100644 --- a/src/base/as_prover0.ml +++ b/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 diff --git a/src/base/as_prover_intf.ml b/src/base/as_prover_intf.ml index d9e70530d..2d56f7bae 100644 --- a/src/base/as_prover_intf.ml +++ b/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 diff --git a/src/base/checked_runner.ml b/src/base/checked_runner.ml index 559a51d0f..5906303ab 100644 --- a/src/base/checked_runner.ml +++ b/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 = diff --git a/src/base/constraint.ml b/src/base/constraint.ml index cdda2bb4d..29524620e 100644 --- a/src/base/constraint.ml +++ b/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 diff --git a/src/base/request.ml b/src/base/request.ml index 84bb63686..2b1cdbf10 100644 --- a/src/base/request.ml +++ b/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 -> diff --git a/src/base/request.mli b/src/base/request.mli index b8f8682cf..19780324f 100644 --- a/src/base/request.mli +++ b/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