aboutsummaryrefslogtreecommitdiffhomepage
path: root/plugins
diff options
context:
space:
mode:
authorGravatar Emilio Jesus Gallego Arias <e+git@x80.org>2016-08-19 01:58:04 +0200
committerGravatar Emilio Jesus Gallego Arias <e+git@x80.org>2016-08-19 02:01:56 +0200
commit543ee0c7ad43874c577416af9f2e5a94d7d1e4d3 (patch)
treecaf22d0e607ed9e0bf9ba64d76b4c2aebce63d5a /plugins
parentde038270f72214b169d056642eb7144a79e6f126 (diff)
Remove errorlabstrm in favor of user_err
As noted by @ppedrot, the first is redundant. The patch is basically a renaming. We didn't make the component optional yet, but this could happen in a future patch.
Diffstat (limited to 'plugins')
-rw-r--r--plugins/cc/cctac.ml2
-rw-r--r--plugins/decl_mode/decl_interp.ml4
-rw-r--r--plugins/decl_mode/decl_proof_instr.ml6
-rw-r--r--plugins/extraction/table.ml2
-rw-r--r--plugins/funind/functional_principles_types.ml4
-rw-r--r--plugins/funind/glob_term_to_relation.ml4
-rw-r--r--plugins/funind/indfun.ml6
-rw-r--r--plugins/funind/indfun_common.ml2
-rw-r--r--plugins/funind/invfun.ml8
-rw-r--r--plugins/funind/merge.ml2
-rw-r--r--plugins/funind/recdef.ml10
-rw-r--r--plugins/rtauto/refl_tauto.ml4
-rw-r--r--plugins/setoid_ring/newring.ml10
-rw-r--r--plugins/ssrmatching/ssrmatching.ml42
14 files changed, 33 insertions, 33 deletions
diff --git a/plugins/cc/cctac.ml b/plugins/cc/cctac.ml
index fd46d8069..6ed678176 100644
--- a/plugins/cc/cctac.ml
+++ b/plugins/cc/cctac.ml
@@ -456,7 +456,7 @@ let cc_tactic depth additionnal_terms =
end }
let cc_fail gls =
- errorlabstrm "Congruence" (Pp.str "congruence failed.")
+ user_err "Congruence" (Pp.str "congruence failed.")
let congruence_tac depth l =
Tacticals.New.tclORELSE
diff --git a/plugins/decl_mode/decl_interp.ml b/plugins/decl_mode/decl_interp.ml
index 49843d828..9ed5c61e2 100644
--- a/plugins/decl_mode/decl_interp.ml
+++ b/plugins/decl_mode/decl_interp.ml
@@ -328,7 +328,7 @@ let interp_cases info env sigma params (pat:cases_pattern_expr) hyps =
let _ =
let expected = mib.Declarations.mind_nparams - num_params in
if not (Int.equal (List.length params) expected) then
- errorlabstrm "suppose it is"
+ user_err "suppose it is"
(str "Wrong number of extra arguments: " ++
(if Int.equal expected 0 then str "none" else int expected) ++ spc () ++
str "expected.") in
@@ -348,7 +348,7 @@ let interp_cases info env sigma params (pat:cases_pattern_expr) hyps =
Thesis (Plain) -> Glob_term.GSort(Loc.ghost,GProp)
| Thesis (For rec_occ) ->
if not (Id.List.mem rec_occ pat_vars) then
- errorlabstrm "suppose it is"
+ user_err "suppose it is"
(str "Variable " ++ Nameops.pr_id rec_occ ++
str " does not occur in pattern.");
Glob_term.GSort(Loc.ghost,GProp)
diff --git a/plugins/decl_mode/decl_proof_instr.ml b/plugins/decl_mode/decl_proof_instr.ml
index 97c9d5f4a..9510ba384 100644
--- a/plugins/decl_mode/decl_proof_instr.ml
+++ b/plugins/decl_mode/decl_proof_instr.ml
@@ -43,7 +43,7 @@ let clear ids { it = goal; sigma } =
let (hyps, concl) =
try Evarutil.clear_hyps_in_evi env evdref sign cl ids
with Evarutil.ClearDependencyError (id, _) ->
- errorlabstrm "" (str "Cannot clear " ++ pr_id id)
+ user_err "" (str "Cannot clear " ++ pr_id id)
in
let sigma = !evdref in
let (gl,ev,sigma) = Goal.V82.mk_goal sigma hyps concl (Goal.V82.extra sigma goal) in
@@ -1082,12 +1082,12 @@ let thesis_for obj typ per_info env=
let cind,all_args=decompose_app typ in
let ind,u = destInd cind in
let _ = if not (eq_ind ind per_info.per_ind) then
- errorlabstrm "thesis_for"
+ user_err "thesis_for"
((Printer.pr_constr_env env Evd.empty obj) ++ spc () ++
str"cannot give an induction hypothesis (wrong inductive type).") in
let params,args = List.chop per_info.per_nparams all_args in
let _ = if not (List.for_all2 eq_constr params per_info.per_params) then
- errorlabstrm "thesis_for"
+ user_err "thesis_for"
((Printer.pr_constr_env env Evd.empty obj) ++ spc () ++
str "cannot give an induction hypothesis (wrong parameters).") in
let hd2 = (applist ((lift (List.length rc) per_info.per_pred),args@[obj])) in
diff --git a/plugins/extraction/table.ml b/plugins/extraction/table.ml
index ff66d915f..3c26c4710 100644
--- a/plugins/extraction/table.ml
+++ b/plugins/extraction/table.ml
@@ -293,7 +293,7 @@ let pr_long_global ref = pr_path (Nametab.path_of_global ref)
(*S Warning and Error messages. *)
-let err s = errorlabstrm "Extraction" s
+let err s = user_err "Extraction" s
let warn_extraction_axiom_to_realize =
CWarnings.create ~name:"extraction-axiom-to-realize" ~category:"extraction"
diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml
index 5e72b8672..f4daa0323 100644
--- a/plugins/funind/functional_principles_types.ml
+++ b/plugins/funind/functional_principles_types.ml
@@ -609,7 +609,7 @@ let build_scheme fas =
try
Smartlocate.global_with_alias f
with Not_found ->
- errorlabstrm "FunInd.build_scheme"
+ user_err "FunInd.build_scheme"
(str "Cannot find " ++ Libnames.pr_reference f)
in
let evd',f = Evd.fresh_global (Global.env ()) !evd f_as_constant in
@@ -643,7 +643,7 @@ let build_case_scheme fa =
let (_,f,_) = fa in
try fst (Universes.unsafe_constr_of_global (Smartlocate.global_with_alias f))
with Not_found ->
- errorlabstrm "FunInd.build_case_scheme"
+ user_err "FunInd.build_case_scheme"
(str "Cannot find " ++ Libnames.pr_reference f) in
let first_fun,u = destConst funs in
let funs_mp,funs_dp,_ = Names.repr_con first_fun in
diff --git a/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml
index 5548833d6..9902b0128 100644
--- a/plugins/funind/glob_term_to_relation.ml
+++ b/plugins/funind/glob_term_to_relation.ml
@@ -630,7 +630,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
let (ind,_) =
try Inductiveops.find_inductive env (Evd.from_env env) b_typ
with Not_found ->
- errorlabstrm "" (str "Cannot find the inductive associated to " ++
+ user_err "" (str "Cannot find the inductive associated to " ++
Printer.pr_glob_constr b ++ str " in " ++
Printer.pr_glob_constr rt ++ str ". try again with a cast")
in
@@ -662,7 +662,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
let (ind,_) =
try Inductiveops.find_inductive env (Evd.from_env env) b_typ
with Not_found ->
- errorlabstrm "" (str "Cannot find the inductive associated to " ++
+ user_err "" (str "Cannot find the inductive associated to " ++
Printer.pr_glob_constr b ++ str " in " ++
Printer.pr_glob_constr rt ++ str ". try again with a cast")
in
diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml
index 4f183b3a1..943ebc9fc 100644
--- a/plugins/funind/indfun.ml
+++ b/plugins/funind/indfun.ml
@@ -42,7 +42,7 @@ let functional_induction with_clean c princl pat =
let finfo = (* we first try to find out a graph on f *)
try find_Function_infos c'
with Not_found ->
- errorlabstrm "" (str "Cannot find induction information on "++
+ user_err "" (str "Cannot find induction information on "++
Printer.pr_lconstr (mkConst c') )
in
match Tacticals.elimination_sort_of_goal g with
@@ -70,7 +70,7 @@ let functional_induction with_clean c princl pat =
(b,a)
(* mkConst(const_of_id princ_name ),g (\* FIXME *\) *)
with Not_found -> (* This one is neither defined ! *)
- errorlabstrm "" (str "Cannot find induction principle for "
+ user_err "" (str "Cannot find induction principle for "
++Printer.pr_lconstr (mkConst c') )
in
(princ,NoBindings, Tacmach.pf_unsafe_type_of g' princ,g')
@@ -321,7 +321,7 @@ let error_error names e =
in
match e with
| Building_graph e ->
- errorlabstrm ""
+ user_err ""
(str "Cannot define graph(s) for " ++
h 1 (prlist_with_sep (fun _ -> str","++spc ()) Ppconstr.pr_id names) ++
e_explain e)
diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml
index f56e92414..a1c94f8cb 100644
--- a/plugins/funind/indfun_common.ml
+++ b/plugins/funind/indfun_common.ml
@@ -110,7 +110,7 @@ let const_of_id id =
in
try Constrintern.locate_reference princ_ref
with Not_found ->
- CErrors.errorlabstrm "IndFun.const_of_id"
+ CErrors.user_err "IndFun.const_of_id"
(str "cannot find " ++ Nameops.pr_id id)
let def_of_const t =
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index 26fc88a60..ee1232013 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -1043,19 +1043,19 @@ let invfun qhyp f g =
functional_inversion kn hid f2 f_correct g
with
| Failure "" ->
- errorlabstrm "" (str "Hypothesis " ++ Ppconstr.pr_id hid ++ str " must contain at least one Function")
+ user_err "" (str "Hypothesis " ++ Ppconstr.pr_id hid ++ str " must contain at least one Function")
| Option.IsNone ->
if do_observe ()
then
error "Cannot use equivalence with graph for any side of the equality"
- else errorlabstrm "" (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
+ else user_err "" (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
| Not_found ->
if do_observe ()
then
error "No graph found for any side of equality"
- else errorlabstrm "" (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
+ else user_err "" (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
end
- | _ -> errorlabstrm "" (Ppconstr.pr_id hid ++ str " must be an equality ")
+ | _ -> user_err "" (Ppconstr.pr_id hid ++ str " must be an equality ")
end)
qhyp
end
diff --git a/plugins/funind/merge.ml b/plugins/funind/merge.ml
index de4210af5..0b93a909a 100644
--- a/plugins/funind/merge.ml
+++ b/plugins/funind/merge.ml
@@ -901,7 +901,7 @@ let find_Function_infos_safe (id:Id.t): Indfun_common.function_info =
locate_constant f_ref in
try find_Function_infos (kn_of_id id)
with Not_found ->
- errorlabstrm "indfun" (Nameops.pr_id id ++ str " has no functional scheme")
+ user_err "indfun" (Nameops.pr_id id ++ str " has no functional scheme")
(** [merge id1 id2 args1 args2 id] builds and declares a new inductive
type called [id], representing the merged graphs of both graphs
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index 62f307115..7745e8498 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -307,7 +307,7 @@ let check_not_nested forbidden e =
| Rel _ -> ()
| Var x ->
if Id.List.mem x forbidden
- then errorlabstrm "Recdef.check_not_nested"
+ then user_err "Recdef.check_not_nested"
(str "check_not_nested: failure " ++ pr_id x)
| Meta _ | Evar _ | Sort _ -> ()
| Cast(e,_,t) -> check_not_nested e;check_not_nested t
@@ -327,7 +327,7 @@ let check_not_nested forbidden e =
try
check_not_nested e
with UserError(_,p) ->
- errorlabstrm "_" (str "on expr : " ++ Printer.pr_lconstr e ++ str " " ++ p)
+ user_err "_" (str "on expr : " ++ Printer.pr_lconstr e ++ str " " ++ p)
(* ['a info] contains the local information for traveling *)
type 'a infos =
@@ -442,7 +442,7 @@ let rec travel_aux jinfo continuation_tac (expr_info:constr infos) =
check_not_nested (expr_info.f_id::expr_info.forbidden_ids) expr_info.info;
jinfo.otherS () expr_info continuation_tac expr_info
with e when CErrors.noncritical e ->
- errorlabstrm "Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain a recursive call to " ++ pr_id expr_info.f_id)
+ user_err "Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain a recursive call to " ++ pr_id expr_info.f_id)
end
| Lambda(n,t,b) ->
begin
@@ -450,7 +450,7 @@ let rec travel_aux jinfo continuation_tac (expr_info:constr infos) =
check_not_nested (expr_info.f_id::expr_info.forbidden_ids) expr_info.info;
jinfo.otherS () expr_info continuation_tac expr_info
with e when CErrors.noncritical e ->
- errorlabstrm "Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain a recursive call to " ++ pr_id expr_info.f_id)
+ user_err "Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain a recursive call to " ++ pr_id expr_info.f_id)
end
| Case(ci,t,a,l) ->
begin
@@ -478,7 +478,7 @@ let rec travel_aux jinfo continuation_tac (expr_info:constr infos) =
jinfo.apP (f,args) expr_info continuation_tac in
travel_args jinfo
expr_info.is_main_branch new_continuation_tac new_infos
- | Case _ -> errorlabstrm "Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain an applied match (See Limitation in Section 2.3 of refman)")
+ | Case _ -> user_err "Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain an applied match (See Limitation in Section 2.3 of refman)")
| _ -> anomaly (Pp.str "travel_aux : unexpected "++ Printer.pr_lconstr expr_info.info)
end
| Cast(t,_,_) -> travel jinfo continuation_tac {expr_info with info=t}
diff --git a/plugins/rtauto/refl_tauto.ml b/plugins/rtauto/refl_tauto.ml
index 4ed907951..9cfcb0fb7 100644
--- a/plugins/rtauto/refl_tauto.ml
+++ b/plugins/rtauto/refl_tauto.ml
@@ -263,7 +263,7 @@ let rtauto_tac gls=
let _=
if Retyping.get_sort_family_of
(pf_env gls) (Tacmach.project gls) gl != InProp
- then errorlabstrm "rtauto" (Pp.str "goal should be in Prop") in
+ then user_err "rtauto" (Pp.str "goal should be in Prop") in
let glf=make_form gamma gls gl in
let hyps=make_hyps gamma gls [gl] (pf_hyps gls) in
let formula=
@@ -282,7 +282,7 @@ let rtauto_tac gls=
let prf =
try project (search_fun (init_state [] formula))
with Not_found ->
- errorlabstrm "rtauto" (Pp.str "rtauto couldn't find any proof") in
+ user_err "rtauto" (Pp.str "rtauto couldn't find any proof") in
let search_end_time = System.get_time () in
let _ = if !verbose then
begin
diff --git a/plugins/setoid_ring/newring.ml b/plugins/setoid_ring/newring.ml
index 90f5f8e63..7450aa23e 100644
--- a/plugins/setoid_ring/newring.ml
+++ b/plugins/setoid_ring/newring.ml
@@ -79,7 +79,7 @@ let add_map s m = protect_maps := String.Map.add s m !protect_maps
let lookup_map map =
try String.Map.find map !protect_maps
with Not_found ->
- errorlabstrm"lookup_map"(str"map "++qs map++str"not found")
+ user_err"lookup_map"(str"map "++qs map++str"not found")
let protect_red map env sigma c =
kl (create_clos_infos all env)
@@ -348,13 +348,13 @@ let find_ring_structure env sigma l =
let check c =
let ty' = Retyping.get_type_of env sigma c in
if not (Reductionops.is_conv env sigma ty ty') then
- errorlabstrm "ring"
+ user_err "ring"
(str"arguments of ring_simplify do not have all the same type")
in
List.iter check cl';
(try ring_for_carrier ty
with Not_found ->
- errorlabstrm "ring"
+ user_err "ring"
(str"cannot find a declared ring structure over"++
spc()++str"\""++pr_constr ty++str"\""))
| [] -> assert false
@@ -828,13 +828,13 @@ let find_field_structure env sigma l =
let check c =
let ty' = Retyping.get_type_of env sigma c in
if not (Reductionops.is_conv env sigma ty ty') then
- errorlabstrm "field"
+ user_err "field"
(str"arguments of field_simplify do not have all the same type")
in
List.iter check cl';
(try field_for_carrier ty
with Not_found ->
- errorlabstrm "field"
+ user_err "field"
(str"cannot find a declared field structure over"++
spc()++str"\""++pr_constr ty++str"\""))
| [] -> assert false
diff --git a/plugins/ssrmatching/ssrmatching.ml4 b/plugins/ssrmatching/ssrmatching.ml4
index 536c6ff4b..199c26363 100644
--- a/plugins/ssrmatching/ssrmatching.ml4
+++ b/plugins/ssrmatching/ssrmatching.ml4
@@ -61,7 +61,7 @@ DECLARE PLUGIN "ssrmatching_plugin"
type loc = Loc.t
let dummy_loc = Loc.ghost
-let errorstrm = CErrors.errorlabstrm "ssrmatching"
+let errorstrm = CErrors.user_err "ssrmatching"
let loc_error loc msg = CErrors.user_err ~loc msg (str msg)
let ppnl = Feedback.msg_info