aboutsummaryrefslogtreecommitdiffhomepage
path: root/plugins
diff options
context:
space:
mode:
authorGravatar Gaetan Gilbert <gaetan.gilbert@ens-lyon.fr>2017-04-25 14:31:15 +0200
committerGravatar Gaetan Gilbert <gaetan.gilbert@ens-lyon.fr>2017-04-27 21:42:01 +0200
commit87910d7be9bd50de4db80f70c6e287c7c7994460 (patch)
treeff0c9daa7ff73f0eb19e8b62ea6f689b154f314b /plugins
parent5eb09af1e3686d6ac518b9eafe7cfcebd2b16375 (diff)
Fix 4.04 warnings
Diffstat (limited to 'plugins')
-rw-r--r--plugins/firstorder/g_ground.ml41
-rw-r--r--plugins/funind/functional_principles_proofs.ml5
-rw-r--r--plugins/funind/indfun_common.ml9
-rw-r--r--plugins/funind/invfun.ml10
-rw-r--r--plugins/funind/recdef.ml5
-rw-r--r--plugins/ltac/rewrite.ml2
-rw-r--r--plugins/ltac/tauto.ml1
-rw-r--r--plugins/omega/omega.ml10
8 files changed, 21 insertions, 22 deletions
diff --git a/plugins/firstorder/g_ground.ml4 b/plugins/firstorder/g_ground.ml4
index 8ef6a09d0..b25017535 100644
--- a/plugins/firstorder/g_ground.ml4
+++ b/plugins/firstorder/g_ground.ml4
@@ -123,7 +123,6 @@ let normalize_evaluables=
unfold_in_hyp (Lazy.force defined_connectives)
(Tacexpr.InHypType id)) *)
-open Pp
open Genarg
open Ppconstr
open Printer
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index df81bc78c..55d361e3d 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -229,12 +229,13 @@ let nf_betaiotazeta = (* Reductionops.local_strong Reductionops.whd_betaiotazeta
Reductionops.clos_norm_flags CClosure.betaiotazeta Environ.empty_env Evd.empty
+exception NoChange
let change_eq env sigma hyp_id (context:rel_context) x t end_of_type =
let nochange ?t' msg =
begin
observe (str ("Not treating ( "^msg^" )") ++ pr_leconstr t ++ str " " ++ match t' with None -> str "" | Some t -> Printer.pr_leconstr t );
- failwith "NoChange";
+ raise NoChange;
end
in
let eq_constr c1 c2 = Evarconv.e_conv env (ref sigma) c1 c2 in
@@ -536,7 +537,7 @@ let clean_hyp_with_heq ptes_infos eq_hyps hyp_id env sigma =
tclTHEN
tac
(scan_type new_context new_t')
- with Failure "NoChange" ->
+ with NoChange ->
(* Last thing todo : push the rel in the context and continue *)
scan_type (LocalAssum (x,t_x) :: context) t'
end
diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml
index c6f5c2745..848b44a60 100644
--- a/plugins/funind/indfun_common.ml
+++ b/plugins/funind/indfun_common.ml
@@ -21,12 +21,9 @@ let get_name avoid ?(default="H") = function
| Name n -> Name n
let array_get_start a =
- try
- Array.init
- (Array.length a - 1)
- (fun i -> a.(i))
- with Invalid_argument "index out of bounds" ->
- invalid_arg "array_get_start"
+ Array.init
+ (Array.length a - 1)
+ (fun i -> a.(i))
let id_of_name = function
Name id -> id
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index 29472cdef..6c0c28905 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -1025,7 +1025,7 @@ let invfun qhyp f =
| Not_found -> error "No graph found"
| Option.IsNone -> error "Cannot use equivalence with graph!"
-
+exception NoFunction
let invfun qhyp f g =
match f with
| Some f -> invfun qhyp f g
@@ -1040,23 +1040,23 @@ let invfun qhyp f g =
begin
let f1,_ = decompose_app sigma args.(1) in
try
- if not (isConst sigma f1) then failwith "";
+ if not (isConst sigma f1) then raise NoFunction;
let finfos = find_Function_infos (fst (destConst sigma f1)) in
let f_correct = mkConst(Option.get finfos.correctness_lemma)
and kn = fst finfos.graph_ind
in
functional_inversion kn hid f1 f_correct g
- with | Failure "" | Option.IsNone | Not_found ->
+ with | NoFunction | Option.IsNone | Not_found ->
try
let f2,_ = decompose_app sigma args.(2) in
- if not (isConst sigma f2) then failwith "";
+ if not (isConst sigma f2) then raise NoFunction;
let finfos = find_Function_infos (fst (destConst sigma f2)) in
let f_correct = mkConst(Option.get finfos.correctness_lemma)
and kn = fst finfos.graph_ind
in
functional_inversion kn hid f2 f_correct g
with
- | Failure "" ->
+ | NoFunction ->
user_err (str "Hypothesis " ++ Ppconstr.pr_id hid ++ str " must contain at least one Function")
| Option.IsNone ->
if do_observe ()
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index 1e405d2c9..bd30f1159 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -1225,6 +1225,7 @@ let get_current_subgoals_types () =
let { Evd.it=sgs ; sigma=sigma } = Proof.V82.subgoals p in
sigma, List.map (Goal.V82.abstract_type sigma) sgs
+exception EmptySubgoals
let build_and_l sigma l =
let and_constr = Coqlib.build_coq_and () in
let conj_constr = coq_conj () in
@@ -1246,7 +1247,7 @@ let build_and_l sigma l =
in
let l = List.sort compare l in
let rec f = function
- | [] -> failwith "empty list of subgoals!"
+ | [] -> raise EmptySubgoals
| [p] -> p,tclIDTAC,1
| p1::pl ->
let c,tac,nb = f pl in
@@ -1432,7 +1433,7 @@ let com_terminate
using_lemmas tcc_lemma_ref
(Some tcc_lemma_name)
(new_goal_type);
- with Failure "empty list of subgoals!" ->
+ with EmptySubgoals ->
(* a non recursive function declared with measure ! *)
tcc_lemma_ref := Not_needed;
defined ()
diff --git a/plugins/ltac/rewrite.ml b/plugins/ltac/rewrite.ml
index 12a1566e2..9a1615d3f 100644
--- a/plugins/ltac/rewrite.ml
+++ b/plugins/ltac/rewrite.ml
@@ -39,7 +39,7 @@ open Proofview.Notations
open Context.Named.Declaration
module NamedDecl = Context.Named.Declaration
-module RelDecl = Context.Rel.Declaration
+(* module RelDecl = Context.Rel.Declaration *)
(** Typeclass-based generalized rewriting. *)
diff --git a/plugins/ltac/tauto.ml b/plugins/ltac/tauto.ml
index e86d1c728..4de2081cf 100644
--- a/plugins/ltac/tauto.ml
+++ b/plugins/ltac/tauto.ml
@@ -10,7 +10,6 @@ open Term
open EConstr
open Hipattern
open Names
-open Pp
open Geninterp
open Misctypes
open Tacexpr
diff --git a/plugins/omega/omega.ml b/plugins/omega/omega.ml
index bd991a955..334b03de1 100644
--- a/plugins/omega/omega.ml
+++ b/plugins/omega/omega.ml
@@ -330,11 +330,13 @@ let omega_mod a b = a - b * floor_div (two * a + b) (two * b)
let banerjee_step (new_eq_id,new_var_id,print_var) original l1 l2 =
let e = original.body in
let sigma = new_var_id () in
+ if e == [] then begin
+ display_system print_var [original] ; failwith "TL"
+ end;
let smallest,var =
- try
- List.fold_left (fun (v,p) c -> if v >? (abs c.c) then abs c.c,c.v else (v,p))
- (abs (List.hd e).c, (List.hd e).v) (List.tl e)
- with Failure "tl" -> display_system print_var [original] ; failwith "TL" in
+ List.fold_left (fun (v,p) c -> if v >? (abs c.c) then abs c.c,c.v else (v,p))
+ (abs (List.hd e).c, (List.hd e).v) (List.tl e)
+ in
let m = smallest + one in
let new_eq =
{ constant = omega_mod original.constant m;