diff options
| author | herbelin | 2008-08-04 18:10:48 +0000 |
|---|---|---|
| committer | herbelin | 2008-08-04 18:10:48 +0000 |
| commit | 7d515acbc5d83aa2300b71a9b7712b3da1d3d2e3 (patch) | |
| tree | 01b9d71f3982ebee13c41cd9c2d5d6960c317eee /kernel | |
| parent | 0721090dea4d9018f4c4cad8cefa1a10fb0d5a71 (diff) | |
Évolutions diverses et variées.
- Correction divers messages d'erreur
- lorsque rien à réécrire dans une hyp,
- lorsqu'une variable ltac n'est pas liée,
- correction anomalie en présence de ?id dans le "as" de induction,
- correction mauvais env dans message d'erreur de unify_0.
- Diverses extensions et améliorations
- "specialize" :
- extension au cas (fun x1 ... xn => H u1 ... un),
- renommage au même endroit.
- "assert" et "pose proof" peuvent réutiliser la même hyp comme "specialize".
- "induction"
- intro des IH toujours au sommet même si induction sur var quantifiée,
- ajout d'un hack pour la reconnaissance de schémas inductifs comme
N_ind_double mais il reste du boulot pour reconnaître (et/ou
réordonner) les composantes d'un schéma dont les hypothèses ne sont pas
dans l'ordre standard,
- vérification de longueur et éventuelle complétion des
intropatterns dans le cas de sous-patterns destructifs dans induction
(par exemple "destruct n as [|[|]]" sur "forall n, n=0" ne mettait pas
le n dans le contexte),
- localisation des erreurs d'intropattern,
- ajout d'un pattern optionnel après "as" pour forcer une égalité et la
nommer (*).
- "apply" accepte plusieurs arguments séparés par des virgules (*).
- Plus de robustesse pour clear en présence d'evars.
- Amélioration affichage TacFun dans Print Ltac.
- Vieux pb espace en trop en tête d'affichage des tactiques EXTEND résolu
(incidemment, ça remodifie une nouvelle fois le test output Fixpoint.v !).
- Fusion VTactic/VFun dans l'espoir.
- Mise en place d'un système de trace de la pile des appels Ltac (tout en
préservant certains aspects de la récursivité terminale - cf bug #468).
- Tactiques primitives
- ajout de "move before" dans les tactiques primitives et ajout des
syntaxes move before et move dependent au niveau utilisateur (*),
- internal_cut peuvent faire du remplacement de nom d'hypothèse existant,
- suppression de Intro_replacing et du code sous-traitant
- Nettoyage
- Suppression cible et fichiers minicoq non portés depuis longtemps.
(*) Extensions de syntaxe qu'il pourrait être opportun de discuter
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@11300 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'kernel')
| -rw-r--r-- | kernel/environ.ml | 11 | ||||
| -rw-r--r-- | kernel/environ.mli | 2 | ||||
| -rw-r--r-- | kernel/term.ml | 21 | ||||
| -rw-r--r-- | kernel/term.mli | 4 |
4 files changed, 23 insertions, 15 deletions
diff --git a/kernel/environ.ml b/kernel/environ.ml index 30cec7ed94..80c24058ef 100644 --- a/kernel/environ.ml +++ b/kernel/environ.ml @@ -379,17 +379,14 @@ let insert_after_hyp (ctxt,vals) id d check = (* To be used in Logic.clear_hyps *) let remove_hyps ids check_context check_value (ctxt, vals) = - let ctxt,vals,rmv = - List.fold_right2 (fun (id,_,_ as d) (id',v) (ctxt,vals,rmv) -> + List.fold_right2 (fun (id,_,_ as d) (id',v) (ctxt,vals) -> if List.mem id ids then - (ctxt,vals,id::rmv) + (ctxt,vals) else let nd = check_context d in let nv = check_value v in - (nd::ctxt,(id',nv)::vals,rmv)) - ctxt vals ([],[],[]) - in ((ctxt,vals),rmv) - + (nd::ctxt,(id',nv)::vals)) + ctxt vals ([],[]) diff --git a/kernel/environ.mli b/kernel/environ.mli index ca41c2d7d9..b0dc2846f9 100644 --- a/kernel/environ.mli +++ b/kernel/environ.mli @@ -222,7 +222,7 @@ val insert_after_hyp : named_context_val -> variable -> named_declaration -> (named_context -> unit) -> named_context_val -val remove_hyps : identifier list -> (named_declaration -> named_declaration) -> (Pre_env.lazy_val -> Pre_env.lazy_val) -> named_context_val -> named_context_val * identifier list +val remove_hyps : identifier list -> (named_declaration -> named_declaration) -> (Pre_env.lazy_val -> Pre_env.lazy_val) -> named_context_val -> named_context_val (* spiwack: functions manipulating the retroknowledge *) diff --git a/kernel/term.ml b/kernel/term.ml index a15510158f..d274857af5 100644 --- a/kernel/term.ml +++ b/kernel/term.ml @@ -370,16 +370,22 @@ let destProd c = match kind_of_term c with | Prod (x,t1,t2) -> (x,t1,t2) | _ -> invalid_arg "destProd" +let isProd c = match kind_of_term c with | Prod _ -> true | _ -> false + (* Destructs the abstraction [x:t1]t2 *) let destLambda c = match kind_of_term c with | Lambda (x,t1,t2) -> (x,t1,t2) | _ -> invalid_arg "destLambda" +let isLambda c = match kind_of_term c with | Lambda _ -> true | _ -> false + (* Destructs the let [x:=b:t1]t2 *) let destLetIn c = match kind_of_term c with | LetIn (x,b,t1,t2) -> (x,b,t1,t2) | _ -> invalid_arg "destProd" +let isLetIn c = match kind_of_term c with LetIn _ -> true | _ -> false + (* Destructs an application *) let destApp c = match kind_of_term c with | App (f,a) -> (f, a) @@ -389,10 +395,6 @@ let destApplication = destApp let isApp c = match kind_of_term c with App _ -> true | _ -> false -let isProd c = match kind_of_term c with | Prod _ -> true | _ -> false - -let isLambda c = match kind_of_term c with | Lambda _ -> true | _ -> false - (* Destructs a constant *) let destConst c = match kind_of_term c with | Const kn -> kn @@ -419,22 +421,27 @@ let destConstruct c = match kind_of_term c with | Construct (kn, a as r) -> r | _ -> invalid_arg "dest" -let isConstruct c = match kind_of_term c with - Construct _ -> true | _ -> false +let isConstruct c = match kind_of_term c with Construct _ -> true | _ -> false (* Destructs a term <p>Case c of lc1 | lc2 .. | lcn end *) let destCase c = match kind_of_term c with | Case (ci,p,c,v) -> (ci,p,c,v) | _ -> anomaly "destCase" +let isCase c = match kind_of_term c with Case _ -> true | _ -> false + let destFix c = match kind_of_term c with | Fix fix -> fix | _ -> invalid_arg "destFix" - + +let isFix c = match kind_of_term c with Fix _ -> true | _ -> false + let destCoFix c = match kind_of_term c with | CoFix cofix -> cofix | _ -> invalid_arg "destCoFix" +let isCoFix c = match kind_of_term c with CoFix _ -> true | _ -> false + (******************************************************************) (* Cast management *) (******************************************************************) diff --git a/kernel/term.mli b/kernel/term.mli index 9254a6ff83..2ab03e50fe 100644 --- a/kernel/term.mli +++ b/kernel/term.mli @@ -230,9 +230,13 @@ val isSort : constr -> bool val isCast : constr -> bool val isApp : constr -> bool val isLambda : constr -> bool +val isLetIn : constr -> bool val isProd : constr -> bool val isConst : constr -> bool val isConstruct : constr -> bool +val isFix : constr -> bool +val isCoFix : constr -> bool +val isCase : constr -> bool val is_Prop : constr -> bool val is_Set : constr -> bool |
