aboutsummaryrefslogtreecommitdiff
path: root/engine
diff options
context:
space:
mode:
authorGaëtan Gilbert2018-10-10 13:27:27 +0200
committerGaëtan Gilbert2018-10-16 15:52:52 +0200
commit5993c266300cca1c7ca6e8b2b8e3f77f745ca9f9 (patch)
tree3b304d51b3f1ae62441d0d63fc4245750508cc3a /engine
parent72de7e057505c45cdbf75234a9ea90465d0e19ec (diff)
Simplify vars_of_global usage
Diffstat (limited to 'engine')
-rw-r--r--engine/eConstr.ml7
-rw-r--r--engine/eConstr.mli2
-rw-r--r--engine/evarutil.ml2
-rw-r--r--engine/termops.ml19
-rw-r--r--engine/termops.mli2
5 files changed, 19 insertions, 13 deletions
diff --git a/engine/eConstr.ml b/engine/eConstr.ml
index 8ab3ce821e..cefffb315e 100644
--- a/engine/eConstr.ml
+++ b/engine/eConstr.ml
@@ -166,6 +166,13 @@ let destProj sigma c = match kind sigma c with
| Proj (p, c) -> (p, c)
| _ -> raise DestKO
+let destRef sigma c = let open GlobRef in match kind sigma c with
+ | Var x -> VarRef x, EInstance.empty
+ | Const (c,u) -> ConstRef c, u
+ | Ind (ind,u) -> IndRef ind, u
+ | Construct (c,u) -> ConstructRef c, u
+ | _ -> raise DestKO
+
let decompose_app sigma c =
match kind sigma c with
| App (f,cl) -> (f, Array.to_list cl)
diff --git a/engine/eConstr.mli b/engine/eConstr.mli
index f897448557..e27eecc24f 100644
--- a/engine/eConstr.mli
+++ b/engine/eConstr.mli
@@ -180,6 +180,8 @@ val destProj : Evd.evar_map -> t -> Projection.t * t
val destFix : Evd.evar_map -> t -> (t, t) pfixpoint
val destCoFix : Evd.evar_map -> t -> (t, t) pcofixpoint
+val destRef : Evd.evar_map -> t -> GlobRef.t * EInstance.t
+
val decompose_app : Evd.evar_map -> t -> t * t list
(** Pops lambda abstractions until there are no more, skipping casts. *)
diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index 13356627f0..f9d9ce3569 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -549,7 +549,7 @@ let rec check_and_clear_in_constr env evdref err ids global c =
if Id.Set.mem id' ids then
raise (ClearDependencyError (id',err,Some (Globnames.global_of_constr c)))
in
- Id.Set.iter check (Environ.vars_of_global env c)
+ Id.Set.iter check (Environ.vars_of_global env (fst @@ destRef c))
in
c
diff --git a/engine/termops.ml b/engine/termops.ml
index 1244074d50..ee0c3d210e 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -912,9 +912,9 @@ let occur_in_global env id constr =
let occur_var env sigma id c =
let rec occur_rec c =
- match EConstr.kind sigma c with
- | Var _ | Const _ | Ind _ | Construct _ -> occur_in_global env id (EConstr.to_constr sigma c)
- | _ -> EConstr.iter sigma occur_rec c
+ match EConstr.destRef sigma c with
+ | gr, _ -> occur_in_global env id gr
+ | exception DestKO -> EConstr.iter sigma occur_rec c
in
try occur_rec c; false with Occur -> true
@@ -961,9 +961,7 @@ let collect_vars sigma c =
| _ -> EConstr.fold sigma aux vars c in
aux Id.Set.empty c
-let vars_of_global_reference env gr =
- let c, _ = Global.constr_of_global_in_context env gr in
- vars_of_global env c
+let vars_of_global_reference = vars_of_global
(* Tests whether [m] is a subterm of [t]:
[m] is appropriately lifted through abstractions of [t] *)
@@ -1458,12 +1456,9 @@ let clear_named_body id env =
let global_vars_set env sigma constr =
let rec filtrec acc c =
- let acc = match EConstr.kind sigma c with
- | Var _ | Const _ | Ind _ | Construct _ ->
- Id.Set.union (vars_of_global env (EConstr.to_constr sigma c)) acc
- | _ -> acc
- in
- EConstr.fold sigma filtrec acc c
+ match EConstr.destRef sigma c with
+ | gr, _ -> Id.Set.union (vars_of_global env gr) acc
+ | exception DestKO -> EConstr.fold sigma filtrec acc c
in
filtrec Id.Set.empty constr
diff --git a/engine/termops.mli b/engine/termops.mli
index 64e3977d68..f7b9469ae8 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -118,7 +118,9 @@ val dependent_in_decl : Evd.evar_map -> constr -> named_declaration -> bool
val count_occurrences : Evd.evar_map -> constr -> constr -> int
val collect_metas : Evd.evar_map -> constr -> int list
val collect_vars : Evd.evar_map -> constr -> Id.Set.t (** for visible vars only *)
+
val vars_of_global_reference : env -> GlobRef.t -> Id.Set.t
+[@@ocaml.deprecated "Use [Environ.vars_of_global]"]
(* Substitution of metavariables *)
type meta_value_map = (metavariable * Constr.constr) list