From de0085539583f59dc7c4bf4e272e18711d565466 Mon Sep 17 00:00:00 2001
From: Samuel Mimram <smimram@debian.org>
Date: Thu, 13 Jul 2006 14:28:31 +0000
Subject: Imported Upstream version 8.0pl3+8.1beta.2

---
 kernel/inductive.ml | 14 ++++++++++----
 1 file changed, 10 insertions(+), 4 deletions(-)

(limited to 'kernel/inductive.ml')

diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index d9f9f912..76553237 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: inductive.ml 8871 2006-05-28 16:46:48Z herbelin $ *)
+(* $Id: inductive.ml 8972 2006-06-22 22:17:43Z herbelin $ *)
 
 open Util
 open Names
@@ -135,16 +135,22 @@ let sort_as_univ = function
 | Prop Null -> neutral_univ
 | Prop Pos -> base_univ
 
+let cons_subst u su subst =
+  try (u, sup su (List.assoc u subst)) :: List.remove_assoc u subst
+  with Not_found -> (u, su) :: subst
+
 let rec make_subst env exp act =
   match exp, act with
   (* Bind expected levels of parameters to actual levels *)
   | None :: exp, _ :: act ->
       make_subst env exp act
-  | Some u :: exp, t :: act -> 
-      (u, sort_as_univ (snd (dest_arity env t))) :: make_subst env exp act
+  | Some u :: exp, t :: act ->
+      let su = sort_as_univ (snd (dest_arity env t)) in
+      cons_subst u su (make_subst env exp act)
   (* Not enough parameters, create a fresh univ *)
   | Some u :: exp, [] ->
-      (u, fresh_local_univ ()) :: make_subst env exp []
+      let su = fresh_local_univ () in
+      cons_subst u su (make_subst env exp [])
   | None :: exp, [] ->
       make_subst env exp []
   (* Uniform parameters are exhausted *)
-- 
cgit v1.2.3