coq-plugin: requires camlp5 (detected at configuration time

parent e0095c54
...@@ -343,13 +343,13 @@ byte: src/coq-plugin/whytac.cma ...@@ -343,13 +343,13 @@ byte: src/coq-plugin/whytac.cma
opt: src/coq-plugin/whytac.cmxs opt: src/coq-plugin/whytac.cmxs
endif endif
COQTREES = kernel lib interp parsing proofs pretyping tactics library COQTREES = kernel lib interp parsing proofs pretyping tactics library toplevel
src/coq-plugin/whytac.cma: INCLUDES = $(addprefix -I @COQLIB@/, $(COQTREES)) src/coq-plugin/whytac.cma: INCLUDES = $(addprefix -I @COQLIB@/, $(COQTREES))
src/coq-plugin/whytac.cmxs: INCLUDES = $(addprefix -I @COQLIB@/, $(COQTREES)) src/coq-plugin/whytac.cmxs: INCLUDES = $(addprefix -I @COQLIB@/, $(COQTREES))
src/coq-plugin/whytac.cma: BFLAGS+=-rectypes src/coq-plugin/whytac.cma: BFLAGS+=-rectypes -I +camlp5
src/coq-plugin/whytac.cmxs: OFLAGS+=-rectypes src/coq-plugin/whytac.cmxs: OFLAGS+=-rectypes -I +camlp5
src/coq-plugin/whytac.cmxs: src/why.cmxa src/coq-plugin/whytac.ml src/coq-plugin/whytac.cmxs: src/why.cmxa src/coq-plugin/whytac.ml
$(OCAMLOPT) $(OFLAGS) -o $@ -shared $^ $(OCAMLOPT) $(OFLAGS) -o $@ -shared $^
......
...@@ -253,6 +253,9 @@ fi ...@@ -253,6 +253,9 @@ fi
if test "$enable_coq_support" = yes; then if test "$enable_coq_support" = yes; then
AC_CHECK_FILE($COQLIB/kernel/term.cmi,,enable_coq_support=no) AC_CHECK_FILE($COQLIB/kernel/term.cmi,,enable_coq_support=no)
fi fi
if test "$enable_coq_support" = yes; then
AC_CHECK_FILE($OCAMLLIB/camlp5/gramext.cmi,,enable_coq_support=no)
fi
#Viewer for ps and pdf #Viewer for ps and pdf
dnl AC_CHECK_PROGS(PSVIEWER,gv evince) dnl AC_CHECK_PROGS(PSVIEWER,gv evince)
......
...@@ -3,6 +3,8 @@ Require Export ZArith. ...@@ -3,6 +3,8 @@ Require Export ZArith.
Open Scope Z_scope. Open Scope Z_scope.
Require Export List. Require Export List.
Ltac ae := why "alt-ergo".
(* type definitions *) (* type definitions *)
Definition t := list. Definition t := list.
...@@ -10,28 +12,27 @@ Definition t := list. ...@@ -10,28 +12,27 @@ Definition t := list.
Inductive foo : Set := Inductive foo : Set :=
C : t nat -> foo. C : t nat -> foo.
(*
Goal forall x:foo, x=x. Goal forall x:foo, x=x.
intros. intros.
why. ae.
Qed. Qed.
*)
(* predicate definition *) (* predicate definition *)
Definition p (x:nat) := x=O. Definition p (x:nat) := x=O.
(*
Goal p O. Goal p O.
why. ae.
Qed. Qed.
*)
Definition eq (A:Set) (x y : A) := x=y. Definition eq (A:Set) (x y : A) := x=y.
Goal eq nat O O. Goal eq nat O O.
why. (* BUG transformations ? *) (*
why "z3". (* BUG transformation ici ? *)
Qed. Qed.
*)
Admitted.
Parameter mem : forall (A:Set), A -> list A -> Prop. Parameter mem : forall (A:Set), A -> list A -> Prop.
...@@ -46,13 +47,13 @@ Admitted. ...@@ -46,13 +47,13 @@ Admitted.
Definition f (x:Z) (y:Z) := x+y. Definition f (x:Z) (y:Z) := x+y.
Goal f 1 2 = 3. Goal f 1 2 = 3.
why. ae.
Qed. Qed.
Definition id A (x:A) := x. Definition id A (x:A) := x.
Goal id nat O = O. Goal id nat O = O.
why. ae.
Qed. Qed.
(* inductive types *) (* inductive types *)
...@@ -62,17 +63,17 @@ Parameter P : (nat -> nat) -> Prop. ...@@ -62,17 +63,17 @@ Parameter P : (nat -> nat) -> Prop.
Goal forall (a:Set), forall x:nat, x=S O -> P S -> Goal forall (a:Set), forall x:nat, x=S O -> P S ->
let y := (S (S O)) in S x=y. let y := (S (S O)) in S x=y.
intros. intros.
why. ae.
Qed. Qed.
Goal forall (a:Set), forall x:Z, x=1 -> P S -> let y := 2 in x+1=y. Goal forall (a:Set), forall x:Z, x=1 -> P S -> let y := 2 in x+1=y.
intros. intros.
why. ae.
Qed. Qed.
Goal forall x: list nat, x=x. Goal forall x: list nat, x=x.
intros. intros.
why. ae.
Qed. Qed.
(* Mutually inductive types *) (* Mutually inductive types *)
...@@ -86,7 +87,7 @@ with forest : Set := ...@@ -86,7 +87,7 @@ with forest : Set :=
| Cons : tree -> forest -> forest. | Cons : tree -> forest -> forest.
Goal forall x : tree, x=x. Goal forall x : tree, x=x.
why. ae.
Qed. Qed.
(* Polymorphic, Mutually inductive types *) (* Polymorphic, Mutually inductive types *)
...@@ -100,7 +101,7 @@ with pforest (a:Set) : Set := ...@@ -100,7 +101,7 @@ with pforest (a:Set) : Set :=
| PCons : ptree a -> pforest a -> pforest a. | PCons : ptree a -> pforest a -> pforest a.
Goal forall x : ptree Z, x=x. Goal forall x : ptree Z, x=x.
why. ae.
Qed. Qed.
(* the same, without parameters *) (* the same, without parameters *)
...@@ -114,6 +115,6 @@ with pforest' : Type -> Type := ...@@ -114,6 +115,6 @@ with pforest' : Type -> Type :=
| PCons' : forall (a:Type), ptree' a -> pforest' a -> pforest' a. | PCons' : forall (a:Type), ptree' a -> pforest' a -> pforest' a.
Goal forall x : ptree' Z, x=x. Goal forall x : ptree' Z, x=x.
why. ae.
Qed. Qed.
...@@ -24,18 +24,23 @@ let debug = ...@@ -24,18 +24,23 @@ let debug =
let config = Whyconf.read_config None let config = Whyconf.read_config None
let env = Env.create_env (Typing.retrieve config.loadpath)
let config_prover =
try Util.Mstr.find "alt-ergo" config.provers
with Not_found -> assert false
let drv = Driver.load_driver env config_prover.driver
let command = config_prover.command
let timelimit = match config.timelimit with let timelimit = match config.timelimit with
| None -> 3 | None -> 3
| Some t -> t | Some t -> t
let env = Env.create_env (Typing.retrieve config.loadpath)
let provers = Hashtbl.create 17
let get_prover s =
try
Hashtbl.find provers s
with Not_found ->
let cp = Util.Mstr.find s config.provers in
let drv = Driver.load_driver env cp.driver in
Hashtbl.add provers s (cp, drv);
cp, drv
(* Coq constants *) (* Coq constants *)
let logic_dir = ["Coq";"Logic";"Decidable"] let logic_dir = ["Coq";"Logic";"Decidable"]
...@@ -705,12 +710,14 @@ let tr_goal gl = ...@@ -705,12 +710,14 @@ let tr_goal gl =
task := Task.add_prop_decl !task Decl.Pgoal pr f task := Task.add_prop_decl !task Decl.Pgoal pr f
let whytac gl = let whytac s gl =
let concl_type = pf_type_of gl (pf_concl gl) in let concl_type = pf_type_of gl (pf_concl gl) in
if not (is_Prop concl_type) then error "Conclusion is not a Prop"; if not (is_Prop concl_type) then error "Conclusion is not a Prop";
task := Task.use_export None Theory.builtin_theory; task := Task.use_export None Theory.builtin_theory;
try try
tr_goal gl; tr_goal gl;
let cp, drv = get_prover s in
let command = cp.command in
if debug then Format.printf "@[%a@]@\n---@." Pretty.print_task !task; if debug then Format.printf "@[%a@]@\n---@." Pretty.print_task !task;
if debug then Format.printf "@[%a@]@\n---@." (Prover.print_task drv) !task; if debug then Format.printf "@[%a@]@\n---@." (Prover.print_task drv) !task;
let res = Prover.prove_task ~debug ~command ~timelimit drv !task () in let res = Prover.prove_task ~debug ~command ~timelimit drv !task () in
...@@ -725,11 +732,43 @@ let whytac gl = ...@@ -725,11 +732,43 @@ let whytac gl =
with NotFO -> with NotFO ->
error "Not a first order goal" error "Not a first order goal"
(***
let _ = let _ =
Tacinterp.overwriting_add_tactic "Why" (fun _ -> whytac); Tacinterp.overwriting_add_tactic "Why" (fun s -> whytac s);
Egrammar.extend_tactic_grammar "Why" [[Egrammar.TacTerm "why"]] Egrammar.extend_tactic_grammar "Why" [[Egrammar.TacTerm "why"]]
***)
open Pcoq
let h_Why s =
Refiner.abstract_extended_tactic "Why"
[Genarg.in_gen Genarg.wit_string s] (whytac s)
let _ =
try
let _ =
Tacinterp.add_tactic "Why"
(function
[s] when Genarg.genarg_tag s = Genarg.StringArgType && true ->
let s = Genarg.out_gen Genarg.wit_string s in whytac s
| _ -> failwith "Tactic extension: cannot occur")
in
List.iter
(fun s ->
Tacinterp.add_primitive_tactic s
(Tacexpr.TacAtom
(dummy_loc, Tacexpr.TacExtend (dummy_loc, s, []))))
[]
with e -> pp (Cerrors.explain_exn e)
let _ =
Egrammar.extend_tactic_grammar "Why"
[[Egrammar.TacTerm "why";
Egrammar.TacNonTerm
(dummy_loc,
(Gramext.Snterm (Pcoq.Gram.Entry.obj Prim.string),
Genarg.StringArgType),
Some "s")]]
let _ =
List.iter Pptactic.declare_extra_tactic_pprule
["Why", [Genarg.StringArgType], (0, [Some "why"; None])]
(* (*
Local Variables: Local Variables:
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment