aboutsummaryrefslogtreecommitdiff
path: root/plugins/funind/invfun.ml
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/funind/invfun.ml')
-rw-r--r--plugins/funind/invfun.ml39
1 files changed, 7 insertions, 32 deletions
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index d68bdc2153..bcfa6b9316 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -26,31 +26,6 @@ open Context.Rel.Declaration
module RelDecl = Context.Rel.Declaration
-(* Some pretty printing function for debugging purpose *)
-
-let pr_binding prc =
- function
- | loc, (NamedHyp id, c) -> hov 1 (Ppconstr.pr_id id ++ str " := " ++ Pp.cut () ++ prc c)
- | loc, (AnonHyp n, c) -> hov 1 (int n ++ str " := " ++ Pp.cut () ++ prc c)
-
-let pr_bindings prc prlc = function
- | ImplicitBindings l ->
- brk (1,1) ++ str "with" ++ brk (1,1) ++
- pr_sequence prc l
- | ExplicitBindings l ->
- brk (1,1) ++ str "with" ++ brk (1,1) ++
- pr_sequence (fun b -> str"(" ++ pr_binding prlc b ++ str")") l
- | NoBindings -> mt ()
-
-
-let pr_with_bindings prc prlc (c,bl) =
- prc c ++ hv 0 (pr_bindings prc prlc bl)
-
-
-
-let pr_constr_with_binding prc (c,bl) : Pp.std_ppcmds =
- pr_with_bindings prc prc (c,bl)
-
(* The local debugging mechanism *)
(* let msgnl = Pp.msgnl *)
@@ -140,7 +115,7 @@ let generate_type evd g_to_f f graph i =
let ctxt,_ = decompose_prod_assum !evd graph_arity in
let fun_ctxt,res_type =
match ctxt with
- | [] | [_] -> anomaly (Pp.str "Not a valid context")
+ | [] | [_] -> anomaly (Pp.str "Not a valid context.")
| decl :: fun_ctxt -> fun_ctxt, RelDecl.get_type decl
in
let rec args_from_decl i accu = function
@@ -292,7 +267,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
(fun (_,pat) acc ->
match pat with
| IntroNaming (IntroIdentifier id) -> id::acc
- | _ -> anomaly (Pp.str "Not an identifier")
+ | _ -> anomaly (Pp.str "Not an identifier.")
)
(List.nth intro_pats (pred i))
[]
@@ -401,7 +376,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
Array.map
(fun ((_,(ctxt,concl))) ->
match ctxt with
- | [] | [_] | [_;_] -> anomaly (Pp.str "bad context")
+ | [] | [_] | [_;_] -> anomaly (Pp.str "bad context.")
| hres::res::decl::ctxt ->
let res = EConstr.it_mkLambda_or_LetIn
(EConstr.it_mkProd_or_LetIn concl [hres;res])
@@ -421,7 +396,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
let params_bindings,avoid =
List.fold_left2
(fun (bindings,avoid) decl p ->
- let id = Namegen.next_ident_away (Nameops.out_name (RelDecl.get_name decl)) avoid in
+ let id = Namegen.next_ident_away (Nameops.Name.get_id (RelDecl.get_name decl)) avoid in
p::bindings,id::avoid
)
([],pf_ids_of_hyps g)
@@ -431,7 +406,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
let lemmas_bindings =
List.rev (fst (List.fold_left2
(fun (bindings,avoid) decl p ->
- let id = Namegen.next_ident_away (Nameops.out_name (RelDecl.get_name decl)) avoid in
+ let id = Namegen.next_ident_away (Nameops.Name.get_id (RelDecl.get_name decl)) avoid in
(nf_zeta p)::bindings,id::avoid)
([],avoid)
princ_infos.predicates
@@ -708,7 +683,7 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : tactic =
then
let eq_lemma =
try Option.get (infos).equation_lemma
- with Option.IsNone -> anomaly (Pp.str "Cannot find equation lemma")
+ with Option.IsNone -> anomaly (Pp.str "Cannot find equation lemma.")
in
tclTHENSEQ[
tclMAP (fun id -> Proofview.V82.of_tactic (Simple.intro id)) ids;
@@ -938,7 +913,7 @@ let revert_graph kn post_tac hid g =
let info =
try find_Function_of_graph ind'
with Not_found -> (* The graphs are mutually recursive but we cannot find one of them !*)
- anomaly (Pp.str "Cannot retrieve infos about a mutual block")
+ anomaly (Pp.str "Cannot retrieve infos about a mutual block.")
in
(* if we can find a completeness lemma for this function
then we can come back to the functional form. If not, we do nothing