From 710bbc7ca76faa77dbdebc9e14cf98ba8361111a Mon Sep 17 00:00:00 2001 From: herbelin Date: Thu, 20 Sep 2001 15:46:14 +0000 Subject: Le prédicat du vieux Case ne doit pas contenir d'univers algébrique même quand il est synthétisé à partir du type des branches MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@2025 85f007b7-540e-0410-9357-904b9bb8a0f7 --- pretyping/cases.ml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/pretyping/cases.ml b/pretyping/cases.ml index 89c4c8406..6f051b6e3 100644 --- a/pretyping/cases.ml +++ b/pretyping/cases.ml @@ -129,6 +129,11 @@ let build_notdep_pred env sigma indf pred = exception NotInferable of ml_case_error +let rec refresh_types t = match kind_of_term t with + | IsSort (Type _) -> new_Type () + | IsProd (na,u,v) -> mkProd (na,u,refresh_types v) + | _ -> t + let pred_case_ml_fail env sigma isrec (IndType (indf,realargs)) (i,ft) = let pred = let mispec,_ = dest_ind_family indf in @@ -138,7 +143,7 @@ let pred_case_ml_fail env sigma isrec (IndType (indf,realargs)) (i,ft) = let j = mis_index mispec in let nbrec = if isrec then count_rec_arg j recargi else 0 in let nb_arg = List.length (recargs.(i)) + nbrec in - let pred = concl_n env sigma nb_arg ft in + let pred = refresh_types (concl_n env sigma nb_arg ft) in if noccur_between 1 nb_arg pred then lift (-nb_arg) pred else -- cgit v1.2.3