diff options
| author | Hugo Herbelin | 2015-11-19 22:49:25 +0100 |
|---|---|---|
| committer | Hugo Herbelin | 2015-12-05 10:01:14 +0100 |
| commit | ade2363e357db3ac3f258e645fe6bba988e7e7dd (patch) | |
| tree | ade794510151d080d164be6d33d03aacbbe5064f /pretyping | |
| parent | f66e604a9d714ee9dba09234d935ee208bc89d97 (diff) | |
About building of substitutions from instances.
Redefining adjust_subst_to_rel_context from instantiate_context who
was hidden in inductiveops.ml, renamed the latter into
subst_of_rel_context_instance and moving them to Vars. The new name
highlights that the input is an instance (as for applist) and the
output a substitution (as for substl). This is a clearer unified
interface, centralizing the difficult de-Bruijn job in one place. It
saves a couple of List.rev.
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/cases.ml | 8 | ||||
| -rw-r--r-- | pretyping/inductiveops.ml | 10 | ||||
| -rw-r--r-- | pretyping/vnorm.ml | 2 |
3 files changed, 6 insertions, 14 deletions
diff --git a/pretyping/cases.ml b/pretyping/cases.ml index a5a7ace221..b894cb8ea4 100644 --- a/pretyping/cases.ml +++ b/pretyping/cases.ml @@ -837,10 +837,10 @@ let regeneralize_index_predicate n = map_predicate (relocate_index n 1) 0 let substnl_predicate sigma = map_predicate (substnl sigma) (* This is parallel bindings *) -let subst_predicate (args,copt) ccl tms = +let subst_predicate (subst,copt) ccl tms = let sigma = match copt with - | None -> List.rev args - | Some c -> c::(List.rev args) in + | None -> subst + | Some c -> c::subst in substnl_predicate sigma 0 ccl tms let specialize_predicate_var (cur,typ,dep) tms ccl = @@ -1018,7 +1018,7 @@ let specialize_predicate newtomatchs (names,depna) arsign cs tms ccl = (* We prepare the substitution of X and x:I(X) *) let realargsi = if not (Int.equal nrealargs 0) then - adjust_subst_to_rel_context arsign (Array.to_list cs.cs_concl_realargs) + subst_of_rel_context_instance arsign (Array.to_list cs.cs_concl_realargs) else [] in let copti = match depna with diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml index 632e00ed70..4c2ae61c30 100644 --- a/pretyping/inductiveops.ml +++ b/pretyping/inductiveops.ml @@ -354,14 +354,6 @@ let substnl_rel_context subst n sign = let substl_rel_context subst = substnl_rel_context subst 0 -let instantiate_context sign args = - let rec aux subst = function - | (_,None,_)::sign, a::args -> aux (a::subst) (sign,args) - | (_,Some b,_)::sign, args -> aux (substl subst b::subst) (sign,args) - | [], [] -> subst - | _ -> anomaly (Pp.str "Signature/instance mismatch in inductive family") - in aux [] (List.rev sign,args) - let get_arity env ((ind,u),params) = let (mib,mip) = Inductive.lookup_mind_specif env ind in let parsign = @@ -379,7 +371,7 @@ let get_arity env ((ind,u),params) = let parsign = Vars.subst_instance_context u parsign in let arproperlength = List.length mip.mind_arity_ctxt - List.length parsign in let arsign,_ = List.chop arproperlength mip.mind_arity_ctxt in - let subst = instantiate_context parsign params in + let subst = subst_of_rel_context_instance parsign params in let arsign = Vars.subst_instance_context u arsign in (substl_rel_context subst arsign, Inductive.inductive_sort_family mip) diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml index 60140a31d9..c59e085e5b 100644 --- a/pretyping/vnorm.ml +++ b/pretyping/vnorm.ml @@ -57,7 +57,7 @@ let type_constructor mind mib u typ params = if Int.equal ndecls 0 then ctyp else let _,ctyp = decompose_prod_n_assum ndecls ctyp in - substl (List.rev (Termops.adjust_subst_to_rel_context mib.mind_params_ctxt (Array.to_list params))) + substl (List.rev (adjust_subst_to_rel_context mib.mind_params_ctxt (Array.to_list params))) ctyp |