aboutsummaryrefslogtreecommitdiffhomepage
path: root/plugins/funind
diff options
context:
space:
mode:
authorGravatar Hugo Herbelin <Hugo.Herbelin@inria.fr>2014-08-12 14:03:32 +0200
committerGravatar Hugo Herbelin <Hugo.Herbelin@inria.fr>2014-09-12 10:39:32 +0200
commit012fe1a96ba81ab0a7fa210610e3f25187baaf1d (patch)
tree32282ac2f1198738c8c545b19215ff0a0d9ef6ce /plugins/funind
parentb720cd3cbefa46da784b68a8e016a853f577800c (diff)
Referring to evars by names. Added a parser for evars (but parsing of
instances still to do). Using heuristics to name after the quantifier name it comes. Also added a "sigma" to almost all printing functions.
Diffstat (limited to 'plugins/funind')
-rw-r--r--plugins/funind/functional_principles_proofs.ml2
-rw-r--r--plugins/funind/glob_term_to_relation.ml18
-rw-r--r--plugins/funind/indfun.ml6
-rw-r--r--plugins/funind/merge.ml8
4 files changed, 18 insertions, 16 deletions
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index aba93de47..700f67a74 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -599,7 +599,7 @@ let treat_new_case ptes_infos nb_prod continue_tac term dyn_infos =
| App(f,[| _;_;args2 |]) -> args2
| _ ->
observe (str "cannot compute new term value : " ++ pr_gls g' ++ fnl () ++ str "last hyp is" ++
- pr_lconstr_env (pf_env g') new_term_value_eq
+ pr_lconstr_env (pf_env g') Evd.empty new_term_value_eq
);
anomaly (Pp.str "cannot compute new term value")
in
diff --git a/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml
index 587af35ac..36942636f 100644
--- a/plugins/funind/glob_term_to_relation.ml
+++ b/plugins/funind/glob_term_to_relation.ml
@@ -340,7 +340,7 @@ let raw_push_named (na,raw_value,raw_typ) env =
let add_pat_variables pat typ env : Environ.env =
let rec add_pat_variables env pat typ : Environ.env =
- observe (str "new rel env := " ++ Printer.pr_rel_context_of env);
+ observe (str "new rel env := " ++ Printer.pr_rel_context_of env Evd.empty);
match pat with
| PatVar(_,na) -> Environ.push_rel (na,None,typ) env
@@ -376,7 +376,7 @@ let add_pat_variables pat typ env : Environ.env =
~init:(env,[])
)
in
- observe (str "new var env := " ++ Printer.pr_named_context_of res);
+ observe (str "new var env := " ++ Printer.pr_named_context_of res Evd.empty);
res
@@ -405,7 +405,7 @@ let rec pattern_to_term_and_type env typ = function
Array.to_list
(Array.init
(cst_narg - List.length patternl)
- (fun i -> Detyping.detype false [] (Termops.names_of_rel_context env) csta.(i))
+ (fun i -> Detyping.detype false [] (Termops.names_of_rel_context env) Evd.empty csta.(i))
)
in
let patl_as_term =
@@ -488,7 +488,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
*)
let rt_as_constr,ctx = Pretyping.understand Evd.empty env 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) rt_typ 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
let new_avoid = res::args_res.to_avoid in
let res_rt = mkGVar res in
@@ -743,7 +743,7 @@ and build_entry_lc_from_case_term env types funname make_discr patterns_to_preve
in
let raw_typ_of_id =
Detyping.detype false []
- (Termops.names_of_rel_context env_with_pat_ids) typ_of_id
+ (Termops.names_of_rel_context env_with_pat_ids) Evd.empty typ_of_id
in
mkGProd (Name id,raw_typ_of_id,acc))
pat_ids
@@ -787,7 +787,7 @@ and build_entry_lc_from_case_term env types funname make_discr patterns_to_preve
List.map3
(fun pat e typ_as_constr ->
let this_pat_ids = ids_of_pat pat in
- let typ = Detyping.detype false [] (Termops.names_of_rel_context new_env) typ_as_constr in
+ let typ = Detyping.detype false [] (Termops.names_of_rel_context new_env) Evd.empty typ_as_constr in
let pat_as_term = pattern_to_term pat in
List.fold_right
(fun id acc ->
@@ -795,7 +795,7 @@ and build_entry_lc_from_case_term env types funname make_discr patterns_to_preve
then (Prod (Name id),
let typ_of_id = Typing.type_of new_env Evd.empty (mkVar id) in
let raw_typ_of_id =
- Detyping.detype false [] (Termops.names_of_rel_context new_env) typ_of_id
+ Detyping.detype false [] (Termops.names_of_rel_context new_env) Evd.empty typ_of_id
in
raw_typ_of_id
)::acc
@@ -951,7 +951,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
GRef (Loc.ghost,Globnames.IndRef (fst ind),None),
(List.map
(fun p -> Detyping.detype false []
- (Termops.names_of_rel_context env)
+ (Termops.names_of_rel_context env) Evd.empty
p) params)@(Array.to_list
(Array.make
(List.length args' - nparam)
@@ -980,10 +980,12 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
| Name id' ->
(id',Detyping.detype false []
(Termops.names_of_rel_context env)
+ Evd.empty
arg)::acc
else if isVar var_as_constr
then (destVar var_as_constr,Detyping.detype false []
(Termops.names_of_rel_context env)
+ Evd.empty
arg)::acc
else acc
)
diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml
index 953e1f049..e2273972e 100644
--- a/plugins/funind/indfun.ml
+++ b/plugins/funind/indfun.ml
@@ -538,7 +538,7 @@ let recompute_binder_list (fixpoint_exprl : (Vernacexpr.fixpoint_expr * Vernacex
let fixl,ntns = Command.extract_fixpoint_components false fixpoint_exprl in
let ((_,_,typel),_,_) = Command.interp_fixpoint fixl ntns in
let constr_expr_typel =
- with_full_print (List.map (Constrextern.extern_constr false (Global.env ()))) typel in
+ with_full_print (List.map (Constrextern.extern_constr false (Global.env ()) Evd.empty)) typel in
let fixpoint_exprl_with_new_bl =
List.map2 (fun ((lna,(rec_arg_opt,rec_order),bl,ret_typ,opt_body),notation_list) fix_typ ->
@@ -768,8 +768,8 @@ let make_graph (f_ref:global_reference) =
let env = Global.env () in
let extern_body,extern_type =
with_full_print (fun () ->
- (Constrextern.extern_constr false env body,
- Constrextern.extern_type false env
+ (Constrextern.extern_constr false env Evd.empty body,
+ Constrextern.extern_type false env Evd.empty
((*FIXNE*) Typeops.type_of_constant_type env c_body.const_type)
)
)
diff --git a/plugins/funind/merge.ml b/plugins/funind/merge.ml
index 0886e7f71..0117adede 100644
--- a/plugins/funind/merge.ml
+++ b/plugins/funind/merge.ml
@@ -773,7 +773,7 @@ let merge_inductive_body (shift:merge_infos) avoid (oib1:one_inductive_body)
let mkrawcor nme avoid typ =
(* first replace rel 1 by a varname *)
let substindtyp = substitterm 0 (mkRel 1) (mkVar nme) typ in
- Detyping.detype false (Id.Set.elements avoid) [] substindtyp in
+ Detyping.detype false (Id.Set.elements avoid) [] Evd.empty substindtyp in
let lcstr1: glob_constr list =
Array.to_list (Array.map (mkrawcor ind1name avoid) oib1.mind_user_lc) in
(* add to avoid all indentifiers of lcstr1 *)
@@ -821,11 +821,11 @@ let merge_rec_params_and_arity prms1 prms2 shift (concl:constr) =
let typ = glob_constr_to_constr_expr tp in
LocalRawAssum ([(Loc.ghost,nme)], Constrexpr_ops.default_binder_kind, typ) :: acc)
[] params in
- let concl = Constrextern.extern_constr false (Global.env()) concl in
+ let concl = Constrextern.extern_constr false (Global.env()) Evd.empty concl in
let arity,_ =
List.fold_left
(fun (acc,env) (nm,_,c) ->
- let typ = Constrextern.extern_constr false env c in
+ let typ = Constrextern.extern_constr false env Evd.empty c in
let newenv = Environ.push_rel (nm,None,c) env in
CProdN (Loc.ghost, [[(Loc.ghost,nm)],Constrexpr_ops.default_binder_kind,typ] , acc) , newenv)
(concl,Global.env())
@@ -854,7 +854,7 @@ let glob_constr_list_to_inductive_expr prms1 prms2 mib1 mib2 shift
let mkProd_reldecl (rdecl:rel_declaration) (t2:glob_constr) =
match rdecl with
| (nme,None,t) ->
- let traw = Detyping.detype false [] [] t in
+ let traw = Detyping.detype false [] [] Evd.empty t in
GProd (Loc.ghost,nme,Explicit,traw,t2)
| (_,Some _,_) -> assert false