aboutsummaryrefslogtreecommitdiff
path: root/plugins/funind
diff options
context:
space:
mode:
authorHugo Herbelin2014-08-20 22:30:37 +0200
committerHugo Herbelin2014-09-12 10:39:33 +0200
commitb006f10e7d591417844ffa1f04eeb926d6092d7b (patch)
tree9253b32cb1adabafce28f123ef9eb11d4fa122f4 /plugins/funind
parentca300977724a6b065a98c025d400c71f41b9df4b (diff)
Uniformisation of the order of arguments env and sigma.
Diffstat (limited to 'plugins/funind')
-rw-r--r--plugins/funind/g_indfun.ml44
-rw-r--r--plugins/funind/glob_term_to_relation.ml36
-rw-r--r--plugins/funind/indfun.ml6
-rw-r--r--plugins/funind/merge.ml2
-rw-r--r--plugins/funind/recdef.ml10
5 files changed, 29 insertions, 29 deletions
diff --git a/plugins/funind/g_indfun.ml4 b/plugins/funind/g_indfun.ml4
index bbb8a96c54..a597e5d454 100644
--- a/plugins/funind/g_indfun.ml4
+++ b/plugins/funind/g_indfun.ml4
@@ -474,9 +474,9 @@ VERNAC COMMAND EXTEND MergeFunind CLASSIFIED AS SIDEFF
[ "Mergeschemes" "(" ident(id1) ne_ident_list(cl1) ")"
"with" "(" ident(id2) ne_ident_list(cl2) ")" "using" ident(id) ] ->
[
- let f1,ctx = Constrintern.interp_constr Evd.empty (Global.env())
+ let f1,ctx = Constrintern.interp_constr (Global.env()) Evd.empty
(CRef (Libnames.Ident (Loc.ghost,id1),None)) in
- let f2,ctx' = Constrintern.interp_constr Evd.empty (Global.env())
+ let f2,ctx' = Constrintern.interp_constr (Global.env()) Evd.empty
(CRef (Libnames.Ident (Loc.ghost,id2),None)) in
let f1type = Typing.type_of (Global.env()) Evd.empty f1 in
let f2type = Typing.type_of (Global.env()) Evd.empty f2 in
diff --git a/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml
index 36942636ff..6d22743652 100644
--- a/plugins/funind/glob_term_to_relation.ml
+++ b/plugins/funind/glob_term_to_relation.ml
@@ -333,8 +333,8 @@ let raw_push_named (na,raw_value,raw_typ) env =
match na with
| Anonymous -> env
| Name id ->
- let value = Option.map (fun x-> fst (Pretyping.understand Evd.empty env x)) raw_value in
- let typ,ctx = Pretyping.understand Evd.empty env ~expected_type:Pretyping.IsType raw_typ in
+ let value = Option.map (fun x-> fst (Pretyping.understand env Evd.empty x)) raw_value in
+ let typ,ctx = Pretyping.understand env Evd.empty ~expected_type:Pretyping.IsType raw_typ in
Environ.push_named (id,value,typ) env
@@ -486,7 +486,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
a pseudo value "v1 ... vn".
The "value" of this branch is then simply [res]
*)
- let rt_as_constr,ctx = Pretyping.understand Evd.empty env rt in
+ let rt_as_constr,ctx = Pretyping.understand env Evd.empty rt in
let rt_typ = Typing.type_of env Evd.empty rt_as_constr in
let res_raw_type = Detyping.detype false [] (Termops.names_of_rel_context env) Evd.empty rt_typ in
let res = fresh_id args_res.to_avoid "_res" in
@@ -595,7 +595,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
and combine the two result
*)
let v_res = build_entry_lc env funnames avoid v in
- let v_as_constr,ctx = Pretyping.understand Evd.empty env v in
+ let v_as_constr,ctx = Pretyping.understand env Evd.empty v in
let v_type = Typing.type_of env Evd.empty v_as_constr in
let new_env =
match n with
@@ -611,7 +611,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
let make_discr = make_discr_match brl in
build_entry_lc_from_case env funnames make_discr el brl avoid
| GIf(_,b,(na,e_option),lhs,rhs) ->
- let b_as_constr,ctx = Pretyping.understand Evd.empty env b in
+ let b_as_constr,ctx = Pretyping.understand env Evd.empty b in
let b_typ = Typing.type_of env Evd.empty b_as_constr in
let (ind,_) =
try Inductiveops.find_inductive env Evd.empty b_typ
@@ -643,7 +643,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
)
nal
in
- let b_as_constr,ctx = Pretyping.understand Evd.empty env b in
+ let b_as_constr,ctx = Pretyping.understand env Evd.empty b in
let b_typ = Typing.type_of env Evd.empty b_as_constr in
let (ind,_) =
try Inductiveops.find_inductive env Evd.empty b_typ
@@ -691,7 +691,7 @@ and build_entry_lc_from_case env funname make_discr
in
let types =
List.map (fun (case_arg,_) ->
- let case_arg_as_constr,ctx = Pretyping.understand Evd.empty env case_arg in
+ let case_arg_as_constr,ctx = Pretyping.understand env Evd.empty case_arg in
Typing.type_of env Evd.empty case_arg_as_constr
) el
in
@@ -896,7 +896,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
let new_t =
mkGApp(mkGVar(mk_rel_id this_relname),args'@[res_rt])
in
- let t',ctx = Pretyping.understand Evd.empty env new_t in
+ let t',ctx = Pretyping.understand env Evd.empty new_t in
let new_env = Environ.push_rel (n,None,t') env in
let new_b,id_to_exclude =
rebuild_cons new_env
@@ -916,7 +916,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
try
observe (str "computing new type for eq : " ++ pr_glob_constr rt);
let t' =
- try fst (Pretyping.understand Evd.empty env t)(*FIXME*)
+ try fst (Pretyping.understand env Evd.empty t)(*FIXME*)
with e when Errors.noncritical e -> raise Continue
in
let is_in_b = is_free_in id b in
@@ -939,7 +939,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
mkGProd(n,t,new_b),id_to_exclude
with Continue ->
let jmeq = Globnames.IndRef (fst (destInd (jmeq ()))) in
- let ty',ctx = Pretyping.understand Evd.empty env ty in
+ let ty',ctx = Pretyping.understand env Evd.empty ty in
let ind,args' = Inductive.find_inductive env ty' in
let mib,_ = Global.lookup_inductive (fst ind) in
let nparam = mib.Declarations.mind_nparams in
@@ -961,7 +961,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
GApp(loc1,GRef(loc2,jmeq,None),[ty;GVar(loc3,id);rt_typ;rt])
in
observe (str "computing new type for jmeq : " ++ pr_glob_constr eq');
- let eq'_as_constr,ctx = Pretyping.understand Evd.empty env eq' in
+ let eq'_as_constr,ctx = Pretyping.understand env Evd.empty eq' in
observe (str " computing new type for jmeq : done") ;
let new_args =
match kind_of_term eq'_as_constr with
@@ -1011,7 +1011,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
if is_in_b then b else replace_var_by_term id rt b
in
let new_env =
- let t',ctx = Pretyping.understand Evd.empty env eq' in
+ let t',ctx = Pretyping.understand env Evd.empty eq' in
Environ.push_rel (n,None,t') env
in
let new_b,id_to_exclude =
@@ -1049,7 +1049,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
else raise Continue
with Continue ->
observe (str "computing new type for prod : " ++ pr_glob_constr rt);
- let t',ctx = Pretyping.understand Evd.empty env t in
+ let t',ctx = Pretyping.understand env Evd.empty t in
let new_env = Environ.push_rel (n,None,t') env in
let new_b,id_to_exclude =
rebuild_cons new_env
@@ -1065,7 +1065,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
end
| _ ->
observe (str "computing new type for prod : " ++ pr_glob_constr rt);
- let t',ctx = Pretyping.understand Evd.empty env t in
+ let t',ctx = Pretyping.understand env Evd.empty t in
let new_env = Environ.push_rel (n,None,t') env in
let new_b,id_to_exclude =
rebuild_cons new_env
@@ -1084,7 +1084,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
let not_free_in_t id = not (is_free_in id t) in
let new_crossed_types = t :: crossed_types in
observe (str "computing new type for lambda : " ++ pr_glob_constr rt);
- let t',ctx = Pretyping.understand Evd.empty env t in
+ let t',ctx = Pretyping.understand env Evd.empty t in
match n with
| Name id ->
let new_env = Environ.push_rel (n,None,t') env in
@@ -1106,7 +1106,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
| GLetIn(_,n,t,b) ->
begin
let not_free_in_t id = not (is_free_in id t) in
- let t',ctx = Pretyping.understand Evd.empty env t in
+ let t',ctx = Pretyping.understand env Evd.empty t in
let type_t' = Typing.type_of env Evd.empty t' in
let new_env = Environ.push_rel (n,Some t',type_t') env in
let new_b,id_to_exclude =
@@ -1131,7 +1131,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
args (crossed_types)
depth t
in
- let t',ctx = Pretyping.understand Evd.empty env new_t in
+ let t',ctx = Pretyping.understand env Evd.empty new_t in
let new_env = Environ.push_rel (na,None,t') env in
let new_b,id_to_exclude =
rebuild_cons new_env
@@ -1290,7 +1290,7 @@ let do_build_inductive
let rel_arities = Array.mapi rel_arity funsargs in
Util.Array.fold_left2 (fun env rel_name rel_ar ->
Environ.push_named (rel_name,None,
- fst (with_full_print (Constrintern.interp_constr Evd.empty env) rel_ar)) env) env relnames rel_arities
+ fst (with_full_print (Constrintern.interp_constr env Evd.empty) rel_ar)) env) env relnames rel_arities
in
(* and of the real constructors*)
let constr i res =
diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml
index e2273972e7..cd35a09a1d 100644
--- a/plugins/funind/indfun.ml
+++ b/plugins/funind/indfun.ml
@@ -130,7 +130,7 @@ let rec abstract_glob_constr c = function
List.fold_right (fun x b -> Constrexpr_ops.mkLambdaC([x],k,t,b)) idl
(abstract_glob_constr c bl)
-let interp_casted_constr_with_implicits sigma env impls c =
+let interp_casted_constr_with_implicits env sigma impls c =
Constrintern.intern_gen Pretyping.WithoutTypeConstraint env ~impls
~allow_patvar:false c
@@ -148,7 +148,7 @@ let build_newrecursive
List.fold_left
(fun (env,impls) ((_,recname),bl,arityc,_) ->
let arityc = Constrexpr_ops.prod_constr_expr arityc bl in
- let arity,ctx = Constrintern.interp_type sigma env0 arityc in
+ let arity,ctx = Constrintern.interp_type env0 sigma arityc in
let impl = Constrintern.compute_internalization_data env0 Constrintern.Recursive arity [] in
(Environ.push_named (recname,None,arity) env, Id.Map.add recname impl impls))
(env0,Constrintern.empty_internalization_env) lnameargsardef in
@@ -157,7 +157,7 @@ let build_newrecursive
let f (_,bl,_,def) =
let def = abstract_glob_constr def bl in
interp_casted_constr_with_implicits
- sigma rec_sign rec_impls def
+ rec_sign sigma rec_impls def
in
States.with_state_protection (List.map f) lnameargsardef
in
diff --git a/plugins/funind/merge.ml b/plugins/funind/merge.ml
index 0117adede0..669b77e038 100644
--- a/plugins/funind/merge.ml
+++ b/plugins/funind/merge.ml
@@ -51,7 +51,7 @@ let rec substitterm prof t by_t in_u =
let lift_ldecl n ldecl = List.map (fun (x,y) -> x,lift n y) ldecl
-let understand = Pretyping.understand Evd.empty (Global.env())
+let understand = Pretyping.understand (Global.env()) Evd.empty
(** Operations on names and identifiers *)
let id_of_name = function
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index 8602f0a527..f3096e7a71 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -194,7 +194,7 @@ let (value_f:constr list -> global_reference -> constr) =
Anonymous)],
GVar(d0,v_id)])
in
- let body = fst (understand Evd.empty env glob_body)(*FIXME*) in
+ let body = fst (understand env Evd.empty glob_body)(*FIXME*) in
it_mkLambda_or_LetIn body context
let (declare_f : Id.t -> logical_kind -> constr list -> global_reference -> global_reference) =
@@ -1340,7 +1340,7 @@ let open_new_goal build_proof ctx using_lemmas ref_ goal_name (gls_type,decompos
(fun c ->
Proofview.V82.of_tactic (Tacticals.New.tclTHENLIST
[intros;
- Simple.apply (fst (interp_constr Evd.empty (Global.env()) c)) (*FIXME*);
+ Simple.apply (fst (interp_constr (Global.env()) Evd.empty c)) (*FIXME*);
Tacticals.New.tclCOMPLETE Auto.default_auto
])
)
@@ -1461,10 +1461,10 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num
generate_induction_principle using_lemmas : unit =
let env = Global.env() in
let evd = ref (Evd.from_env env) in
- let function_type = interp_type_evars evd env type_of_f in
+ let function_type = interp_type_evars env evd type_of_f in
let env = push_named (function_name,None,function_type) env in
(* Pp.msgnl (str "function type := " ++ Printer.pr_lconstr function_type); *)
- let ty = interp_type_evars evd env ~impls:rec_impls eq in
+ let ty = interp_type_evars env evd ~impls:rec_impls eq in
let evm, nf = Evarutil.nf_evars_and_universes !evd in
let equation_lemma_type = nf_betaiotazeta (nf ty) in
let function_type = nf function_type in
@@ -1492,8 +1492,8 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num
let env_with_pre_rec_args = push_rel_context(List.map (function (x,t) -> (x,None,t)) pre_rec_args) env in
let relation =
fst (*FIXME*)(interp_constr
- Evd.empty
env_with_pre_rec_args
+ Evd.empty
r)
in
let tcc_lemma_name = add_suffix function_name "_tcc" in