Skip to content
Snippets Groups Projects
verification.ml 3.36 KiB
Newer Older
(**************************************************************************)
(*                                                                        *)
Michele Alberti's avatar
Michele Alberti committed
(*  This file is part of CAISAR.                                          *)
(*                                                                        *)
(**************************************************************************)

open Base
Michele Alberti's avatar
Michele Alberti committed
module Filename = Caml.Filename
Michele Alberti's avatar
Michele Alberti committed
let () = Language.register_nnet_support ()

let create_env loadpath =
  let config = Autodetection.autodetect ~debug:true () in
  let open Why3 in
  let config =
    let main = Whyconf.get_main config in
    let dft_memlimit = 4000 (* 4 GB *) in
    let main =
      Whyconf.(
        set_limits main (timelimit main) dft_memlimit (running_provers_max main))
    in
    Whyconf.set_main config main
  in
  let stdlib = Dirs.Sites.stdlib in
  ( Env.create_env
      (loadpath @ stdlib @ Whyconf.loadpath (Whyconf.get_main config)),
    config )

François Bobot's avatar
François Bobot committed
let nnet_or_onnx = Re.compile (Re.str "%{nnet-onnx}")

let call_prover ~limit prover driver task =
  let open Why3 in
  let task_prepared = Driver.prepare_task driver task in
  let command = Whyconf.get_complete_command ~with_steps:false prover in
  let nn_file =
    match Task.on_meta_excl Native_nn_prover.meta_nn_filename task_prepared with
François Bobot's avatar
François Bobot committed
    | Some [ MAstr nn_file ] -> nn_file
Michele Alberti's avatar
Michele Alberti committed
    | Some _ -> assert false (* By construction of the meta. *)
    | None -> invalid_arg (Fmt.str "No neural network model found in task")
François Bobot's avatar
François Bobot committed
  in
  let command = Re.replace_string nnet_or_onnx ~by:nn_file command in
  let prover_call =
    Driver.prove_task_prepared ~command ~limit driver task_prepared
  in
  let prover_result = Call_provers.wait_on_call prover_call in
  Fmt.pr "Goal %a: %a@." Pretty.print_pr (Task.task_goal task)
    Call_provers.print_prover_answer prover_result.pr_answer
let verify format loadpath ?memlimit ~prover file =
  let open Why3 in
  (* Debug.(set_flag (lookup_flag "call_prover")); *)
  let env, config = create_env loadpath in
François Bobot's avatar
François Bobot committed
  let steplimit = None in
  let timeout = None in
  let steps = match steplimit with Some 0 -> None | _ -> steplimit in
  let limit =
    let memlimit =
      Option.value memlimit ~default:Whyconf.(memlimit (get_main config))
    in
Michele Alberti's avatar
Michele Alberti committed
    let def = Call_provers.empty_limit in
François Bobot's avatar
François Bobot committed
    {
Michele Alberti's avatar
Michele Alberti committed
      Call_provers.limit_time = Opt.get_def def.limit_time timeout;
      Call_provers.limit_steps = Opt.get_def def.limit_time steps;
      Call_provers.limit_mem = memlimit;
  let _, mstr_theory =
    match file with
    | "-" ->
      ("stdin", Env.(read_channel ?format base_language env "stdin" Caml.stdin))
Michele Alberti's avatar
Michele Alberti committed
    | file ->
      let mlw_files, _ = Env.(read_file ?format base_language env file) in
      (file, mlw_files)
  in
  Wstdlib.Mstr.iter
    (fun _ theory ->
      let tasks = Task.split_theory theory None None in
Michele Alberti's avatar
Michele Alberti committed
        Whyconf.(filter_one_prover config (mk_filter_prover prover))
François Bobot's avatar
François Bobot committed
      let driver =
        match String.chop_prefix ~prefix:"caisar_drivers/" prover.driver with
        | None -> Whyconf.(load_driver (get_main config) env prover)
        | Some file ->
          let file =
Michele Alberti's avatar
Michele Alberti committed
            Filename.concat
              (Filename.concat (List.hd_exn Dirs.Sites.config) "drivers")
François Bobot's avatar
François Bobot committed
              file
          in
          Driver.load_driver_absolute env file prover.extra_drivers
      in
François Bobot's avatar
François Bobot committed
      List.iter ~f:(call_prover ~limit prover driver) tasks)
    mstr_theory