aboutsummaryrefslogtreecommitdiff
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/declare.ml3
-rw-r--r--library/goptions.mli2
-rw-r--r--library/keys.ml28
-rw-r--r--library/libnames.ml4
-rw-r--r--library/libnames.mli2
-rw-r--r--library/library.ml46
-rw-r--r--library/library.mli3
-rw-r--r--library/loadpath.ml25
-rw-r--r--library/loadpath.mli2
-rw-r--r--library/nameops.ml4
-rw-r--r--library/nametab.ml2
11 files changed, 44 insertions, 77 deletions
diff --git a/library/declare.ml b/library/declare.ml
index 994a6557ad..c1697a434a 100644
--- a/library/declare.ml
+++ b/library/declare.ml
@@ -417,9 +417,6 @@ let assumption_message id =
(** Global universe names, in a different summary *)
-type universe_names =
- (Univ.universe_level Idmap.t * Id.t Univ.LMap.t)
-
(* Discharged or not *)
type universe_decl = polymorphic * (Id.t * Univ.universe_level) list
diff --git a/library/goptions.mli b/library/goptions.mli
index 9d87c14c50..25b5315c2a 100644
--- a/library/goptions.mli
+++ b/library/goptions.mli
@@ -133,7 +133,7 @@ val declare_stringopt_option: string option option_sig -> string option write_fu
(** {6 Special functions supposed to be used only in vernacentries.ml } *)
-module OptionMap : Map.S with type key = option_name
+module OptionMap : CSig.MapS with type key = option_name
val get_string_table :
option_name ->
diff --git a/library/keys.ml b/library/keys.ml
index 3d277476f1..e30cf67175 100644
--- a/library/keys.ml
+++ b/library/keys.ml
@@ -12,35 +12,31 @@ open Globnames
open Term
open Libobject
-type key =
+type key =
| KGlob of global_reference
- | KLam
+ | KLam
| KLet
| KProd
| KSort
- | KEvar
- | KCase
- | KFix
+ | KCase
+ | KFix
| KCoFix
- | KRel
- | KMeta
+ | KRel
module KeyOrdered = struct
type t = key
let hash gr =
match gr with
- | KGlob gr -> 10 + RefOrdered.hash gr
+ | KGlob gr -> 8 + RefOrdered.hash gr
| KLam -> 0
| KLet -> 1
| KProd -> 2
| KSort -> 3
- | KEvar -> 4
- | KCase -> 5
- | KFix -> 6
- | KCoFix -> 7
- | KRel -> 8
- | KMeta -> 9
+ | KCase -> 4
+ | KFix -> 5
+ | KCoFix -> 6
+ | KRel -> 7
let compare gr1 gr2 =
match gr1, gr2 with
@@ -62,8 +58,6 @@ module Keyset = Keymap.Set
(* Mapping structure for references to be considered equivalent *)
-type keys = Keyset.t Keymap.t
-
let keys = Summary.ref Keymap.empty ~name:"Keys_decl"
let add_kv k v m =
@@ -153,12 +147,10 @@ let pr_key pr_global = function
| KLet -> str"Let"
| KProd -> str"Product"
| KSort -> str"Sort"
- | KEvar -> str"Evar"
| KCase -> str"Case"
| KFix -> str"Fix"
| KCoFix -> str"CoFix"
| KRel -> str"Rel"
- | KMeta -> str"Meta"
let pr_keyset pr_global v =
prlist_with_sep spc (pr_key pr_global) (Keyset.elements v)
diff --git a/library/libnames.ml b/library/libnames.ml
index cdaec6a3de..36b46ca498 100644
--- a/library/libnames.ml
+++ b/library/libnames.ml
@@ -13,7 +13,7 @@ open Names
(**********************************************)
-let pr_dirpath sl = (str (DirPath.to_string sl))
+let pr_dirpath sl = str (DirPath.to_string sl)
(*s Operations on dirpaths *)
@@ -197,7 +197,7 @@ let string_of_reference = function
let pr_reference = function
| Qualid (_,qid) -> pr_qualid qid
- | Ident (_,id) -> str (Id.to_string id)
+ | Ident (_,id) -> Id.print id
let loc_of_reference = function
| Qualid (loc,qid) -> loc
diff --git a/library/libnames.mli b/library/libnames.mli
index b95c088715..c72f517532 100644
--- a/library/libnames.mli
+++ b/library/libnames.mli
@@ -60,7 +60,7 @@ val path_of_string : string -> full_path
val string_of_path : full_path -> string
val pr_path : full_path -> std_ppcmds
-module Spmap : Map.S with type key = full_path
+module Spmap : CSig.MapS with type key = full_path
val restrict_path : int -> full_path -> full_path
diff --git a/library/library.ml b/library/library.ml
index 024ac9e6fa..db95213fe9 100644
--- a/library/library.ml
+++ b/library/library.ml
@@ -132,7 +132,7 @@ let try_find_library dir =
try find_library dir
with Not_found ->
errorlabstrm "Library.find_library"
- (str "Unknown library " ++ str (DirPath.to_string dir))
+ (str "Unknown library " ++ pr_dirpath dir)
let register_library_filename dir f =
(* Not synchronized: overwrite the previous binding if one existed *)
@@ -286,28 +286,18 @@ let locate_absolute_library dir =
with Not_found -> [] in
match find ".vo" @ find ".vio" with
| [] -> raise LibNotFound
- | [file] -> dir, file
+ | [file] -> file
| [vo;vi] when Unix.((stat vo).st_mtime < (stat vi).st_mtime) ->
msg_warning (str"Loading " ++ str vi ++ str " instead of " ++
str vo ++ str " because it is more recent");
- dir, vi
- | [vo;vi] -> dir, vo
+ vi
+ | [vo;vi] -> vo
| _ -> assert false
let locate_qualified_library ?root ?(warn = true) qid =
(* Search library in loadpath *)
let dir, base = repr_qualid qid in
- let loadpath = match root with
- | None -> Loadpath.expand_path dir
- | Some root ->
- let filter path =
- if is_dirpath_prefix_of root path then
- let path = drop_dirpath_prefix root path in
- is_dirpath_suffix_of dir path
- else false
- in
- Loadpath.filter_path filter
- in
+ let loadpath = Loadpath.expand_path ?root dir in
let () = match loadpath with [] -> raise LibUnmappedDir | _ -> () in
let find ext =
try
@@ -459,7 +449,7 @@ let intern_from_file f =
module DPMap = Map.Make(DirPath)
let rec intern_library (needed, contents) (dir, f) from =
- Pp.feedback(Feedback.FileDependency (from, f));
+ Pp.feedback(Feedback.FileDependency (from, DirPath.to_string dir));
(* Look if in the current logical environment *)
try (find_library dir).libsum_digests, (needed, contents)
with Not_found ->
@@ -467,6 +457,7 @@ let rec intern_library (needed, contents) (dir, f) from =
try (DPMap.find dir contents).library_digests, (needed, contents)
with Not_found ->
(* [dir] is an absolute name which matches [f] which must be in loadpath *)
+ let f = match f with Some f -> f | None -> try_locate_absolute_library dir in
let m = intern_from_file f in
if not (DirPath.equal dir m.library_name) then
errorlabstrm "load_physical_library"
@@ -481,13 +472,13 @@ and intern_library_deps libs dir m from =
(dir :: needed, DPMap.add dir m contents )
and intern_mandatory_library caller from libs (dir,d) =
- let digest, libs = intern_library libs (try_locate_absolute_library dir) from in
+ let digest, libs = intern_library libs (dir, None) from in
if not (Safe_typing.digest_match ~actual:digest ~required:d) then
- errorlabstrm "" (str "Compiled library " ++ str (DirPath.to_string caller) ++ str ".vo makes inconsistent assumptions over library " ++ str (DirPath.to_string dir));
+ errorlabstrm "" (str "Compiled library " ++ pr_dirpath caller ++ str ".vo makes inconsistent assumptions over library " ++ pr_dirpath dir);
libs
-let rec_intern_library libs mref =
- let _, libs = intern_library libs mref None in
+let rec_intern_library libs (dir, f) =
+ let _, libs = intern_library libs (dir, Some f) None in
libs
let native_name_from_filename f =
@@ -576,7 +567,7 @@ let safe_locate_module (loc,qid) =
try Nametab.locate_module qid
with Not_found ->
user_err_loc
- (loc,"import_library", str (string_of_qualid qid) ++ str " is not a module")
+ (loc,"import_library", pr_qualid qid ++ str " is not a module")
let import_module export modl =
(* Optimization: libraries in a raw in the list are imported
@@ -601,7 +592,7 @@ let import_module export modl =
try Declaremods.import_module export mp; aux [] l
with Not_found ->
user_err_loc (loc,"import_library",
- str (string_of_qualid dir) ++ str " is not a module"))
+ pr_qualid dir ++ str " is not a module"))
| [] -> flush acc
in aux [] modl
@@ -611,9 +602,9 @@ let import_module export modl =
let check_coq_overwriting p id =
let l = DirPath.repr p in
let is_empty = match l with [] -> true | _ -> false in
- if not !Flags.boot && not is_empty && String.equal (Id.to_string (List.last l)) "Coq" then
+ if not !Flags.boot && not is_empty && Id.equal (List.last l) coq_root then
errorlabstrm ""
- (str "Cannot build module " ++ str (DirPath.to_string p) ++ str "." ++ pr_id id ++ str "." ++ spc () ++
+ (str "Cannot build module " ++ pr_dirpath p ++ str "." ++ pr_id id ++ str "." ++ spc () ++
str "it starts with prefix \"Coq\" which is reserved for the Coq library.")
(* Verifies that a string starts by a letter and do not contain
@@ -778,13 +769,6 @@ let save_library_raw f sum lib univs proofs =
System.marshal_out_segment f' ch (proofs : seg_proofs);
close_out ch
-(************************************************************************)
-(*s Display the memory use of a library. *)
-
-open Printf
-
-let mem s = Pp.mt ()
-
module StringOrd = struct type t = string let compare = String.compare end
module StringSet = Set.Make(StringOrd)
diff --git a/library/library.mli b/library/library.mli
index d5e610dd67..71aefdbd86 100644
--- a/library/library.mli
+++ b/library/library.mli
@@ -82,8 +82,5 @@ val locate_qualified_library :
*)
-(** {6 Statistics: display the memory use of a library. } *)
-val mem : DirPath.t -> Pp.std_ppcmds
-
(** {6 Native compiler. } *)
val native_name_from_filename : string -> string
diff --git a/library/loadpath.ml b/library/loadpath.ml
index 622d390a2c..f77bd1ef53 100644
--- a/library/loadpath.ml
+++ b/library/loadpath.ml
@@ -84,10 +84,6 @@ let add_load_path phys_path coq_path ~implicit =
end
| _ -> anomaly_too_many_paths phys_path
-let extend_path_with_dirpath p dir =
- List.fold_left Filename.concat p
- (List.rev_map Id.to_string (DirPath.repr dir))
-
let filter_path f =
let rec aux = function
| [] -> []
@@ -97,18 +93,19 @@ let filter_path f =
in
aux !load_paths
-let expand_path dir =
+let expand_path ?root dir =
let rec aux = function
| [] -> []
- | { path_physical = ph; path_logical = lg; path_implicit = implicit } :: l ->
- match implicit with
- | true ->
- (** The path is implicit, so that we only want match the logical suffix *)
- if is_dirpath_suffix_of dir lg then (ph, lg) :: aux l else aux l
- | false ->
- (** Otherwise we must match exactly *)
- if DirPath.equal dir lg then (ph, lg) :: aux l else aux l
- in
+ | { path_physical = ph; path_logical = lg; path_implicit = implicit } :: l ->
+ let success =
+ match root with
+ | None ->
+ if implicit then is_dirpath_suffix_of dir lg
+ else DirPath.equal dir lg
+ | Some root ->
+ is_dirpath_prefix_of root lg &&
+ is_dirpath_suffix_of dir (drop_dirpath_prefix root lg) in
+ if success then (ph, lg) :: aux l else aux l in
aux !load_paths
let locate_file fname =
diff --git a/library/loadpath.mli b/library/loadpath.mli
index 269e28e0b5..732f6349fb 100644
--- a/library/loadpath.mli
+++ b/library/loadpath.mli
@@ -42,7 +42,7 @@ val find_load_path : CUnix.physical_path -> t
val is_in_load_paths : CUnix.physical_path -> bool
(** Whether a physical path is currently bound. *)
-val expand_path : DirPath.t -> (CUnix.physical_path * DirPath.t) list
+val expand_path : ?root:DirPath.t -> DirPath.t -> (CUnix.physical_path * DirPath.t) list
(** Given a relative logical path, associate the list of absolute physical and
logical paths which are possible matches of it. *)
diff --git a/library/nameops.ml b/library/nameops.ml
index 3a23ab97df..418d620c25 100644
--- a/library/nameops.ml
+++ b/library/nameops.ml
@@ -12,7 +12,7 @@ open Names
(* Identifiers *)
-let pr_id id = str (Id.to_string id)
+let pr_id id = Id.print id
let pr_name = function
| Anonymous -> str "_"
@@ -141,7 +141,7 @@ let name_max na1 na2 =
| Name _ -> na1
| Anonymous -> na2
-let pr_lab l = str (Label.to_string l)
+let pr_lab l = Label.print l
let default_library = Names.DirPath.initial (* = ["Top"] *)
diff --git a/library/nametab.ml b/library/nametab.ml
index 5b6d7cd982..621640ef98 100644
--- a/library/nametab.ml
+++ b/library/nametab.ml
@@ -523,7 +523,7 @@ let shortest_qualid_of_tactic kn =
KnTab.shortest_qualid Id.Set.empty sp !the_tactictab
let pr_global_env env ref =
- try str (string_of_qualid (shortest_qualid_of_global env ref))
+ try pr_qualid (shortest_qualid_of_global env ref)
with Not_found as e ->
if !Flags.debug then Pp.msg_debug (Pp.str "pr_global_env not found"); raise e
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-03 17:09:52 +0000