diff options
author | Hugo Herbelin <Hugo.Herbelin@inria.fr> | 2018-03-24 13:19:13 +0100 |
---|---|---|
committer | Hugo Herbelin <Hugo.Herbelin@inria.fr> | 2018-03-24 13:31:36 +0100 |
commit | 7fd28dc95e3251a10617ddb6758cc00b8960f954 (patch) | |
tree | 020e1faa27fb091ed10c1576b1cb853b9d4cf3c9 /engine | |
parent | e128900aee63c972d7977fd47e3fd21649b63409 (diff) |
Slightly refining some error messages about unresolvable evars.
For instance, error in "Goal forall a f, f a = 0" is now located.
Diffstat (limited to 'engine')
-rw-r--r-- | engine/evarutil.ml | 6 | ||||
-rw-r--r-- | engine/evarutil.mli | 2 | ||||
-rw-r--r-- | engine/termops.ml | 8 |
3 files changed, 10 insertions, 6 deletions
diff --git a/engine/evarutil.ml b/engine/evarutil.ml index 9cf81ecce..45760c6b4 100644 --- a/engine/evarutil.ml +++ b/engine/evarutil.ml @@ -807,11 +807,11 @@ let judge_of_new_Type evd = let (evd', s) = new_univ_variable univ_rigid evd in (evd', { uj_val = mkSort (Type s); uj_type = mkSort (Type (Univ.super s)) }) -let subterm_source evk (loc,k) = +let subterm_source evk ?where (loc,k) = let evk = match k with - | Evar_kinds.SubEvar (evk) -> evk + | Evar_kinds.SubEvar (None,evk) when where = None -> evk | _ -> evk in - (loc,Evar_kinds.SubEvar evk) + (loc,Evar_kinds.SubEvar (where,evk)) (* Add equality constraints for covariant/invariant positions. For irrelevant positions, unify universes when flexible. *) diff --git a/engine/evarutil.mli b/engine/evarutil.mli index e289ca169..972b0b9e1 100644 --- a/engine/evarutil.mli +++ b/engine/evarutil.mli @@ -254,7 +254,7 @@ val evd_comb0 : (evar_map -> evar_map * 'a) -> evar_map ref -> 'a val evd_comb1 : (evar_map -> 'b -> evar_map * 'a) -> evar_map ref -> 'b -> 'a val evd_comb2 : (evar_map -> 'b -> 'c -> evar_map * 'a) -> evar_map ref -> 'b -> 'c -> 'a -val subterm_source : Evar.t -> Evar_kinds.t Loc.located -> +val subterm_source : Evar.t -> ?where:Evar_kinds.subevar_kind -> Evar_kinds.t Loc.located -> Evar_kinds.t Loc.located val meta_counter_summary_tag : int Summary.Dyn.tag diff --git a/engine/termops.ml b/engine/termops.ml index 3dfb0c34f..b7531f6fc 100644 --- a/engine/termops.ml +++ b/engine/termops.ml @@ -206,8 +206,12 @@ let pr_evar_source = function | Evar_kinds.ImpossibleCase -> str "type of impossible pattern-matching clause" | Evar_kinds.MatchingVar _ -> str "matching variable" | Evar_kinds.VarInstance id -> str "instance of " ++ Id.print id - | Evar_kinds.SubEvar evk -> - str "subterm of " ++ Evar.print evk + | Evar_kinds.SubEvar (where,evk) -> + (match where with + | None -> str "subterm of " + | Some Evar_kinds.Body -> str "body of " + | Some Evar_kinds.Domain -> str "domain of " + | Some Evar_kinds.Codomain -> str "codomain of ") ++ Evar.print evk let pr_evar_info evi = let open Evd in |