aboutsummaryrefslogtreecommitdiff
path: root/kernel/inductive.ml
diff options
context:
space:
mode:
authorherbelin2000-10-11 13:41:26 +0000
committerherbelin2000-10-11 13:41:26 +0000
commit9ca14acd5acdd6159540d072a777adb4b9ed5ed0 (patch)
treee8b5a84f915e575aa150ddc1b52a55a89f4d4609 /kernel/inductive.ml
parentd510a00bbe0223a34e1fe2f8ad77f9141ec700e2 (diff)
Prise en compte de Let dans build_dependent_inductive
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@683 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'kernel/inductive.ml')
-rw-r--r--kernel/inductive.ml18
1 files changed, 13 insertions, 5 deletions
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 3436bf9620..257305b006 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -260,27 +260,35 @@ let get_arity (IndFamily (mispec,params)) =
(* Functions to build standard types related to inductive *)
+let local_rels =
+ let rec relrec acc n = function (* more recent arg in front *)
+ | [] -> acc
+ | (_,None,_)::l -> relrec (mkRel n :: acc) (n+1) l
+ | (_,Some _,_)::l -> relrec acc (n+1) l
+ in relrec [] 1
+
let build_dependent_constructor cs =
applist
(mkMutConstruct cs.cs_cstr,
- (List.map (lift cs.cs_nargs) cs.cs_params)@(rel_list 0 cs.cs_nargs))
+ (List.map (lift cs.cs_nargs) cs.cs_params)@(local_rels cs.cs_args))
-let build_dependent_inductive (IndFamily (mis, params)) =
+let build_dependent_inductive (IndFamily (mis, params) as indf) =
+ let arsign,_ = get_arity indf in
let nrealargs = mis_nrealargs mis in
applist
(mkMutInd (mis_inductive mis),
- (List.map (lift nrealargs) params)@(rel_list 0 nrealargs))
+ (List.map (lift nrealargs) params)@(local_rels arsign))
(* builds the arity of an elimination predicate in sort [s] *)
let make_arity env dep indf s =
let (arsign,_) = get_arity indf in
if dep then
(* We need names everywhere *)
- it_prod_name env
+ it_mkProd_or_LetIn_name env
(mkArrow (build_dependent_inductive indf) (mkSort s)) arsign
else
(* No need to enforce names *)
- prod_it (mkSort s) arsign
+ it_mkProd_or_LetIn (mkSort s) arsign
(* [p] is the predicate and [cs] a constructor summary *)
let build_branch_type env dep p cs =