diff options
| author |  Hugo Herbelin <Hugo.Herbelin@inria.fr> | 2017-08-12 14:23:11 +0200 |
|---|---|---|
| committer | Hugo Herbelin <Hugo.Herbelin@inria.fr> | 2018-02-20 10:03:03 +0100 |
| commit | 6e1f26a075a48fb32bce32e07d6b58e2f38b97a5 (patch) | |
| tree | 38babec4eba2840b916402c85df00971804918bd /interp/notation_ops.ml | |
| parent | 65505b835d6a77b8702d11d09e8cf6b84c529c65 (diff) | |
More precise explanation when a notation is not reversible for printing.
Diffstat (limited to 'interp/notation_ops.ml')
| -rw-r--r-- | interp/notation_ops.ml | 11 |
1 files changed, 7 insertions, 4 deletions
diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml index 2e3f19a37..472b9de59 100644 --- a/interp/notation_ops.ml +++ b/interp/notation_ops.ml @@ -396,7 +396,7 @@ let notation_constr_and_vars_of_glob_constr a = t, !found, !has_ltac let check_variables_and_reversibility nenv (found,foundrec,foundrecbinding) = - let injective = ref true in + let injective = ref [] in let recvars = nenv.ninterp_rec_vars in let fold _ y accu = Id.Set.add y accu in let useless_vars = Id.Map.fold fold recvars Id.Set.empty in @@ -419,7 +419,7 @@ let check_variables_and_reversibility nenv (found,foundrec,foundrecbinding) = user_err Pp.(str (Id.to_string x ^ " should not be bound in a recursive pattern of the right-hand side.")) - else injective := false + else injective := x :: !injective in let check_pair s x y where = if not (List.mem_f (pair_equal Id.equal Id.equal) (x,y) where) then @@ -440,12 +440,15 @@ let check_variables_and_reversibility nenv (found,foundrec,foundrecbinding) = end | NtnInternTypeIdent -> check_bound x in Id.Map.iter check_type vars; - !injective + List.rev !injective let notation_constr_of_glob_constr nenv a = let a, found, has_ltac = notation_constr_and_vars_of_glob_constr a in let injective = check_variables_and_reversibility nenv found in - a, not has_ltac && injective + let status = if has_ltac then HasLtac else match injective with + | [] -> APrioriReversible + | l -> NonInjective l in + a, status (**********************************************************************) (* Substitution of kernel names, avoiding a list of bound identifiers *) |