aboutsummaryrefslogtreecommitdiff
path: root/kernel
diff options
context:
space:
mode:
authorherbelin2008-08-04 18:10:48 +0000
committerherbelin2008-08-04 18:10:48 +0000
commit7d515acbc5d83aa2300b71a9b7712b3da1d3d2e3 (patch)
tree01b9d71f3982ebee13c41cd9c2d5d6960c317eee /kernel
parent0721090dea4d9018f4c4cad8cefa1a10fb0d5a71 (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.ml11
-rw-r--r--kernel/environ.mli2
-rw-r--r--kernel/term.ml21
-rw-r--r--kernel/term.mli4
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