diff options
Diffstat (limited to 'library/libnames.ml')
| -rw-r--r-- | library/libnames.ml | 102 |
1 files changed, 57 insertions, 45 deletions
diff --git a/library/libnames.ml b/library/libnames.ml index dd74e192..d8473132 100644 --- a/library/libnames.ml +++ b/library/libnames.ml @@ -1,9 +1,11 @@ (************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) (* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) (************************************************************************) open Pp @@ -13,7 +15,7 @@ open Names (**********************************************) -let pr_dirpath sl = str (DirPath.to_string sl) +let pr_dirpath sl = DirPath.print sl (*s Operations on dirpaths *) @@ -58,14 +60,14 @@ let add_dirpath_suffix p id = DirPath.make (id :: DirPath.repr p) let parse_dir s = let len = String.length s in let rec decoupe_dirs dirs n = - if Int.equal n len && n > 0 then error (s ^ " is an invalid path."); + if Int.equal n len && n > 0 then user_err Pp.(str @@ 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 Int.equal pos n then error (s ^ " is an invalid path."); + if Int.equal pos n then user_err Pp.(str @@ s ^ " is an invalid path."); let dir = String.sub s n (pos-n) in decoupe_dirs ((Id.of_string dir)::dirs) (pos+1) in @@ -154,12 +156,17 @@ let qualid_of_dirpath dir = let (l,a) = split_dirpath dir in make_qualid l a -type object_name = full_path * kernel_name +type object_name = full_path * KerName.t -type object_prefix = DirPath.t * (module_path * DirPath.t) +type object_prefix = { + obj_dir : DirPath.t; + obj_mp : ModPath.t; + obj_sec : DirPath.t; +} -let make_oname (dirpath,(mp,dir)) id = - make_path dirpath id, make_kn mp dir (Label.of_id id) +(* let make_oname (dirpath,(mp,dir)) id = *) +let make_oname { obj_dir; obj_mp; obj_sec } id = + make_path obj_dir id, KerName.make obj_mp obj_sec (Label.of_id id) (* to this type are mapped DirPath.t's in the nametab *) type global_dir_reference = @@ -170,10 +177,10 @@ type global_dir_reference = | DirClosedSection of DirPath.t (* this won't last long I hope! *) -let eq_op (d1, (mp1, p1)) (d2, (mp2, p2)) = - DirPath.equal d1 d2 && - DirPath.equal p1 p2 && - mp_eq mp1 mp2 +let eq_op op1 op2 = + DirPath.equal op1.obj_dir op2.obj_dir && + DirPath.equal op1.obj_sec op2.obj_sec && + ModPath.equal op1.obj_mp op2.obj_mp let eq_global_dir_reference r1 r2 = match r1, r2 with | DirOpenModule op1, DirOpenModule op2 -> eq_op op1 op2 @@ -183,54 +190,59 @@ let eq_global_dir_reference r1 r2 = match r1, r2 with | DirClosedSection dp1, DirClosedSection dp2 -> DirPath.equal dp1 dp2 | _ -> false -type reference = - | Qualid of qualid Loc.located - | Ident of Id.t Loc.located +type reference_r = + | Qualid of qualid + | Ident of Id.t +type reference = reference_r CAst.t -let qualid_of_reference = function - | Qualid (loc,qid) -> loc, qid - | Ident (loc,id) -> loc, qualid_of_ident id +let qualid_of_reference = CAst.map (function + | Qualid qid -> qid + | Ident id -> qualid_of_ident id) -let string_of_reference = function - | Qualid (loc,qid) -> string_of_qualid qid - | Ident (loc,id) -> Id.to_string id +let string_of_reference = CAst.with_val (function + | Qualid qid -> string_of_qualid qid + | Ident id -> Id.to_string id) -let pr_reference = function - | Qualid (_,qid) -> pr_qualid qid - | Ident (_,id) -> Id.print id +let pr_reference = CAst.with_val (function + | Qualid qid -> pr_qualid qid + | Ident id -> Id.print id) -let loc_of_reference = function - | Qualid (loc,qid) -> loc - | Ident (loc,id) -> loc - -let eq_reference r1 r2 = match r1, r2 with -| Qualid (_, q1), Qualid (_, q2) -> qualid_eq q1 q2 -| Ident (_, id1), Ident (_, id2) -> Id.equal id1 id2 +let eq_reference {CAst.v=r1} {CAst.v=r2} = match r1, r2 with +| Qualid q1, Qualid q2 -> qualid_eq q1 q2 +| Ident id1, Ident id2 -> Id.equal id1 id2 | _ -> false -let join_reference ns r = +let join_reference {CAst.loc=l1;v=ns} {CAst.loc=l2;v=r} = + CAst.make ?loc:(Loc.merge_opt l1 l2) ( match ns , r with - Qualid (_, q1), Qualid (loc, q2) -> + Qualid q1, Qualid q2 -> let (dp1,id1) = repr_qualid q1 in let (dp2,id2) = repr_qualid q2 in - Qualid (loc, - make_qualid + Qualid (make_qualid (append_dirpath (append_dirpath dp1 (dirpath_of_string (Names.Id.to_string id1))) dp2) id2) - | Qualid (_, q1), Ident (loc, id2) -> + | Qualid q1, Ident id2 -> let (dp1,id1) = repr_qualid q1 in - Qualid (loc, - make_qualid + Qualid (make_qualid (append_dirpath dp1 (dirpath_of_string (Names.Id.to_string id1))) id2) - | Ident (_, id1), Qualid (loc, q2) -> + | Ident id1, Qualid q2 -> let (dp2,id2) = repr_qualid q2 in - Qualid (loc, make_qualid + Qualid (make_qualid (append_dirpath (dirpath_of_string (Names.Id.to_string id1)) dp2) id2) - | Ident (_, id1), Ident (loc, id2) -> - Qualid (loc, make_qualid + | Ident id1, Ident id2 -> + Qualid (make_qualid (dirpath_of_string (Names.Id.to_string id1)) id2) + ) + +(* Default paths *) +let default_library = Names.DirPath.initial (* = ["Top"] *) + +(*s Roots of the space of absolute names *) +let coq_string = "Coq" +let coq_root = Id.of_string coq_string +let default_root_prefix = DirPath.empty (* Deprecated synonyms *) |