diff options
| -rw-r--r-- | interp/constrintern.ml | 8 | ||||
| -rw-r--r-- | interp/constrintern.mli | 2 | ||||
| -rw-r--r-- | test-suite/bugs/closed/4217.v | 6 | ||||
| -rw-r--r-- | toplevel/command.ml | 2 |
4 files changed, 12 insertions, 6 deletions
diff --git a/interp/constrintern.ml b/interp/constrintern.ml index 8f0d56c5b..982d9bfe3 100644 --- a/interp/constrintern.ml +++ b/interp/constrintern.ml @@ -1893,7 +1893,7 @@ let intern_context global_level env impl_env binders = with InternalizationError (loc,e) -> user_err_loc (loc,"internalize", explain_internalization_error e) -let interp_rawcontext_evars env evdref bl = +let interp_rawcontext_evars env evdref k bl = let (env, par, _, impls) = List.fold_left (fun (env,params,n,impls) (na, k, b, t) -> @@ -1914,11 +1914,11 @@ let interp_rawcontext_evars env evdref bl = let c = understand_judgment_tcc env evdref b in let d = (na, Some c.uj_val, c.uj_type) in (push_rel d env, d::params, n, impls)) - (env,[],1,[]) (List.rev bl) + (env,[],k+1,[]) (List.rev bl) in (env, par), impls -let interp_context_evars ?(global_level=false) ?(impl_env=empty_internalization_env) env evdref params = +let interp_context_evars ?(global_level=false) ?(impl_env=empty_internalization_env) ?(shift=0) env evdref params = let int_env,bl = intern_context global_level env impl_env params in - let x = interp_rawcontext_evars env evdref bl in + let x = interp_rawcontext_evars env evdref shift bl in int_env, x diff --git a/interp/constrintern.mli b/interp/constrintern.mli index 0d33d4334..4d2c99467 100644 --- a/interp/constrintern.mli +++ b/interp/constrintern.mli @@ -157,7 +157,7 @@ val interp_binder_evars : env -> evar_map ref -> Name.t -> constr_expr -> types (** Interpret contexts: returns extended env and context *) val interp_context_evars : - ?global_level:bool -> ?impl_env:internalization_env -> + ?global_level:bool -> ?impl_env:internalization_env -> ?shift:int -> env -> evar_map ref -> local_binder list -> internalization_env * ((env * rel_context) * Impargs.manual_implicits) diff --git a/test-suite/bugs/closed/4217.v b/test-suite/bugs/closed/4217.v new file mode 100644 index 000000000..19973f30a --- /dev/null +++ b/test-suite/bugs/closed/4217.v @@ -0,0 +1,6 @@ +(* Checking correct index of implicit by pos in fixpoints *) + +Fixpoint ith_default + {default_A : nat} + {As : list nat} + {struct As} : Set. diff --git a/toplevel/command.ml b/toplevel/command.ml index cdeecf1bb..1249581ee 100644 --- a/toplevel/command.ml +++ b/toplevel/command.ml @@ -733,7 +733,7 @@ type structured_fixpoint_expr = { let interp_fix_context env evdref isfix fix = let before, after = if isfix then split_at_annot fix.fix_binders fix.fix_annot else [], fix.fix_binders in let impl_env, ((env', ctx), imps) = interp_context_evars env evdref before in - let impl_env', ((env'', ctx'), imps') = interp_context_evars ~impl_env env' evdref after in + let impl_env', ((env'', ctx'), imps') = interp_context_evars ~impl_env ~shift:(List.length before) env' evdref after in let annot = Option.map (fun _ -> List.length (assums_of_rel_context ctx)) fix.fix_annot in ((env'', ctx' @ ctx), (impl_env',imps @ imps'), annot) |