Here comes the commit, announced long ago, of the new tactic engine.

This is a fairly large commit (around 140 files and 7000 lines of code
impacted), it will cause some troubles for sure (I've listed the know
regressions below, there is bound to be more).
At this state of developpement it brings few features to the user, as
the old tactics were
ported with no change. Changes are on the side of the developer mostly.

Here comes a list of the major changes. I will stay brief, but the code
is hopefully well documented so that it is reasonably easy to infer the
details from it.

Feature developer-side:
* Primitives for a "real" refine tactic (generating a goal for each
evar).
* Abstract type of tactics, goals and proofs
* Tactics can act on several goals (formally all the focused goals). An
interesting consequence of this is that the tactical (. ; [ . | ... ])
can be separated in two
tacticals (. ; .) and ( [ . | ... ] ) (although there is a conflict for
this particular syntax). We can also imagine a tactic to reorder the
goals.
* Possibility for a tactic to pass a value to following tactics (a
typical example is
an intro function which tells the following tactics which name it
introduced).
* backtracking primitives for tactics (it is now possible to implement a
tactical '+'
  with (a+b);c equivalent to (a;c+b;c) (itself equivalent to
(a;c||b;c)). This is a valuable
  tool to implement tactics like "auto" without nowing of the
implementation of tactics.
* A notion of proof modes, which allows to dynamically change the parser
for tactics. It is controlled at user level with the keywords Set
Default Proof Mode (this is the proof mode which is loaded at the start
of each proof) and Proof Mode (switches the proof mode of the current
proof) to control them.
* A new primitive Evd.fold_undefined which operates like an Evd.fold,
except it only goes through the evars whose body is Evar_empty. This is
a common operation throughout the code,
some of the fold-and-test-if-empty occurences have been replaced by
fold_undefined. For now,
it is only implemented as a fold-and-test, but we expect to have some
optimisations coming some day, as there can be a lot of evars in an
evar_map with this new implementation (I've observed a couple of
thousands), whereas there are rarely more than a dozen undefined ones.
Folding being a linear operation, this might result in a significant
speed-up.
* The declarative mode has been moved into the plugins. This is made
possible by the proof mode feature. I tried to document it so that it
can serve as a tutorial for a tactic mode plugin.

Features user-side:
* Unfocus does not go back to the root of the proof if several Focus-s
have been performed.
  It only goes back to the point where it was last focused.
* experimental (non-documented) support of keywords
BeginSubproof/EndSubproof:
  BeginSubproof focuses on first goal, one can unfocus only with
EndSubproof, and only
  if the proof is completed for that goal.
* experimental (non-documented) support for bullets ('+', '-' and '*')
  they act as hierarchical BeginSubproof/EndSubproof:
  First time one uses '+' (for instance) it focuses on first goal, when
the subproof is
  completed, one can use '+' again which unfocuses and focuses on next
first goal.
  Meanwhile, one cas use '*' (for instance) to focus more deeply.

Known regressions:
* The xml plugin had some functions related to proof trees. As the
structure of proof changed significantly, they do not work anymore.
* I do not know how to implement info or show script in this new engine.
Actually I don't even know what they were suppose to actually mean in
earlier versions either. I wager they would require some calm thinking
before going back to work.
* Declarative mode not entirely working (in particular proofs by
induction need to be restored).
* A bug in the inversion tactic (observed in some contributions)
* A bug in Program (observed in some contributions)
* Minor change in the 'old' type of tactics causing some contributions
to fail.
* Compilation time takes about 10-15% longer for unknown reasons (I
suspect it might be linked to the fact that I don't perform any
reduction at QED-s, and also to some linear operations on evar_map-s
(see Evd.fold_undefined above)).


git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12961 85f007b7-540e-0410-9357-904b9bb8a0f7

4 files changed, 15 insertions, 133 deletions

diff --git a/plugins/xml/dumptree.ml4 b/plugins/xml/dumptree.ml4
index 9419ba597..d20f9f9b6 100644
--- a/plugins/xml/dumptree.ml4
+++ b/plugins/xml/dumptree.ml4
@@ -56,13 +56,11 @@ let pr_rule_xml pr = function
       hov 2 (str "<cmpdrule>" ++ fnl () ++
         begin match cmpd with
           Tactic (texp, _) -> pr_tactic_xml texp
-        | Proof_instr (_,instr) -> pr_proof_instr_xml instr
         end ++ fnl ()
         ++ pr subtree
       ) ++ fnl () ++ str "</cmpdrule>"
   | Daimon -> str "<daimon/>"
   | Decl_proof _ -> str "<proof/>"
-(*  | Change_evars -> str "<chgevars/>"*)
 ;;
 
 let pr_var_decl_xml env (id,c,typ) =
@@ -115,11 +113,11 @@ let pr_subgoal_metas_xml metas env=
   List.fold_left (++) (mt ()) (List.map pr_one metas)
 ;;
 
-let pr_goal_xml g =
-  let env = try evar_unfiltered_env g with _ -> empty_env in
-  if g.evar_extra = None then
+let pr_goal_xml sigma g =
+  let env = try Goal.V82.unfiltered_env sigma g with _ -> empty_env in
+  if Decl_mode.try_get_info sigma g = None then
     (hov 2 (str "<goal>" ++ fnl () ++ str "<concl type=\"" ++
-    xmlstream (pr_ltype_env_at_top env g.evar_concl) ++
+    xmlstream (pr_ltype_env_at_top env (Goal.V82.concl sigma g)) ++
     str "\"/>" ++
     (pr_context_xml env)) ++
     fnl () ++ str "</goal>")
@@ -129,23 +127,9 @@ let pr_goal_xml g =
     fnl () ++ str "</goal>")
 ;;
 
