aboutsummaryrefslogtreecommitdiffhomepage
path: root/tactics/class_tactics.ml
diff options
context:
space:
mode:
authorGravatar aspiwack <aspiwack@85f007b7-540e-0410-9357-904b9bb8a0f7>2013-11-02 15:34:01 +0000
committerGravatar aspiwack <aspiwack@85f007b7-540e-0410-9357-904b9bb8a0f7>2013-11-02 15:34:01 +0000
commit260965dcf60d793ba01110ace8945cf51ef6531f (patch)
treed07323383e16bb5a63492e2721cf0502ba931716 /tactics/class_tactics.ml
parent328279514e65f47a689e2d23f132c43c86870c05 (diff)
Makes the new Proofview.tactic the basic type of Ltac.
On the compilation of Coq, we can see an increase of ~20% compile time on my completely non-scientific tests. Hopefully this can be fixed. There are a lot of low hanging fruits, but this is an iso-functionality commit. With a few exceptions which were not necessary for the compilation of the theories: - The declarative mode is not yet ported - The timeout tactical is currently deactivated because it needs some subtle I/O. The framework is ready to handle it, but I haven't done it yet. - For much the same reason, the ltac debugger is unplugged. It will be more difficult, but will eventually be back. A few comments: I occasionnally used a coercion from [unit Proofview.tactic] to the old [Prooftype.tactic]. It should work smoothely, but loses any backtracking information: the coerced tactics has at most one success. - It is used in autorewrite (it shouldn't be a problem there). Autorewrite's code is fairly old and tricky - It is used in eauto, mostly for "Hint Extern". It may be an issue as time goes as we might want to have various success in a "Hint Extern". But it would require a heavy port of eauto.ml4 - It is used in typeclass eauto, but with a little help from Matthieu, it should be easy to port the whole thing to the new tactic engine, actually simplifying the code. - It is used in fourier. I believe it to be inocuous. - It is used in firstorder and congruence. I think it's ok. Their code is somewhat intricate and I'm not sure they would be easy to actually port. - It is used heavily in Function. And honestly, I have no idea whether it can do harm or not. Updates: (11 June 2013) Pierre-Marie Pédrot contributed the rebase over his new stream based architecture for Ltac matching (r16533), which avoid painfully and expensively working around the exception-throwing control flow of the previous API. (11 October 2013) Rebasing over recent commits (somewhere in r16721-r16730) rendered a major bug in my implementation of Tacticals.New.tclREPEAT_MAIN apparent. It caused Field_theory.v to loop. The bug made rewrite !lemma, rewrite ?lemma and autorewrite incorrect (tclREPEAT_MAIN was essentially tclREPEAT, causing rewrites to be tried in the side-conditions of conditional rewrites as well). The new implementation makes Coq faster, but it is pretty much impossible to tell if it is significant at all. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16967 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'tactics/class_tactics.ml')
-rw-r--r--tactics/class_tactics.ml33
1 files changed, 18 insertions, 15 deletions
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index 87086cfae..71f8c2ba8 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -24,6 +24,7 @@ open Globnames
open Evd
open Locus
open Misctypes
+open Proofview.Notations
(** Hint database named "typeclass_instances", now created directly in Auto *)
@@ -81,14 +82,14 @@ let rec eq_constr_mod_evars x y =
| Evar (e1, l1), Evar (e2, l2) when not (Evar.equal e1 e2) -> true
| _, _ -> compare_constr eq_constr_mod_evars x y
-let progress_evars t gl =
- let concl = pf_concl gl in
- let check gl' =
- let newconcl = pf_concl gl' in
+let progress_evars t =
+ Goal.concl >>- fun concl ->
+ let check =
+ Goal.concl >>- fun newconcl ->
if eq_constr_mod_evars concl newconcl
- then tclFAIL 0 (str"No progress made (modulo evars)") gl'
- else tclIDTAC gl'
- in tclTHEN t check gl
+ then Tacticals.New.tclFAIL 0 (str"No progress made (modulo evars)")
+ else Proofview.tclUNIT ()
+ in t <*> check
let unify_e_resolve flags (c,clenv) gls =
let clenv' = connect_clenv gls clenv in
@@ -105,7 +106,7 @@ let clenv_of_prods nprods (c, clenv) gls =
else
let ty = pf_type_of gls c in
let diff = nb_prod ty - nprods in
- if diff >= 0 then
+ if Pervasives.(>=) diff 0 then
Some (mk_clenv_from_n gls (Some diff) (c,ty))
else None
@@ -125,7 +126,7 @@ let flags_of_state st =
let rec e_trivial_fail_db db_list local_db goal =
let tacl =
Eauto.registered_e_assumption ::
- (tclTHEN Tactics.intro
+ (tclTHEN (Proofview.V82.of_tactic Tactics.intro)
(function g'->
let d = pf_last_hyp g' in
let hintl = make_resolve_hyp (pf_env g') (project g') d in
@@ -164,7 +165,7 @@ and e_my_find_search db_list local_db hdc complete concl =
| Extern tacast ->
(* tclTHEN *)
(* (fun gl -> Refiner.tclEVARS (mark_unresolvables (project gl)) gl) *)
- (conclPattern concl p tacast)
+ Proofview.V82.of_tactic (conclPattern concl p tacast)
in
let tac = if complete then tclCOMPLETE tac else tac in
match t with
@@ -293,8 +294,8 @@ let lift_tactic tac (f : goal list sigma -> autoinfo -> autogoal list sigma) : '
| None -> fk () }
let intro_tac : atac =
- lift_tactic Tactics.intro
- (fun {it = gls; sigma = s;} info ->
+ lift_tactic (Proofview.V82.of_tactic Tactics.intro)
+ (fun {it = gls; sigma = s} info ->
let gls' =
List.map (fun g' ->
let env = Goal.V82.env s g' in
@@ -723,7 +724,9 @@ let typeclasses_eauto ?(only_classes=false) ?(st=full_transparent_state) dbs gl
eauto ?limit:!typeclasses_depth ~only_classes ~st dbs gl
with Not_found -> tclFAIL 0 (str" typeclasses eauto failed on: " ++ Printer.pr_goal gl) gl
-let _ = Classes.refine_ref := Refine.refine
+let _ = Classes.refine_ref := begin fun c ->
+ Refine.refine c
+end
(** Take the head of the arity of a constr.
Used in the partial application tactic. *)
@@ -741,8 +744,8 @@ let head_of_constr h c =
letin_tac None (Name h) c None Locusops.allHyps
let not_evar c = match kind_of_term c with
-| Evar _ -> tclFAIL 0 (str"Evar")
-| _ -> tclIDTAC
+| Evar _ -> Tacticals.New.tclFAIL 0 (str"Evar")
+| _ -> Proofview.tclUNIT ()
let is_ground c gl =
if Evarutil.is_ground_term (project gl) c then tclIDTAC gl