diff options
Diffstat (limited to 'engine')
| -rw-r--r-- | engine/eConstr.ml | 18 | ||||
| -rw-r--r-- | engine/ftactic.ml | 2 | ||||
| -rw-r--r-- | engine/ftactic.mli | 2 | ||||
| -rw-r--r-- | engine/proofview.mli | 2 | ||||
| -rw-r--r-- | engine/termops.ml | 2 | ||||
| -rw-r--r-- | engine/termops.mli | 8 |
6 files changed, 30 insertions, 4 deletions
diff --git a/engine/eConstr.ml b/engine/eConstr.ml index 2913645c1c..678f7c6ce6 100644 --- a/engine/eConstr.ml +++ b/engine/eConstr.ml @@ -445,10 +445,22 @@ let fold sigma f acc c = match kind sigma c with let compare_gen k eq_inst eq_sort eq_constr nargs c1 c2 = (c1 == c2) || Constr.compare_head_gen_with k k eq_inst eq_sort eq_constr nargs c1 c2 +let eq_einstance sigma i1 i2 = + let i1 = EInstance.kind sigma (EInstance.make i1) in + let i2 = EInstance.kind sigma (EInstance.make i2) in + Univ.Instance.equal i1 i2 + +let eq_esorts sigma s1 s2 = + let s1 = ESorts.kind sigma (ESorts.make s1) in + let s2 = ESorts.kind sigma (ESorts.make s2) in + Sorts.equal s1 s2 + let eq_constr sigma c1 c2 = let kind c = kind_upto sigma c in + let eq_inst _ _ i1 i2 = eq_einstance sigma i1 i2 in + let eq_sorts s1 s2 = eq_esorts sigma s1 s2 in let rec eq_constr nargs c1 c2 = - compare_gen kind (fun _ _ -> Univ.Instance.equal) Sorts.equal eq_constr nargs c1 c2 + compare_gen kind eq_inst eq_sorts eq_constr nargs c1 c2 in eq_constr 0 (unsafe_to_constr c1) (unsafe_to_constr c2) @@ -461,8 +473,10 @@ let eq_constr_nounivs sigma c1 c2 = let compare_constr sigma cmp c1 c2 = let kind c = kind_upto sigma c in + let eq_inst _ _ i1 i2 = eq_einstance sigma i1 i2 in + let eq_sorts s1 s2 = eq_esorts sigma s1 s2 in let cmp nargs c1 c2 = cmp (of_constr c1) (of_constr c2) in - compare_gen kind (fun _ _ -> Univ.Instance.equal) Sorts.equal cmp 0 (unsafe_to_constr c1) (unsafe_to_constr c2) + compare_gen kind eq_inst eq_sorts cmp 0 (unsafe_to_constr c1) (unsafe_to_constr c2) let compare_cumulative_instances cv_pb nargs_ok variances u u' cstrs = let open UnivProblem in diff --git a/engine/ftactic.ml b/engine/ftactic.ml index e23a03c0c7..b371884ba4 100644 --- a/engine/ftactic.ml +++ b/engine/ftactic.ml @@ -61,7 +61,7 @@ let nf_enter f = (fun gl -> gl >>= fun gl -> Proofview.Goal.normalize gl >>= fun nfgl -> - Proofview.V82.wrap_exceptions (fun () -> f nfgl)) + Proofview.V82.wrap_exceptions (fun () -> f nfgl)) [@warning "-3"] let enter f = bind goals diff --git a/engine/ftactic.mli b/engine/ftactic.mli index 6c389b2d67..3c4fa6f4e8 100644 --- a/engine/ftactic.mli +++ b/engine/ftactic.mli @@ -42,6 +42,8 @@ val run : 'a t -> ('a -> unit Proofview.tactic) -> unit Proofview.tactic (** {5 Focussing} *) val nf_enter : (Proofview.Goal.t -> 'a t) -> 'a t +[@@ocaml.deprecated "Normalization is enforced by EConstr, please use [enter]"] + (** Enter a goal. The resulting tactic is focussed. *) val enter : (Proofview.Goal.t -> 'a t) -> 'a t diff --git a/engine/proofview.mli b/engine/proofview.mli index a9666e4f90..0bb3229a9b 100644 --- a/engine/proofview.mli +++ b/engine/proofview.mli @@ -497,6 +497,7 @@ module Goal : sig (** Normalises the argument goal. *) val normalize : t -> t tactic + [@@ocaml.deprecated "Normalization is enforced by EConstr, [normalize] is not needed anymore"] (** [concl], [hyps], [env] and [sigma] given a goal [gl] return respectively the conclusion of [gl], the hypotheses of [gl], the @@ -514,6 +515,7 @@ module Goal : sig the current goal is also given as an argument to [t]. The goal is normalised with respect to evars. *) val nf_enter : (t -> unit tactic) -> unit tactic + [@@ocaml.deprecated "Normalization is enforced by EConstr, please use [enter]"] (** Like {!nf_enter}, but does not normalize the goal beforehand. *) val enter : (t -> unit tactic) -> unit tactic diff --git a/engine/termops.ml b/engine/termops.ml index 156d1370e3..710743e92d 100644 --- a/engine/termops.ml +++ b/engine/termops.ml @@ -49,6 +49,8 @@ let pr_puniverses p u = if Univ.Instance.is_empty u then p else p ++ str"(*" ++ Univ.Instance.pr UnivNames.pr_with_global_universes u ++ str"*)" +(* Minimalistic constr printer, typically for debugging *) + let rec pr_constr c = match kind c with | Rel n -> str "#"++int n | Meta n -> str "Meta(" ++ int n ++ str ")" diff --git a/engine/termops.mli b/engine/termops.mli index b967bb6abb..9ce2db9234 100644 --- a/engine/termops.mli +++ b/engine/termops.mli @@ -311,11 +311,17 @@ val pr_metaset : Metaset.t -> Pp.t val pr_evar_universe_context : UState.t -> Pp.t val pr_evd_level : evar_map -> Univ.Level.t -> Pp.t -(** debug printer: do not use to display terms to the casual user... *) +(** Internal hook to register user-level printer *) val set_print_constr : (env -> Evd.evar_map -> constr -> Pp.t) -> unit + +(** User-level printers *) + val print_constr : constr -> Pp.t val print_constr_env : env -> Evd.evar_map -> constr -> Pp.t + +(** debug printer: do not use to display terms to the casual user... *) + val print_named_context : env -> Pp.t val pr_rel_decl : env -> Constr.rel_declaration -> Pp.t val print_rel_context : env -> Pp.t |