summaryrefslogtreecommitdiff
path: root/interp/dumpglob.ml
diff options
context:
space:
mode:
Diffstat (limited to 'interp/dumpglob.ml')
-rw-r--r--interp/dumpglob.ml97
1 files changed, 51 insertions, 46 deletions
diff --git a/interp/dumpglob.ml b/interp/dumpglob.ml
index b020f894..bc6a1ef3 100644
--- a/interp/dumpglob.ml
+++ b/interp/dumpglob.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 Util
@@ -68,11 +70,12 @@ let pause () = previous_state := !glob_output; glob_output := NoGlob
let continue () = glob_output := !previous_state
open Decl_kinds
+open Declarations
let type_of_logical_kind = function
| IsDefinition def ->
(match def with
- | Definition -> "def"
+ | Definition | Let -> "def"
| Coercion -> "coe"
| SubClass -> "subclass"
| CanonicalStructure -> "canonstruc"
@@ -111,14 +114,12 @@ let type_of_global_ref gr =
| Globnames.IndRef ind ->
let (mib,oib) = Inductive.lookup_mind_specif (Global.env ()) ind in
if mib.Declarations.mind_record <> None then
- let open Decl_kinds in
begin match mib.Declarations.mind_finite with
| Finite -> "indrec"
| BiFinite -> "rec"
| CoFinite -> "corec"
end
else
- let open Decl_kinds in
begin match mib.Declarations.mind_finite with
| Finite -> "ind"
| BiFinite -> "variant"
@@ -139,30 +140,32 @@ let interval loc =
let loc1,loc2 = Loc.unloc loc in
loc1, loc2-1
-let dump_ref loc filepath modpath ident ty =
+let dump_ref ?loc filepath modpath ident ty =
match !glob_output with
| Feedback ->
- Feedback.feedback (Feedback.GlobRef (loc, filepath, modpath, ident, ty))
+ Option.iter (fun loc ->
+ Feedback.feedback (Feedback.GlobRef (loc, filepath, modpath, ident, ty))
+ ) loc
| NoGlob -> ()
- | _ when not (Loc.is_ghost loc) ->
+ | _ -> Option.iter (fun loc ->
let bl,el = interval loc in
dump_string (Printf.sprintf "R%d:%d %s %s %s %s\n"
bl el filepath modpath ident ty)
- | _ -> ()
+ ) loc
-let dump_reference loc modpath ident ty =
+let dump_reference ?loc modpath ident ty =
let filepath = Names.DirPath.to_string (Lib.library_dp ()) in
- dump_ref loc filepath modpath ident ty
+ dump_ref ?loc filepath modpath ident ty
-let dump_modref loc mp ty =
+let dump_modref ?loc mp ty =
let (dp, l) = Lib.split_modpath mp in
let filepath = Names.DirPath.to_string dp in
let modpath = Names.DirPath.to_string (Names.DirPath.make l) in
let ident = "<>" in
- dump_ref loc filepath modpath ident ty
+ dump_ref ?loc filepath modpath ident ty
-let dump_libref loc dp ty =
- dump_ref loc (Names.DirPath.to_string dp) "<>" "<>" ty
+let dump_libref ?loc dp ty =
+ dump_ref ?loc (Names.DirPath.to_string dp) "<>" "<>" ty
let cook_notation df sc =
(* We encode notations so that they are space-free and still human-readable *)
@@ -173,32 +176,33 @@ let cook_notation df sc =
(* - all single quotes in terminal tokens are doubled *)
(* - characters < 32 are represented by '^A, '^B, '^C, etc *)
(* The output is decoded in function Index.prepare_entry of coqdoc *)
- let ntn = String.make (String.length df * 5) '_' in
+ let ntn = Bytes.make (String.length df * 5) '_' in
let j = ref 0 in
let l = String.length df - 1 in
let i = ref 0 in
+ let open Bytes in (* Bytes.set *)
while !i <= l do
assert (df.[!i] != ' ');
if df.[!i] == '_' && (Int.equal !i l || df.[!i+1] == ' ') then
(* Next token is a non-terminal *)
- (ntn.[!j] <- 'x'; incr j; incr i)
+ (set ntn !j 'x'; incr j; incr i)
else begin
(* Next token is a terminal *)
- ntn.[!j] <- '\''; incr j;
+ set ntn !j '\''; incr j;
while !i <= l && df.[!i] != ' ' do
if df.[!i] < ' ' then
let c = char_of_int (int_of_char 'A' + int_of_char df.[!i] - 1) in
(String.blit ("'^" ^ String.make 1 c) 0 ntn !j 3; j := !j+3; incr i)
else begin
- if df.[!i] == '\'' then (ntn.[!j] <- '\''; incr j);
- ntn.[!j] <- df.[!i]; incr j; incr i
+ if df.[!i] == '\'' then (set ntn !j '\''; incr j);
+ set ntn !j df.[!i]; incr j; incr i
end
done;
- ntn.[!j] <- '\''; incr j
+ set ntn !j '\''; incr j
end;
- if !i <= l then (ntn.[!j] <- '_'; incr j; incr i)
+ if !i <= l then (set ntn !j '_'; incr j; incr i)
done;
- let df = String.sub ntn 0 !j in
+ let df = Bytes.sub_string ntn 0 !j in
match sc with Some sc -> ":" ^ sc ^ ":" ^ df | _ -> "::" ^ df
let dump_notation_location posl df (((path,secpath),_),sc) =
@@ -207,10 +211,10 @@ let dump_notation_location posl df (((path,secpath),_),sc) =
let secpath = Names.DirPath.to_string secpath in
let df = cook_notation df sc in
List.iter (fun l ->
- dump_ref (Loc.make_loc l) path secpath df "not")
+ dump_ref ~loc:(Loc.make_loc l) path secpath df "not")
posl
-let add_glob_gen loc sp lib_dp ty =
+let add_glob_gen ?loc sp lib_dp ty =
if dump () then
let mod_dp,id = Libnames.repr_path sp in
let mod_dp = remove_sections mod_dp in
@@ -218,50 +222,51 @@ let add_glob_gen loc sp lib_dp ty =
let filepath = Names.DirPath.to_string lib_dp in
let modpath = Names.DirPath.to_string mod_dp_trunc in
let ident = Names.Id.to_string id in
- dump_ref loc filepath modpath ident ty
+ dump_ref ?loc filepath modpath ident ty
-let add_glob loc ref =
- if dump () && not (Loc.is_ghost loc) then
+let add_glob ?loc ref =
+ if dump () then
let sp = Nametab.path_of_global ref in
let lib_dp = Lib.library_part ref in
let ty = type_of_global_ref ref in
- add_glob_gen loc sp lib_dp ty
+ add_glob_gen ?loc sp lib_dp ty
let mp_of_kn kn =
- let mp,sec,l = Names.repr_kn kn in
+ let mp,sec,l = Names.KerName.repr kn in
Names.MPdot (mp,l)
-let add_glob_kn loc kn =
- if dump () && not (Loc.is_ghost loc) then
+let add_glob_kn ?loc kn =
+ if dump () then
let sp = Nametab.path_of_syndef kn in
let lib_dp = Lib.dp_of_mp (mp_of_kn kn) in
- add_glob_gen loc sp lib_dp "syndef"
+ add_glob_gen ?loc sp lib_dp "syndef"
-let dump_binding loc id = ()
+let dump_binding ?loc id = ()
-let dump_def ty loc secpath id =
+let dump_def ?loc ty secpath id = Option.iter (fun loc ->
if !glob_output = Feedback then
Feedback.feedback (Feedback.GlobDef (loc, id, secpath, ty))
else
let bl,el = interval loc in
dump_string (Printf.sprintf "%s %d:%d %s %s\n" ty bl el secpath id)
+ ) loc
-let dump_definition (loc, id) sec s =
- dump_def s loc (Names.DirPath.to_string (Lib.current_dirpath sec)) (Names.Id.to_string id)
+let dump_definition {CAst.loc;v=id} sec s =
+ dump_def ?loc s (Names.DirPath.to_string (Lib.current_dirpath sec)) (Names.Id.to_string id)
-let dump_constraint (((loc, n),_), _, _) sec ty =
+let dump_constraint (({ CAst.loc; v = n },_), _, _) sec ty =
match n with
- | Names.Name id -> dump_definition (loc, id) sec ty
+ | Names.Name id -> dump_definition CAst.(make ?loc id) sec ty
| Names.Anonymous -> ()
-let dump_moddef loc mp ty =
+let dump_moddef ?loc mp ty =
let (dp, l) = Lib.split_modpath mp in
let mp = Names.DirPath.to_string (Names.DirPath.make l) in
- dump_def ty loc "<>" mp
+ dump_def ?loc ty "<>" mp
-let dump_notation (loc,(df,_)) sc sec =
+let dump_notation (loc,(df,_)) sc sec = Option.iter (fun loc ->
(* We dump the location of the opening '"' *)
let i = fst (Loc.unloc loc) in
let location = (Loc.make_loc (i, i+1)) in
- dump_def "not" location (Names.DirPath.to_string (Lib.current_dirpath sec)) (cook_notation df sc)
-
+ dump_def ~loc:location "not" (Names.DirPath.to_string (Lib.current_dirpath sec)) (cook_notation df sc)
+ ) loc
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-07 13:18:16 +0000