aboutsummaryrefslogtreecommitdiffhomepage
path: root/tools
diff options
context:
space:
mode:
Diffstat (limited to 'tools')
-rw-r--r--tools/coq_makefile.ml27
-rw-r--r--tools/coqdep.ml2
-rw-r--r--tools/coqdoc/alpha.ml7
-rw-r--r--tools/coqdoc/index.ml12
-rw-r--r--tools/coqmktop.ml1
-rw-r--r--tools/coqworkmgr.ml9
-rw-r--r--tools/fake_ide.ml43
7 files changed, 42 insertions, 59 deletions
diff --git a/tools/coq_makefile.ml b/tools/coq_makefile.ml
index 294575e0a..22b1408c0 100644
--- a/tools/coq_makefile.ml
+++ b/tools/coq_makefile.ml
@@ -50,9 +50,9 @@ let section s =
let lib_dirs =
["kernel"; "lib"; "library"; "parsing";
"pretyping"; "interp"; "printing"; "intf";
- "proofs"; "tactics"; "tools"; "ltacprof";
- "toplevel"; "stm"; "grammar"; "config";
- "ltac"; "engine"]
+ "proofs"; "tactics"; "tools";
+ "vernac"; "stm"; "toplevel"; "grammar"; "config";
+ "engine"]
let usage () =
@@ -125,12 +125,9 @@ let physical_dir_of_logical_dir ldir =
let le = String.length ldir - 1 in
let pdir =
if le >= 0 && ldir.[le] = '.' then String.sub ldir 0 (le - 1)
- else String.copy ldir
+ else ldir
in
- for i = 0 to le - 1 do
- if pdir.[i] = '.' then pdir.[i] <- '/';
- done;
- pdir
+ String.map (fun c -> if c = '.' then '/' else c) pdir
let standard opt =
print "byte:\n";
@@ -524,10 +521,10 @@ let variables is_install opt (args,defs) =
List.iter (fun c -> print " \\
-I \"$(COQLIB)/"; print c; print "\"") Coq_config.plugins_dirs; print "\n";
print "ZFLAGS=$(OCAMLLIBS) $(COQSRCLIBS) -I $(CAMLP4LIB)\n\n";
- print "CAMLC?=$(OCAMLFIND) ocamlc -c -rectypes -thread\n";
- print "CAMLOPTC?=$(OCAMLFIND) opt -c -rectypes -thread\n";
- print "CAMLLINK?=$(OCAMLFIND) ocamlc -rectypes -thread\n";
- print "CAMLOPTLINK?=$(OCAMLFIND) opt -rectypes -thread\n";
+ print "CAMLC?=$(OCAMLFIND) ocamlc -c -rectypes -thread -safe-string\n";
+ print "CAMLOPTC?=$(OCAMLFIND) opt -c -rectypes -thread -safe-string\n";
+ print "CAMLLINK?=$(OCAMLFIND) ocamlc -rectypes -thread -safe-string\n";
+ print "CAMLOPTLINK?=$(OCAMLFIND) opt -rectypes -thread -safe-string\n";
print "CAMLDEP?=$(OCAMLFIND) ocamldep -slash -ml-synonym .ml4 -ml-synonym .mlpack\n";
print "CAMLLIB?=$(shell $(OCAMLFIND) printconf stdlib)\n";
print "GRAMMARS?=grammar.cma\n";
@@ -768,9 +765,9 @@ let main_targets vfiles (mlifiles,ml4files,mlfiles,mllibfiles,mlpackfiles) other
begin
print "mlihtml: $(MLIFILES:.mli=.cmi)\n";
print "\t mkdir $@ || rm -rf $@/*\n";
- print "\t$(OCAMLFIND) ocamldoc -html -rectypes -d $@ -m A $(ZDEBUG) $(ZFLAGS) $(^:.cmi=.mli)\n\n";
+ print "\t$(OCAMLFIND) ocamldoc -html -safe-string -rectypes -d $@ -m A $(ZDEBUG) $(ZFLAGS) $(^:.cmi=.mli)\n\n";
print "all-mli.tex: $(MLIFILES:.mli=.cmi)\n";
- print "\t$(OCAMLFIND) ocamldoc -latex -rectypes -o $@ -m A $(ZDEBUG) $(ZFLAGS) $(^:.cmi=.mli)\n\n";
+ print "\t$(OCAMLFIND) ocamldoc -latex -safe-string -rectypes -o $@ -m A $(ZDEBUG) $(ZFLAGS) $(^:.cmi=.mli)\n\n";
end;
if !some_vfile then
begin
@@ -886,7 +883,7 @@ let check_overlapping_include (_,inc_i,inc_r) =
*)
let merlin targets (ml_inc,_,_) =
print ".merlin:\n";
- print "\t@echo 'FLG -rectypes' > .merlin\n" ;
+ print "\t@echo 'FLG -rectypes -safe-string' > .merlin\n" ;
List.iter (fun c ->
printf "\t@echo \"B $(COQLIB)%s\" >> .merlin\n" c)
lib_dirs ;
diff --git a/tools/coqdep.ml b/tools/coqdep.ml
index a7c32e1d6..a9f1b7376 100644
--- a/tools/coqdep.ml
+++ b/tools/coqdep.ml
@@ -526,5 +526,5 @@ let _ =
try
coqdep ()
with CErrors.UserError(s,p) ->
- let pp = if s <> "_" then Pp.(str s ++ str ": " ++ p) else p in
+ let pp = (match s with | None -> p | Some s -> Pp.(str s ++ str ": " ++ p)) in
Feedback.msg_error pp
diff --git a/tools/coqdoc/alpha.ml b/tools/coqdoc/alpha.ml
index f817ed5a2..3d92c9356 100644
--- a/tools/coqdoc/alpha.ml
+++ b/tools/coqdoc/alpha.ml
@@ -26,12 +26,7 @@ let norm_char c =
if !latin1 then norm_char_latin1 c else
Char.uppercase c
-let norm_string s =
- let u = String.copy s in
- for i = 0 to String.length s - 1 do
- u.[i] <- norm_char s.[i]
- done;
- u
+let norm_string = String.map (fun s -> norm_char s)
let compare_char c1 c2 = match norm_char c1, norm_char c2 with
| ('A'..'Z' as c1), ('A'..'Z' as c2) -> compare c1 c2
diff --git a/tools/coqdoc/index.ml b/tools/coqdoc/index.ml
index 9be791a8d..34108eff4 100644
--- a/tools/coqdoc/index.ml
+++ b/tools/coqdoc/index.ml
@@ -197,7 +197,7 @@ let prepare_entry s = function
let h = try String.index_from s 0 ':' with _ -> err () in
let i = try String.index_from s (h+1) ':' with _ -> err () in
let sc = String.sub s (h+1) (i-h-1) in
- let ntn = String.make (String.length s - i) ' ' in
+ let ntn = Bytes.make (String.length s - i) ' ' in
let k = ref 0 in
let j = ref (i+1) in
let quoted = ref false in
@@ -205,22 +205,22 @@ let prepare_entry s = function
while !j <= l do
if not !quoted then begin
(match s.[!j] with
- | '_' -> ntn.[!k] <- ' '; incr k
- | 'x' -> ntn.[!k] <- '_'; incr k
+ | '_' -> Bytes.set ntn !k ' '; incr k
+ | 'x' -> Bytes.set ntn !k '_'; incr k
| '\'' -> quoted := true
| _ -> assert false)
end
else
if s.[!j] = '\'' then
if (!j = l || s.[!j+1] = '_') then quoted := false
- else (incr j; ntn.[!k] <- s.[!j]; incr k)
+ else (incr j; Bytes.set ntn !k s.[!j]; incr k)
else begin
- ntn.[!k] <- s.[!j];
+ Bytes.set ntn !k s.[!j];
incr k
end;
incr j
done;
- let ntn = String.sub ntn 0 !k in
+ let ntn = Bytes.sub_string ntn 0 !k in
if sc = "" then ntn else ntn ^ " (" ^ sc ^ ")"
| _ ->
s
diff --git a/tools/coqmktop.ml b/tools/coqmktop.ml
index eaf938e8c..645b3665e 100644
--- a/tools/coqmktop.ml
+++ b/tools/coqmktop.ml
@@ -75,6 +75,7 @@ let std_includes basedir =
let rebase d = match basedir with None -> d | Some base -> base / d in
["-I"; rebase ".";
"-I"; rebase "lib";
+ "-I"; rebase "vernac"; (* For Mltop *)
"-I"; rebase "toplevel";
"-I"; rebase "kernel/byterun";
"-I"; Envars.camlp4lib () ] @
diff --git a/tools/coqworkmgr.ml b/tools/coqworkmgr.ml
index d7bdf907a..b8e69d6c6 100644
--- a/tools/coqworkmgr.ml
+++ b/tools/coqworkmgr.ml
@@ -72,10 +72,13 @@ let really_read_fd fd s off len =
let raw_input_line fd =
try
let b = Buffer.create 80 in
- let s = String.make 1 '\000' in
- while s <> "\n" do
+ let s = Bytes.make 1 '\000' in
+ let endl = Bytes.of_string "\n" in
+ let endr = Bytes.of_string "\r" in
+ while Bytes.compare s endl <> 0 do
really_read_fd fd s 0 1;
- if s <> "\n" && s <> "\r" then Buffer.add_string b s;
+ if Bytes.compare s endl <> 0 && Bytes.compare s endr <> 0
+ then Buffer.add_bytes b s;
done;
Buffer.contents b
with Unix.Unix_error _ -> raise End_of_file
diff --git a/tools/fake_ide.ml b/tools/fake_ide.ml
index 8fcca535d..932097607 100644
--- a/tools/fake_ide.ml
+++ b/tools/fake_ide.ml
@@ -12,24 +12,15 @@ let error s =
prerr_endline ("fake_id: error: "^s);
exit 1
+let pperr_endline pp = Format.eprintf "@[%a@]\n%!" Pp.pp_with pp
+
type coqtop = {
xml_printer : Xml_printer.t;
xml_parser : Xml_parser.t;
}
-let print_xml chan xml =
- let rec print = function
- | Xml_datatype.PCData s -> output_string chan s
- | Xml_datatype.Element (_, _, children) -> List.iter print children
- in
- print xml
-
-let error_xml s =
- Printf.eprintf "fake_id: error: %a\n%!" print_xml s;
- exit 1
-
-let logger level content =
- Printf.eprintf "%a\n%! " print_xml (Richpp.repr content)
+let print_error msg =
+ Format.eprintf "fake_id: error: @[%a@]\n%!" Pp.pp_with msg
let base_eval_call ?(print=true) ?(fail=true) call coqtop =
if print then prerr_endline (Xmlprotocol.pr_call call);
@@ -37,20 +28,15 @@ let base_eval_call ?(print=true) ?(fail=true) call coqtop =
Xml_printer.print coqtop.xml_printer xml_query;
let rec loop () =
let xml = Xml_parser.parse coqtop.xml_parser in
- match Xmlprotocol.is_message xml with
- | Some (level, _loc, content) ->
- logger level content;
+ if Xmlprotocol.is_feedback xml then
loop ()
- | None ->
- if Xmlprotocol.is_feedback xml then
- loop ()
- else Xmlprotocol.to_answer call xml
+ else Xmlprotocol.to_answer call xml
in
let res = loop () in
if print then prerr_endline (Xmlprotocol.pr_full_value call res);
match res with
- | Interface.Fail (_,_,s) when fail -> error_xml (Richpp.repr s)
- | Interface.Fail (_,_,s) as x -> Printf.eprintf "%a\n%!" print_xml (Richpp.repr s); x
+ | Interface.Fail (_,_,s) when fail -> print_error s; exit 1
+ | Interface.Fail (_,_,s) as x -> print_error s; x
| x -> x
let eval_call c q = ignore(base_eval_call c q)
@@ -186,7 +172,7 @@ let print_document () =
Str.global_replace (Str.regexp "^[\n ]*") ""
(if String.length s > 20 then String.sub s 0 17 ^ "..."
else s) in
- prerr_endline (Pp.string_of_ppcmds
+ pperr_endline (
(Document.print doc
(fun b state_id { name; text } ->
Pp.str (Printf.sprintf "%s[%10s, %3s] %s"
@@ -199,7 +185,7 @@ let print_document () =
module GUILogic = struct
let after_add = function
- | Interface.Fail (_,_,s) -> error_xml (Richpp.repr s)
+ | Interface.Fail (_,_,s) -> print_error s; exit 1
| Interface.Good (id, (Util.Inl (), _)) ->
Document.assign_tip_id doc id
| Interface.Good (id, (Util.Inr tip, _)) ->
@@ -211,7 +197,7 @@ module GUILogic = struct
let at id id' _ = Stateid.equal id' id
let after_edit_at (id,need_unfocus) = function
- | Interface.Fail (_,_,s) -> error_xml (Richpp.repr s)
+ | Interface.Fail (_,_,s) -> print_error s; exit 1
| Interface.Good (Util.Inl ()) ->
if need_unfocus then Document.unfocus doc;
ignore(Document.cut_at doc id);
@@ -310,11 +296,12 @@ let main =
Sys.set_signal Sys.sigpipe
(Sys.Signal_handle
(fun _ -> prerr_endline "Broken Pipe (coqtop died ?)"; exit 1));
+ let def_args = ["--xml_format=Ppcmds"; "-ideslave"] in
let coqtop_name, coqtop_args, input_file = match Sys.argv with
- | [| _; f |] -> "coqtop",[|"-ideslave"|], f
+ | [| _; f |] -> "coqtop", Array.of_list def_args, f
| [| _; f; ct |] ->
let ct = Str.split (Str.regexp " ") ct in
- List.hd ct, Array.of_list ("-ideslave" :: List.tl ct), f
+ List.hd ct, Array.of_list (def_args @ List.tl ct), f
| _ -> usage () in
let inc = if input_file = "-" then stdin else open_in input_file in
let coq =
@@ -334,7 +321,7 @@ let main =
let finish () =
match base_eval_call (Xmlprotocol.status true) coq with
| Interface.Good _ -> exit 0
- | Interface.Fail (_,_,s) -> error_xml (Richpp.repr s) in
+ | Interface.Fail (_,_,s) -> print_error s; exit 1 in
(* The main loop *)
init ();
while true do
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-28 09:57:51 +0000