aboutsummaryrefslogtreecommitdiff
path: root/pretyping
diff options
context:
space:
mode:
Diffstat (limited to 'pretyping')
-rw-r--r--pretyping/glob_ops.ml12
-rw-r--r--pretyping/glob_ops.mli1
2 files changed, 12 insertions, 1 deletions
diff --git a/pretyping/glob_ops.ml b/pretyping/glob_ops.ml
index c9860864a9..e3b6fb08a8 100644
--- a/pretyping/glob_ops.ml
+++ b/pretyping/glob_ops.ml
@@ -266,7 +266,7 @@ let add_name_to_ids set na =
| Anonymous -> set
| Name id -> Id.Set.add id set
-let free_glob_vars =
+let free_glob_vars =
let rec vars bounded vs = function
| GVar (loc,id') -> if Id.Set.mem id' bounded then vs else Id.Set.add id' vs
| GApp (loc,f,args) -> List.fold_left (vars bounded) vs (f::args)
@@ -324,6 +324,16 @@ let free_glob_vars =
let vs = vars Id.Set.empty Id.Set.empty rt in
Id.Set.elements vs
+let glob_visible_short_qualid c =
+ let rec aux acc = function
+ | GRef (_,c,_) ->
+ let qualid = Nametab.shortest_qualid_of_global Id.Set.empty c in
+ let dir,id = Libnames.repr_qualid qualid in
+ if DirPath.is_empty dir then id :: acc else acc
+ | c ->
+ fold_glob_constr aux acc c
+ in aux [] c
+
let add_and_check_ident id set =
if Id.Set.mem id set then
Pp.(msg_warning
diff --git a/pretyping/glob_ops.mli b/pretyping/glob_ops.mli
index 45444234a3..e0a2de0326 100644
--- a/pretyping/glob_ops.mli
+++ b/pretyping/glob_ops.mli
@@ -40,6 +40,7 @@ val occur_glob_constr : Id.t -> glob_constr -> bool
val free_glob_vars : glob_constr -> Id.t list
val bound_glob_vars : glob_constr -> Id.Set.t
val loc_of_glob_constr : glob_constr -> Loc.t
+val glob_visible_short_qualid : glob_constr -> Id.t list
(** [map_pattern_binders f m c] applies [f] to all the binding names
in a pattern-matching expression ({!Glob_term.GCases}) represented