From df2a8d8307f7594464f97bc8fda50e65eee01f8c Mon Sep 17 00:00:00 2001
From: msozeau
Date: Fri, 5 Mar 2010 01:55:45 +0000
Subject: Add a generic tactic option builder. Use it in firstorder to set the
 default solver (using "Set Firstorder Solver") and for program's obligation
 tactic. I don't understand exactly the reason of the warning when building
 states/initial.coq, anyone?

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12842 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 tactics/tactic_option.ml  | 57 +++++++++++++++++++++++++++++++++++++++++++++++
 tactics/tactic_option.mli | 18 +++++++++++++++
 tactics/tactics.mllib     |  1 +
 3 files changed, 76 insertions(+)
 create mode 100644 tactics/tactic_option.ml
 create mode 100644 tactics/tactic_option.mli

(limited to 'tactics')

diff --git a/tactics/tactic_option.ml b/tactics/tactic_option.ml
new file mode 100644
index 0000000000..8e5124c417
--- /dev/null
+++ b/tactics/tactic_option.ml
@@ -0,0 +1,57 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(* $Id: subtac.ml 12623 2010-01-04 17:50:38Z letouzey $ *)
+
+open Libobject
+open Proof_type
+open Pp
+
+let declare_tactic_option name =
+  let default_tactic : Proof_type.tactic ref = ref Refiner.tclIDTAC in
+  let default_tactic_expr : Tacexpr.glob_tactic_expr ref = ref (Tacexpr.TacId []) in
+  let locality = ref false in
+  let set_default_tactic local t = 
+    locality := local;
+    default_tactic_expr := t; default_tactic := Tacinterp.eval_tactic t 
+  in
+  let cache (_, (local, tac)) = set_default_tactic local tac in
+  let load (_, (local, tac)) =
+    if not local then set_default_tactic local tac
+  in
+  let subst (s, (local, tac)) =
+    (local, Tacinterp.subst_tactic s tac)
+  in
+  let input, _output = 
+    declare_object
+      { (default_object name) with
+	cache_function = cache;
+	load_function = (fun _ -> load);
+	open_function = (fun _ -> load);
+	classify_function = (fun (local, tac) ->
+	  if local then Dispose else Substitute (local, tac));
+	subst_function = subst}
+  in
+  let put local tac =
+    set_default_tactic local tac;
+    Lib.add_anonymous_leaf (input (local, tac))
+  in
+  let get () = !locality, !default_tactic in
+  let print () = 
+    Pptactic.pr_glob_tactic (Global.env ()) !default_tactic_expr ++
+      (if !locality then str" (locally defined)" else str" (globally defined)")
+  in
+  let freeze () = !locality, !default_tactic_expr in
+  let unfreeze (local, t) = set_default_tactic local t in
+  let init () = () in
+    Summary.declare_summary name
+      { Summary.freeze_function = freeze;
+        Summary.unfreeze_function = unfreeze;
+        Summary.init_function = init };
+    put, get, print
+      
diff --git a/tactics/tactic_option.mli b/tactics/tactic_option.mli
new file mode 100644
index 0000000000..208a76aefb
--- /dev/null
+++ b/tactics/tactic_option.mli
@@ -0,0 +1,18 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(* $Id: subtac.ml 12623 2010-01-04 17:50:38Z letouzey $ *)
+
+open Proof_type
+open Tacexpr
+open Vernacexpr
+
+val declare_tactic_option : string -> 
+  (* put *) (locality_flag -> glob_tactic_expr -> unit) *
+  (* get *) (unit -> locality_flag * tactic) *
+  (* print *) (unit -> Pp.std_ppcmds)
diff --git a/tactics/tactics.mllib b/tactics/tactics.mllib
index 0a634138a4..b885b15243 100644
--- a/tactics/tactics.mllib
+++ b/tactics/tactics.mllib
@@ -21,3 +21,4 @@ Evar_tactics
 Autorewrite
 Decl_interp
 Decl_proof_instr
+Tactic_option
-- 
cgit v1.2.3