aboutsummaryrefslogtreecommitdiffstats
path: root/src/zchaff
diff options
context:
space:
mode:
Diffstat (limited to 'src/zchaff')
-rw-r--r--src/zchaff/cnfParser.ml8
-rw-r--r--src/zchaff/cnfParser.mli12
-rw-r--r--src/zchaff/satParser.ml8
-rw-r--r--src/zchaff/satParser.mli12
-rw-r--r--src/zchaff/zchaff.ml69
-rw-r--r--src/zchaff/zchaff.mli102
-rw-r--r--src/zchaff/zchaffParser.ml8
-rw-r--r--src/zchaff/zchaffParser.mli12
8 files changed, 94 insertions, 137 deletions
diff --git a/src/zchaff/cnfParser.ml b/src/zchaff/cnfParser.ml
index c02211f..cf22136 100644
--- a/src/zchaff/cnfParser.ml
+++ b/src/zchaff/cnfParser.ml
@@ -1,13 +1,9 @@
(**************************************************************************)
(* *)
(* SMTCoq *)
-(* Copyright (C) 2011 - 2016 *)
+(* Copyright (C) 2011 - 2019 *)
(* *)
-(* Michaël Armand *)
-(* Benjamin Grégoire *)
-(* Chantal Keller *)
-(* *)
-(* Inria - École Polytechnique - Université Paris-Sud *)
+(* See file "AUTHORS" for the list of authors *)
(* *)
(* This file is distributed under the terms of the CeCILL-C licence *)
(* *)
diff --git a/src/zchaff/cnfParser.mli b/src/zchaff/cnfParser.mli
index 4e2e079..586942e 100644
--- a/src/zchaff/cnfParser.mli
+++ b/src/zchaff/cnfParser.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(* *)
+(* SMTCoq *)
+(* Copyright (C) 2011 - 2019 *)
+(* *)
+(* See file "AUTHORS" for the list of authors *)
+(* *)
+(* This file is distributed under the terms of the CeCILL-C licence *)
+(* *)
+(**************************************************************************)
+
+
val skip_comment : SatParser.lex_buff -> unit
val parse_p_cnf : SatParser.lex_buff -> int
val mklit : int -> SatAtom.Form.reify -> int -> SatAtom.Form.t
diff --git a/src/zchaff/satParser.ml b/src/zchaff/satParser.ml
index 7928c61..8704c7c 100644
--- a/src/zchaff/satParser.ml
+++ b/src/zchaff/satParser.ml
@@ -1,13 +1,9 @@
(**************************************************************************)
(* *)
(* SMTCoq *)
-(* Copyright (C) 2011 - 2016 *)
+(* Copyright (C) 2011 - 2019 *)
(* *)
-(* Michaël Armand *)
-(* Benjamin Grégoire *)
-(* Chantal Keller *)
-(* *)
-(* Inria - École Polytechnique - Université Paris-Sud *)
+(* See file "AUTHORS" for the list of authors *)
(* *)
(* This file is distributed under the terms of the CeCILL-C licence *)
(* *)
diff --git a/src/zchaff/satParser.mli b/src/zchaff/satParser.mli
index c2fa020..871ab66 100644
--- a/src/zchaff/satParser.mli
+++ b/src/zchaff/satParser.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(* *)
+(* SMTCoq *)
+(* Copyright (C) 2011 - 2019 *)
+(* *)
+(* See file "AUTHORS" for the list of authors *)
+(* *)
+(* This file is distributed under the terms of the CeCILL-C licence *)
+(* *)
+(**************************************************************************)
+
+
type lex_buff = {
buff : bytes;
mutable curr_char : int;
diff --git a/src/zchaff/zchaff.ml b/src/zchaff/zchaff.ml
index 928dd8d..2bbb23d 100644
--- a/src/zchaff/zchaff.ml
+++ b/src/zchaff/zchaff.ml
@@ -1,13 +1,9 @@
(**************************************************************************)
(* *)
(* SMTCoq *)
-(* Copyright (C) 2011 - 2016 *)
+(* Copyright (C) 2011 - 2019 *)
(* *)
-(* Michaël Armand *)
-(* Benjamin Grégoire *)
-(* Chantal Keller *)
-(* *)
-(* Inria - École Polytechnique - Université Paris-Sud *)
+(* See file "AUTHORS" for the list of authors *)
(* *)
(* This file is distributed under the terms of the CeCILL-C licence *)
(* *)
@@ -62,6 +58,8 @@ and pp_pform fmt p =
| Fapp(op,args) ->
Format.fprintf fmt "%s" (string_of_op op);
Array.iter (fun a -> Format.fprintf fmt "%a " pp_form a) args
+ (* Nothing to do with ZChaff *)
+ | FbbT _ -> assert false
let pp_value fmt c =
match c.value with
@@ -228,7 +226,7 @@ let theorems interp name fdimacs ftrace =
let certif =
mklApp cCertif [|mkInt (max_id + 1);tres;mkInt (get_pos confl)|] in
- let theorem_concl = mklApp cis_true [|mklApp cnegb [|interp d first last|] |] in
+ let theorem_concl = mklApp cnot [|mklApp cis_true [|interp d first last|] |] in
let vtype = Term.mkProd(Names.Anonymous, Lazy.force cint, Lazy.force cbool) in
let theorem_type =
Term.mkProd (mkName "v", vtype, theorem_concl) in
@@ -239,7 +237,7 @@ let theorems interp name fdimacs ftrace =
Term.mkLambda (mkName "v", vtype,
mklApp ctheorem_checker
[| Term.mkRel 3(*d*); Term.mkRel 2(*c*);
- vm_cast_true
+ vm_cast_true_no_check
(mklApp cchecker [|Term.mkRel 3(*d*); Term.mkRel 2(*c*)|]);
Term.mkRel 1(*v*)|]))),
Term.VMcast,
@@ -361,7 +359,7 @@ let cchecker_eq_correct =
gen_constant cnf_checker_modules "checker_eq_correct"
let cchecker_eq = gen_constant cnf_checker_modules "checker_eq"
-let build_body reify_atom reify_form l b (max_id, confl) =
+let build_body reify_atom reify_form l b (max_id, confl) vm_cast =
let ntvar = mkName "t_var" in
let ntform = mkName "t_form" in
let nc = mkName "c" in
@@ -374,25 +372,27 @@ let build_body reify_atom reify_form l b (max_id, confl) =
let vtvar = Term.mkRel 3 in
let vtform = Term.mkRel 2 in
let vc = Term.mkRel 1 in
- let proof_cast =
+ let add_lets t =
Term.mkLetIn (ntvar, tvar, mklApp carray [|Lazy.force cbool|],
Term.mkLetIn (ntform, tform, mklApp carray [|Lazy.force cform|],
Term.mkLetIn (nc, certif, Lazy.force ccertif,
- mklApp cchecker_b_correct
- [|vtvar; vtform; l; b; vc;
- vm_cast_true (mklApp cchecker_b [|vtform;l;b;vc|])|])))
+ t)))
+ in
+ let cbc =
+ add_lets
+ (mklApp cchecker_b [|vtform;l;b;vc|]) |> vm_cast in
+ let proof_cast =
+ add_lets
+ (mklApp cchecker_b_correct [|vtvar; vtform; l; b; vc; cbc|])
in
let proof_nocast =
- Term.mkLetIn (ntvar, tvar, mklApp carray [|Lazy.force cbool|],
- Term.mkLetIn (ntform, tform, mklApp carray [|Lazy.force cform|],
- Term.mkLetIn (nc, certif, Lazy.force ccertif,
- mklApp cchecker_b_correct
- [|vtvar; vtform; l; b; vc|])))
+ add_lets
+ (mklApp cchecker_b_correct [|vtvar; vtform; l; b; vc|])
in
(proof_cast, proof_nocast)
-let build_body_eq reify_atom reify_form l1 l2 l (max_id, confl) =
+let build_body_eq reify_atom reify_form l1 l2 l (max_id, confl) vm_cast =
let ntvar = mkName "t_var" in
let ntform = mkName "t_form" in
let nc = mkName "c" in
@@ -405,20 +405,20 @@ let build_body_eq reify_atom reify_form l1 l2 l (max_id, confl) =
let vtvar = Term.mkRel 3 in
let vtform = Term.mkRel 2 in
let vc = Term.mkRel 1 in
- let proof_cast =
+ let add_lets t =
Term.mkLetIn (ntvar, tvar, mklApp carray [|Lazy.force cbool|],
Term.mkLetIn (ntform, tform, mklApp carray [|Lazy.force cform|],
Term.mkLetIn (nc, certif, Lazy.force ccertif,
- mklApp cchecker_eq_correct
- [|vtvar; vtform; l1; l2; l; vc;
- vm_cast_true (mklApp cchecker_eq [|vtform;l1;l2;l;vc|])|])))
+ t)))
+ in
+ let ceqc = add_lets (mklApp cchecker_eq [|vtform;l1;l2;l;vc|])
+ |> vm_cast in
+ let proof_cast =
+ add_lets
+ (mklApp cchecker_eq_correct [|vtvar; vtform; l1; l2; l; vc; ceqc|])
in
let proof_nocast =
- Term.mkLetIn (ntvar, tvar, mklApp carray [|Lazy.force cbool|],
- Term.mkLetIn (ntform, tform, mklApp carray [|Lazy.force cform|],
- Term.mkLetIn (nc, certif, Lazy.force ccertif,
- mklApp cchecker_eq_correct
- [|vtvar; vtform; l1; l2; l; vc|])))
+ add_lets (mklApp cchecker_eq_correct [|vtvar; vtform; l1; l2; l; vc|])
in
(proof_cast, proof_nocast)
@@ -512,6 +512,8 @@ let make_proof pform_tbl atom_tbl env reify_form l =
let value = if ispos then " = true" else " = false" in
acc^" "^(Pp.string_of_ppcmds (Structures.pr_constr_env env t))^value
| Fapp _ -> acc
+ (* Nothing to do with ZChaff *)
+ | FbbT _ -> assert false
) with | Invalid_argument _ -> acc (* Because cnf computation does not put the new formulas in the table... Perhaps it should? *)
) "zchaff found a counterexample:\n" model)
);
@@ -520,10 +522,10 @@ let make_proof pform_tbl atom_tbl env reify_form l =
(* The whole tactic *)
-let core_tactic env sigma t =
+let core_tactic vm_cast env sigma concl =
SmtTrace.clear ();
- let (forall_let, concl) = Term.decompose_prod_assum t in
+ let (forall_let, concl) = Term.decompose_prod_assum concl in
let a, b = get_arguments concl in
let reify_atom = Atom.create () in
let reify_form = Form.create () in
@@ -534,7 +536,7 @@ let core_tactic env sigma t =
let atom_tbl = Atom.atom_tbl reify_atom in
let pform_tbl = Form.pform_tbl reify_form in
let max_id_confl = make_proof pform_tbl atom_tbl (Environ.push_rel_context forall_let env) reify_form l' in
- build_body reify_atom reify_form (Form.to_coq l) b max_id_confl
+ build_body reify_atom reify_form (Form.to_coq l) b max_id_confl (vm_cast env)
else
let l1 = Form.of_coq (Atom.get reify_atom) reify_form a in
let l2 = Form.of_coq (Atom.get reify_atom) reify_form b in
@@ -543,7 +545,7 @@ let core_tactic env sigma t =
let pform_tbl = Form.pform_tbl reify_form in
let max_id_confl = make_proof pform_tbl atom_tbl (Environ.push_rel_context forall_let env) reify_form l in
build_body_eq reify_atom reify_form
- (Form.to_coq l1) (Form.to_coq l2) (Form.to_coq l) max_id_confl
+ (Form.to_coq l1) (Form.to_coq l2) (Form.to_coq l) max_id_confl (vm_cast env)
in
let compose_lam_assum forall_let body =
@@ -556,4 +558,5 @@ let core_tactic env sigma t =
(Structures.vm_cast_no_check res_cast))
-let tactic () = Structures.tclTHEN Tactics.intros (Structures.mk_tactic core_tactic)
+let tactic () = Structures.tclTHEN Tactics.intros (Structures.mk_tactic (core_tactic vm_cast_true))
+let tactic_no_check () = Structures.tclTHEN Tactics.intros (Structures.mk_tactic (core_tactic (fun _ -> vm_cast_true_no_check)))
diff --git a/src/zchaff/zchaff.mli b/src/zchaff/zchaff.mli
index 6a873ec..4c312fc 100644
--- a/src/zchaff/zchaff.mli
+++ b/src/zchaff/zchaff.mli
@@ -1,88 +1,18 @@
-val is_trivial : SatAtom.Form.t list -> bool
-val string_of_op : SmtForm.fop -> string
-val pp_form : Format.formatter -> SatAtom.Form.t -> unit
-val pp_sign : Format.formatter -> SatAtom.Form.t -> unit
-val pp_pform : Format.formatter -> SatAtom.Form.pform -> unit
-val pp_value : Format.formatter -> SatAtom.Form.t SmtCertif.clause -> unit
-val pp_kind : Format.formatter -> SatAtom.Form.t SmtCertif.clause -> unit
-val pp_trace : Format.formatter -> SatAtom.Form.t SmtCertif.clause -> unit
-val import_cnf :
- string ->
- int * SatAtom.Form.t SmtCertif.clause * SatAtom.Form.t SmtCertif.clause *
- (int, SatAtom.Form.t SmtCertif.clause) Hashtbl.t
-val import_cnf_trace :
- (int, 'a SmtCertif.clause) Hashtbl.t ->
- string ->
- SatAtom.Form.t SmtCertif.clause ->
- 'a SmtCertif.clause -> int * 'a SmtCertif.clause
-val make_roots :
- SatAtom.Form.t SmtCertif.clause -> 'a SmtCertif.clause -> Term.constr
-val interp_roots :
- SatAtom.Form.t SmtCertif.clause -> 'a SmtCertif.clause -> Term.constr
-val sat_checker_modules : string list list
-val parse_certif :
- Names.identifier -> Names.identifier -> string -> string -> unit
-val cdimacs : Term.constr lazy_t
-val ctheorem_checker : Term.constr lazy_t
-val cchecker : Term.constr lazy_t
-val theorems :
- (Term.constr ->
- SatAtom.Form.t SmtCertif.clause ->
- SatAtom.Form.t SmtCertif.clause -> Term.constr) ->
- Names.identifier -> string -> string -> unit
-val theorem : Names.identifier -> string -> string -> unit
-val theorem_abs : Names.identifier -> string -> string -> unit
+(**************************************************************************)
+(* *)
+(* SMTCoq *)
+(* Copyright (C) 2011 - 2019 *)
+(* *)
+(* See file "AUTHORS" for the list of authors *)
+(* *)
+(* This file is distributed under the terms of the CeCILL-C licence *)
+(* *)
+(**************************************************************************)
+
+
+val parse_certif : Structures.names_id -> Structures.names_id -> string -> string -> unit
val checker : string -> string -> unit
-val export_clause : Format.formatter -> SatAtom.Form.t list -> unit
-val export :
- out_channel ->
- int ->
- SatAtom.Form.t SmtCertif.clause ->
- (int, SatAtom.Form.t SmtCertif.clause) Hashtbl.t *
- SatAtom.Form.t SmtCertif.clause
-val call_zchaff :
- int ->
- SatAtom.Form.t SmtCertif.clause ->
- (int, SatAtom.Form.t SmtCertif.clause) Hashtbl.t * string * string *
- SatAtom.Form.t SmtCertif.clause
-val cnf_checker_modules : string list list
-val certif_ops :
- Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
- Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
- Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
- Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
- Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
- Term.constr lazy_t * Term.constr lazy_t * Term.constr lazy_t *
- Term.constr lazy_t * Term.constr lazy_t
-val ccertif : Term.constr lazy_t
-val cCertif : Term.constr lazy_t
-val cchecker_b_correct : Term.constr lazy_t
-val cchecker_b : Term.constr lazy_t
-val cchecker_eq_correct : Term.constr lazy_t
-val cchecker_eq : Term.constr lazy_t
-val build_body :
- SatAtom.Atom.reify_tbl ->
- SatAtom.Form.reify ->
- Term.constr ->
- Term.constr ->
- int * SatAtom.Form.t SmtCertif.clause -> Term.constr * Term.constr
-val build_body_eq :
- SatAtom.Atom.reify_tbl ->
- SatAtom.Form.reify ->
- Term.constr ->
- Term.constr ->
- Term.constr ->
- int * SatAtom.Form.t SmtCertif.clause -> Term.constr * Term.constr
-val get_arguments : Term.constr -> Term.constr * Term.constr
-exception Sat of int list
-exception Finished
-val input_int : in_channel -> int
-val check_unsat : string -> unit
-val make_proof :
- (int, 'a) SmtForm.gen_pform array ->
- Term.constr array ->
- Environ.env ->
- SatAtom.Form.reify ->
- SatAtom.Form.t -> int * SatAtom.Form.t SmtCertif.clause
-val core_tactic : Environ.env -> 'a -> Term.types -> Structures.tactic
+val theorem : Structures.names_id -> string -> string -> unit
+val theorem_abs : Structures.names_id -> string -> string -> unit
val tactic : unit -> Structures.tactic
+val tactic_no_check : unit -> Structures.tactic
diff --git a/src/zchaff/zchaffParser.ml b/src/zchaff/zchaffParser.ml
index fa04dc6..c4a2f62 100644
--- a/src/zchaff/zchaffParser.ml
+++ b/src/zchaff/zchaffParser.ml
@@ -1,13 +1,9 @@
(**************************************************************************)
(* *)
(* SMTCoq *)
-(* Copyright (C) 2011 - 2016 *)
+(* Copyright (C) 2011 - 2019 *)
(* *)
-(* Michaël Armand *)
-(* Benjamin Grégoire *)
-(* Chantal Keller *)
-(* *)
-(* Inria - École Polytechnique - Université Paris-Sud *)
+(* See file "AUTHORS" for the list of authors *)
(* *)
(* This file is distributed under the terms of the CeCILL-C licence *)
(* *)
diff --git a/src/zchaff/zchaffParser.mli b/src/zchaff/zchaffParser.mli
index a512f48..26065df 100644
--- a/src/zchaff/zchaffParser.mli
+++ b/src/zchaff/zchaffParser.mli
@@ -1,3 +1,15 @@
+(**************************************************************************)
+(* *)
+(* SMTCoq *)
+(* Copyright (C) 2011 - 2019 *)
+(* *)
+(* See file "AUTHORS" for the list of authors *)
+(* *)
+(* This file is distributed under the terms of the CeCILL-C licence *)
+(* *)
+(**************************************************************************)
+
+
val _CL : string
val _INF : string
val _VAR : string
generated by cgit (git 2.34.1) at 2024-07-01 07:35:02 +0000