From 9043add656177eeac1491a73d2f3ab92bec0013c Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Sat, 29 Dec 2018 14:31:27 -0500 Subject: Imported Upstream version 8.8.2 --- library/libnames.ml | 102 +++++++++++++++++++++++++++++----------------------- 1 file changed, 57 insertions(+), 45 deletions(-) (limited to 'library/libnames.ml') 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 *) -(* 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 *) -- cgit v1.2.3