diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/libnames.ml | 12 | ||||
| -rw-r--r-- | library/library.ml | 42 | ||||
| -rw-r--r-- | library/library.mli | 3 |
3 files changed, 19 insertions, 38 deletions
diff --git a/library/libnames.ml b/library/libnames.ml index bf02efb03..b7b36afb3 100644 --- a/library/libnames.ml +++ b/library/libnames.ml @@ -123,21 +123,21 @@ let path_of_inductive env (sp,tyi) = let parse_dir s = let len = String.length s in let rec decoupe_dirs dirs n = - if n>=len then dirs else + if n = len && n > 0 then error (s ^ " is an invalid path."); + if n >= len then dirs else let pos = try String.index_from s n '.' with Not_found -> len in + if pos = n then error (s ^ " is an invalid path."); let dir = String.sub s n (pos-n) in - decoupe_dirs ((id_of_string dir)::dirs) (pos+1) + decoupe_dirs ((id_of_string dir)::dirs) (pos+1) in decoupe_dirs [] 0 -let dirpath_of_string s = - match parse_dir s with - [] -> invalid_arg "dirpath_of_string" - | dir -> make_dirpath dir +let dirpath_of_string s = + make_dirpath (if s = "" then [] else parse_dir s) module Dirset = Set.Make(struct type t = dir_path let compare = compare end) module Dirmap = Map.Make(struct type t = dir_path let compare = compare end) diff --git a/library/library.ml b/library/library.ml index fd9d93eb4..ff0e62064 100644 --- a/library/library.ml +++ b/library/library.ml @@ -28,43 +28,15 @@ let load_paths = ref ([] : (System.physical_path * logical_path * bool) list) let get_load_paths () = List.map pi1 !load_paths -(* Hints to partially detects if two paths refer to the same repertory *) -let rec remove_path_dot p = - let curdir = Filename.concat Filename.current_dir_name "" in (* Unix: "./" *) - let n = String.length curdir in - if String.length p > n && String.sub p 0 n = curdir then - remove_path_dot (String.sub p n (String.length p - n)) - else - p - -let strip_path p = - let cwd = Filename.concat (Sys.getcwd ()) "" in (* Unix: "`pwd`/" *) - let n = String.length cwd in - if String.length p > n && String.sub p 0 n = cwd then - remove_path_dot (String.sub p n (String.length p - n)) - else - remove_path_dot p - -let canonical_path_name p = - let current = Sys.getcwd () in - try - Sys.chdir p; - let p' = Sys.getcwd () in - Sys.chdir current; - p' - with Sys_error _ -> - (* We give up to find a canonical name and just simplify it... *) - strip_path p - let find_logical_path phys_dir = - let phys_dir = canonical_path_name phys_dir in + let phys_dir = System.canonical_path_name phys_dir in match List.filter (fun (p,d,_) -> p = phys_dir) !load_paths with | [_,dir,_] -> dir | [] -> Nameops.default_root_prefix | l -> anomaly ("Two logical paths are associated to "^phys_dir) let is_in_load_paths phys_dir = - let dir = canonical_path_name phys_dir in + let dir = System.canonical_path_name phys_dir in let lp = get_load_paths () in let check_p = fun p -> (String.compare dir p) == 0 in List.exists check_p lp @@ -73,13 +45,13 @@ let remove_load_path dir = load_paths := List.filter (fun (p,d,_) -> p <> dir) !load_paths let add_load_path isroot (phys_path,coq_path) = - let phys_path = canonical_path_name phys_path in + let phys_path = System.canonical_path_name phys_path in match List.filter (fun (p,d,_) -> p = phys_path) !load_paths with | [_,dir,_] -> if coq_path <> dir (* If this is not the default -I . to coqtop *) && not - (phys_path = canonical_path_name Filename.current_dir_name + (phys_path = System.canonical_path_name Filename.current_dir_name && coq_path = Nameops.default_root_prefix) then begin @@ -627,9 +599,15 @@ let import_module export (loc,qid) = (************************************************************************) (*s Initializing the compilation of a library. *) +let check_coq_overwriting p = + let l = repr_dirpath p in + if not !Flags.boot && l <> [] && string_of_id (list_last l) = "Coq" then + errorlabstrm "" (strbrk ("Name "^string_of_dirpath p^" starts with prefix \"Coq\" which is reserved for the Coq library.")) + let start_library f = let _,longf = System.find_file_in_path (get_load_paths ()) (f^".v") in let ldir0 = find_logical_path (Filename.dirname longf) in + check_coq_overwriting ldir0; let id = id_of_string (Filename.basename f) in let ldir = extend_dirpath ldir0 id in Declaremods.start_library ldir; diff --git a/library/library.mli b/library/library.mli index c6bd8fe0b..2b7ecc664 100644 --- a/library/library.mli +++ b/library/library.mli @@ -79,5 +79,8 @@ val locate_qualified_library : bool -> qualid -> library_location * dir_path * System.physical_path val try_locate_qualified_library : qualid located -> dir_path * string +(* Reserve Coq prefix for the standard library *) +val check_coq_overwriting : dir_path -> unit + (*s Statistics: display the memory use of a library. *) val mem : dir_path -> Pp.std_ppcmds |