Cubicle BRAB in Why3 index
module Cubicle_BRAB use import ref.Ref use import option.Option use import fol.FOL use import abstract_queue.AbstractQueue as Q use import reachability.Reachability use import map.Map (* remove unecessary axioms for solvers *) meta remove_prop prop extensionality meta remove_prop prop structure_exists meta remove_prop prop model_true meta remove_prop prop model_false meta remove_prop prop model_and meta remove_prop prop model_or meta remove_prop prop model_neg meta remove_prop prop valid_def (* meta remove_prop prop and_a *) (* meta remove_prop prop and_c *) (* meta remove_prop prop or_a *) (* meta remove_prop prop or_c *) meta remove_prop prop sat_def (* meta remove_prop prop sat_or *) meta remove_prop prop sat_neg meta remove_prop prop sat_and meta remove_prop prop valid_or meta remove_prop prop valid_neg meta remove_prop prop valid_and meta remove_prop prop valid_sat meta remove_prop prop pre_star_def2 meta remove_prop prop pre_star_def3 meta remove_prop prop reachable_imply meta remove_prop prop reachable_and meta remove_prop prop pre_and meta remove_prop prop pre_or meta remove_prop prop unsat_invalid meta remove_prop prop model_extensionality meta remove_prop prop forget_subsumed_or type result = Safe | Unsafe exception Unsafe_trace type kind = Undef | Appr | Orig val visited : ref f val bad : ref f val faulty : ref f val q : Q.t constant finite_model : f val kind : ref (map f kind) val from : ref (map f f) val approx (phi : f) : option f reads { bad } ensures { match result with | Some psi -> not (!bad |== psi) /\ not (finite_model |== psi) /\ phi |== psi | None -> true end } let pre_or_approx (tau: trans_rel) (phi : f) (ghost theta :f) (ghost init :f) = writes { kind, from } reads { bad } requires { (forall phi:f. !kind[phi] = Orig -> !from[phi] = theta) /\ (forall phi:f. !kind[phi] = Orig -> reachable tau init phi -> reachable tau init !from[phi])} ensures { ( (result = pre tau phi /\ !kind[result] = !kind[phi] /\ !from[result] = !from[phi]) \/ (phi |== result /\ !kind[result] = Appr /\ (!kind[phi] = Orig -> !from[result] = result) /\ (!kind[phi] = Appr -> !from[result] = !from[phi])) (* /\ *) (* (!kind[result] = Orig -> *) (* (!from[result] = !from[phi] /\ !kind[phi] = Orig )) /\ *) (* (!kind[result] = Orig -> !from[result] = theta ) /\ *) (* (forall init:f. reachable init phi -> reachable init result) *) ) && (forall phi:f. !kind[phi] = Orig -> !from[phi] = theta) && (forall phi:f. !kind[phi] = Orig -> reachable tau init phi -> reachable tau init !from[phi]) } match approx phi with | Some psi -> kind := !kind[psi <- Appr]; if !kind[phi] = Orig then from := !from[psi <- psi] else from := !from[psi <- !from[phi]]; psi | None -> let psi = pre tau phi in assert { reachable tau init psi -> reachable tau init phi }; kind := !kind[psi <- !kind[phi]]; from := !from[psi <- !from[phi]]; psi end let bwd (tau: trans_rel) (init : f) (theta : f) = writes { kind, from, visited, faulty, q } reads { bad } requires { forall psi:f. !kind[psi] = Undef /\ !from[psi] = psi } (* Soundness *) ensures { result = Safe -> not (reachable tau init theta) } ensures { result = Unsafe -> !kind[ !faulty ] = Orig -> reachable tau init theta } visited := ffalse; Q.clear q; try faulty := theta; (* just for init *) from := !from[ theta <- theta ]; kind := !kind[ theta <- Orig ]; if sat (init & theta) then raise Unsafe_trace; visited := theta ++ !visited; let pre_theta = pre tau theta in from := !from[ pre_theta <- theta ]; kind := !kind[ pre_theta <- Orig ]; Q.push (pre_theta) q; while not (Q.is_empty q) do invariant { not (sat (!visited & init)) && (* pre_star !visited |== !visited ++ (pre_star q.formula) && *) pre_star tau theta |== !visited ++ (pre_star tau q.formula) && (forall phi:f. !kind[phi] = Orig -> !from[phi] = theta) && (forall phi:f. !kind[phi] = Orig -> reachable tau init phi -> reachable tau init (!from[phi]) ) (* (!kind[ !faulty ] = Orig -> !from[ !faulty ] = theta) && *) (* (!kind[ !faulty ] = Orig -> reachable init !faulty -> reachable init (!from[ !faulty ])) *) } let ghost old_q = Q.copy q in let phi = Q.pop q in if sat (init & phi) then (faulty := phi; raise Unsafe_trace); if not (phi |== !visited) then ( let ghost old_v = !visited in let ghost old_kind = !kind in let ghost old_from = !from in visited := phi ++ !visited; let poa = pre_or_approx tau phi theta init in (* assert { (\* !kind[ phi ] = Orig -> !from[phi] = theta && *\) *) (* (\* (!kind[phi] = Orig -> phi <> theta -> *\) *) (* (\* reachable init phi -> reachable init (!from[phi])) *\) *) (* }; *) Q.push poa q; assert { old_v ++ pre_star tau q.formula |== old_v ++ (pre_star tau phi ++ pre_star tau q.formula) && (phi ++ old_v) ++ pre_star tau (pre tau phi ++ ((~ phi) & old_q.formula)) = old_v ++ (pre_star tau phi ++ pre_star tau (~ phi & old_q.formula)) && (phi ++ old_v) ++ pre_star tau (pre tau phi ++ ((~ phi) & old_q.formula)) = old_v ++ pre_star tau (ttrue & (phi ++ old_q.formula)) && (phi |== poa -> ((phi ++ old_v) ++ (pre_star tau phi ++ pre_star tau (~ phi & old_q.formula))) |== ((phi ++ old_v) ++ (pre_star tau poa ++ pre_star tau (~ phi & old_q.formula)))) } ) else assert { valid ((~ phi) => pre_star tau (~ phi)) && !visited ++ ((~ phi) ++ (pre_star tau (~ phi))) = (phi ++ !visited) ++ ((~ phi) ++ (pre_star tau (~ phi))) && ((!visited ++ (~ phi ++ pre_star tau (~ phi))) & (!visited ++ pre_star tau old_q.formula)) = ((!visited ++ ((phi ++ ~ phi) ++ pre_star tau (~ phi))) & (!visited ++ pre_star tau old_q.formula)) && ((!visited ++ (~ phi ++ pre_star tau (~ phi))) & (!visited ++ pre_star tau old_q.formula)) = ((!visited ++ (ttrue ++ pre_star tau (~ phi))) & (!visited ++ pre_star tau old_q.formula)) && ((!visited ++ (~ phi ++ pre_star tau (~ phi))) & (!visited ++ pre_star tau old_q.formula)) = (!visited ++ ttrue) & (!visited ++ pre_star tau old_q.formula) } done; Safe with | Unsafe_trace -> Unsafe | Q.Empty -> absurd end val reset_maps (theta : f) : unit writes { kind, from } ensures { forall psi:f. !kind[psi] = Undef /\ !from[psi] = psi } val bwd_res : ref result let brab (tau: trans_rel) (init : f) (theta : f) = requires { forall psi:f. !kind[psi] = Undef /\ !from[psi] = psi } ensures { result = Safe -> not (reachable tau init theta) } ensures { result = Unsafe -> reachable tau init theta } bad := ffalse; try bwd_res := bwd tau init theta; while !bwd_res = Unsafe do invariant { !bwd_res = Safe -> not (reachable tau init theta) } invariant { !bwd_res = Unsafe -> !kind[ !faulty ] = Orig -> reachable tau init theta } if !kind[ !faulty ] = Orig then raise Unsafe_trace; bad := !from[ !faulty ] ++ !bad; reset_maps theta; bwd_res := bwd tau init theta done; Safe with Unsafe_trace -> Unsafe end end
Generated by why3doc 0.82+git