-let rec print_proof_xml sigma osign pf =
-  let hyps = Environ.named_context_of_val pf.goal.evar_hyps in
-  let hyps' = thin_sign osign hyps in
-  match pf.ref with
-    | None -> hov 2 (str "<tree>" ++ fnl () ++ (pr_goal_xml {pf.goal with evar_hyps=hyps'})) ++ fnl () ++ str "</tree>"
-    | Some(r,spfl) ->
-        hov 2 (str "<tree>" ++ fnl () ++
-        (pr_goal_xml {pf.goal with evar_hyps=hyps'}) ++ fnl () ++ (pr_rule_xml (print_proof_xml sigma osign) r) ++
-        (List.fold_left (fun x y -> x ++ fnl () ++ y) (mt ()) (List.map (print_proof_xml sigma hyps) spfl))) ++ fnl () ++ str "</tree>"
-;;
-
 let print_proof_xml () =
-  let pp = print_proof_xml Evd.empty Sign.empty_named_context
-      (Tacmach.proof_of_pftreestate (Refiner.top_of_tree (Pfedit.get_pftreestate ())))
-  in
-  msgnl pp
-;;
+  Util.anomaly "Dump Tree command not supported in this version."
+
 
 VERNAC COMMAND EXTEND DumpTree
   [ "Dump" "Tree" ] -> [ print_proof_xml () ]
diff --git a/plugins/xml/proof2aproof.ml b/plugins/xml/proof2aproof.ml
index 1beabf26c..c7b8b556e 100644
--- a/plugins/xml/proof2aproof.ml
+++ b/plugins/xml/proof2aproof.ml
@@ -94,83 +94,9 @@ module ProofTreeHash =
 
 
 let extract_open_proof sigma pf =
- let module PT = Proof_type in
- let module L = Logic in
-  let evd = ref (Evd.create_evar_defs sigma) in
-  let proof_tree_to_constr = ProofTreeHash.create 503 in
-  let proof_tree_to_flattened_proof_tree = ProofTreeHash.create 503 in
-  let unshared_constrs = ref S.empty in
-  let rec proof_extractor vl node =
-   let constr =
-    match node with
-       {PT.ref=Some(PT.Prim _,_)} as pf ->
-        L.prim_extractor proof_extractor vl pf
-
-     | {PT.ref=Some(PT.Nested (_,hidden_proof),spfl)} ->
-	 let sgl,v = Refiner.frontier hidden_proof in
-	 let flat_proof = v spfl in
-         ProofTreeHash.add proof_tree_to_flattened_proof_tree node flat_proof ;
-	 proof_extractor vl flat_proof
-
-     | {PT.ref=None;PT.goal=goal} ->
-	 let visible_rels =
-           Util.map_succeed
-             (fun id ->
-                (* Section variables are in the [id] list but are not *)
-                (* lambda abstracted in the term [vl]                 *)
-                try let n = Logic.proof_variable_index id vl in (n,id)
-	        with Not_found -> failwith "caught")
-(*CSC: the above function must be modified such that when it is found  *)
-(*CSC: it becomes a Rel; otherwise a Var. Then it can be already used  *)
-(*CSC: as the evar_instance. Ordering the instance becomes useless (it *)
-(*CSC: will already be ordered.                                        *)
-             (Termops.ids_of_named_context
-		(Environ.named_context_of_val goal.Evd.evar_hyps)) in
-	 let sorted_rels =
-	   Sort.list (fun (n1,_) (n2,_) -> n1 < n2 ) visible_rels in
-	 let context =
-	   let l =
-             List.map
-               (fun (_,id) -> Sign.lookup_named id
-		   (Environ.named_context_of_val goal.Evd.evar_hyps))
-               sorted_rels in
-	   Environ.val_of_named_context l
-         in
-(*CSC: the section variables in the right order must be added too *)
-         let evar_instance = List.map (fun (n,_) -> Term.mkRel n) sorted_rels in
-    (*     let env = Global.env_of_context context in *)
-	 let evd',evar =
-           Evarutil.new_evar_instance context !evd goal.Evd.evar_concl
-             evar_instance in
-         evd := evd' ;
-         evar
-
-     | _ -> Util.anomaly "Bug : a case has been forgotten in proof_extractor"
-   in
-    let unsharedconstr =
-     let evar_nf_constr =
-      nf_evar ( !evd)
-        ~preserve:(function e -> S.mem e !unshared_constrs) constr
-     in
-      Unshare.unshare
-       ~already_unshared:(function e -> S.mem e !unshared_constrs)
-       evar_nf_constr
-    in
-(*CSC: debugging stuff to be removed *)
-if ProofTreeHash.mem proof_tree_to_constr node then
- Pp.ppnl (Pp.(++) (Pp.str "#DUPLICATE INSERTION: ")
- (Tactic_printer.print_proof ( !evd) [] node)) ;
-     ProofTreeHash.add proof_tree_to_constr node unsharedconstr ;
-     unshared_constrs := S.add unsharedconstr !unshared_constrs ;
-     unsharedconstr
-  in
-  let unshared_pf = unshare_proof_tree pf in
-  let pfterm = proof_extractor [] unshared_pf in
-   (pfterm,  !evd, proof_tree_to_constr, proof_tree_to_flattened_proof_tree,
-    unshared_pf)
-;;
+  (* Deactivated and candidate for removal. (Apr. 2010) *)
+   ()
 
 let extract_open_pftreestate pts =
-  extract_open_proof (Refiner.evc_of_pftreestate pts)
-   (Tacmach.proof_of_pftreestate pts)
-;;
+  (* Deactivated and candidate for removal. (Apr. 2010) *)
+   ()
diff --git a/plugins/xml/proofTree2Xml.ml4 b/plugins/xml/proofTree2Xml.ml4
index 3f1e0a630..dcfa99792 100644
--- a/plugins/xml/proofTree2Xml.ml4
+++ b/plugins/xml/proofTree2Xml.ml4
@@ -161,10 +161,12 @@ Pp.ppnl (Pp.(++) (Pp.str
          let of_attribute = ("name",tacname)::("script",tac)::of_attribute in
 
          (****** le but *)
-         let {Evd.evar_concl=concl;
-              Evd.evar_hyps=hyps}=goal in
+
+	 let concl = Goal.V82.concl sigma goal in
+	 let hyps = Goal.V82.hyps sigma goal in
 
          let env = Global.env_of_context hyps in
+	   
 
          let xgoal =
           X.xml_nempty "Goal" [] (constr_to_xml concl sigma env) in
@@ -188,9 +190,6 @@ Pp.ppnl (Pp.(++) (Pp.str
           [<(build_hyps new_hyps) ; (aux flat_proof nhyps)>]
         end
 
-     | {PT.ref=Some((PT.Nested(PT.Proof_instr (_,_),_)|PT.Decl_proof _),nodes)} ->
-         Util.anomaly "Not Implemented"
-
      | {PT.ref=Some(PT.Daimon,_)} ->
          X.xml_empty "Hidden_open_goal" of_attribute
 
diff --git a/plugins/xml/xmlcommand.ml b/plugins/xml/xmlcommand.ml
index b3b2e2654..8a095bb24 100644
--- a/plugins/xml/xmlcommand.ml
+++ b/plugins/xml/xmlcommand.ml
@@ -551,34 +551,7 @@ let print_ref qid fn =
 (*  where dest is either None (for stdout) or (Some filename) *)
 (* pretty prints via Xml.pp the proof in progress on dest     *)
 let show_pftreestate internal fn (kind,pftst) id =
- let pf = Tacmach.proof_of_pftreestate pftst in
- let typ = (Proof_trees.goal_of_proof pf).Evd.evar_concl in
- let val0,evar_map,proof_tree_to_constr,proof_tree_to_flattened_proof_tree,
-     unshared_pf
- =
-  Proof2aproof.extract_open_pftreestate pftst in
- let env = Global.env () in
- let obj =
-  mk_current_proof_obj (fst kind = Decl_kinds.Local) id val0 typ evar_map env in
- let uri =
-  match kind with
-     Decl_kinds.Local, _ ->
-      let uri =
-       "cic:/" ^ String.concat "/"
-        (Cic2acic.token_list_of_path (Lib.cwd ()) id Cic2acic.TVariable)
-      in
-      let kind_of_var = "VARIABLE","LocalFact" in
-       if not internal then print_object_kind uri kind_of_var;
-      uri
-   | Decl_kinds.Global, _ ->
-      let uri = Cic2acic.uri_of_declaration id Cic2acic.TConstant in
-       if not internal then print_object_kind uri (kind_of_global_goal kind);
-       uri
- in
-  print_object uri obj evar_map
-   (Some (Tacmach.evc_of_pftreestate pftst,unshared_pf,proof_tree_to_constr,
-    proof_tree_to_flattened_proof_tree)) fn
-;;
+  Util.anomaly "Xmlcommand.show_pftreestate is not supported in this version."
 
 let show fn =
  let pftst = Pfedit.get_pftreestate () in