From fb982f3d9fd7610c02ca69cad4d9c59ac26a931b Mon Sep 17 00:00:00 2001
From: herbelin
Date: Tue, 5 Feb 2013 10:15:31 +0000
Subject: Fixed bug #2981 (anomaly NotASort in Retyping due to collision
 between variable names).

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16185 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 pretyping/retyping.ml | 18 ++++++++----------
 1 file changed, 8 insertions(+), 10 deletions(-)

(limited to 'pretyping')

diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml
index b01e30bac1..1a175465a3 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -25,18 +25,16 @@ let rec subst_type env sigma typ = function
         | Prod (na,c1,c2) -> subst_type env sigma (subst1 h c2) rest
         | _ -> anomaly (str "Non-functional construction")
 
-(* Si ft est le type d'un terme f, lequel est appliqué à args, *)
-(* [sort_of_atomic_ty] calcule ft[args] qui doit être une sorte *)
-(* On suit une méthode paresseuse, en espèrant que ft est une arité *)
-(* et sinon on substitue *)
+(* If ft is the type of f which itself is applied to args, *)
+(* [sort_of_atomic_type] computes ft[args] which has to be a sort *)
 
 let sort_of_atomic_type env sigma ft args =
-  let rec concl_of_arity env ar =
-    match kind_of_term (whd_betadeltaiota env sigma ar) with
-    | Prod (na, t, b) -> concl_of_arity (push_rel (na,None,t) env) b
-    | Sort s -> s
-    | _ -> decomp_sort env sigma (subst_type env sigma ft (Array.to_list args))
-  in concl_of_arity env ft
+  let rec concl_of_arity env ar args =
+    match kind_of_term (whd_betadeltaiota env sigma ar), args with
+    | Prod (na, t, b), h::l -> concl_of_arity (push_rel (na,Some h,t) env) b l
+    | Sort s, [] -> s
+    | _ -> anomaly (str "Not a sort")
+  in concl_of_arity env ft (Array.to_list args)
 
 let type_of_var env id =
   try let (_,_,ty) = lookup_named id env in ty
-- 
cgit v1.2.3