diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/aux_file.ml | 11 | ||||
| -rw-r--r-- | lib/feedback.ml | 1 | ||||
| -rw-r--r-- | lib/feedback.mli | 1 | ||||
| -rw-r--r-- | lib/pp.ml | 15 | ||||
| -rw-r--r-- | lib/pp.mli | 5 | ||||
| -rw-r--r-- | lib/richpp.ml | 9 | ||||
| -rw-r--r-- | lib/system.ml | 7 | ||||
| -rw-r--r-- | lib/unicode.ml | 24 |
8 files changed, 20 insertions, 53 deletions
diff --git a/lib/aux_file.ml b/lib/aux_file.ml index 0f0f09aa23..1b6651a55f 100644 --- a/lib/aux_file.ml +++ b/lib/aux_file.ml @@ -17,10 +17,6 @@ let version = 1 let oc = ref None -let chop_extension f = - if check_suffix f ".v" then chop_extension f - else f - let aux_file_name_for vfile = dirname vfile ^ "/." ^ chop_extension(basename vfile) ^ ".aux" @@ -76,14 +72,15 @@ let load_aux_file_for vfile = let add loc k v = h := set !h loc k v in let aux_fname = aux_file_name_for vfile in try - let ic = open_in aux_fname in - let ver, hash, fname = Scanf.fscanf ic "COQAUX%d %s %s\n" ret3 in + let ib = Scanf.Scanning.from_channel (open_in aux_fname) in + let ver, hash, fname = + Scanf.bscanf ib "COQAUX%d %s %s\n" ret3 in if ver <> version then raise (Failure "aux file version mismatch"); if fname <> vfile then raise (Failure "aux file name mismatch"); let only_dummyloc = Digest.to_hex (Digest.file vfile) <> hash in while true do - let i, j, k, v = Scanf.fscanf ic "%d %d %s %S\n" ret4 in + let i, j, k, v = Scanf.bscanf ib "%d %d %s %S\n" ret4 in if not only_dummyloc || (i = 0 && j = 0) then add (i,j) k v; done; raise End_of_file diff --git a/lib/feedback.ml b/lib/feedback.ml index 44b3ee35d7..57c6f30a41 100644 --- a/lib/feedback.ml +++ b/lib/feedback.ml @@ -27,7 +27,6 @@ type feedback_content = | ProcessingIn of string | InProgress of int | WorkerStatus of string * string - | Goals of Loc.t * string | AddedAxiom | GlobRef of Loc.t * string * string * string * string | GlobDef of Loc.t * string * string * string diff --git a/lib/feedback.mli b/lib/feedback.mli index 5160bd5bc1..b4bed8793d 100644 --- a/lib/feedback.mli +++ b/lib/feedback.mli @@ -36,7 +36,6 @@ type feedback_content = | InProgress of int | WorkerStatus of string * string (* Generally useful metadata *) - | Goals of Loc.t * string | AddedAxiom | GlobRef of Loc.t * string * string * string * string | GlobDef of Loc.t * string * string * string @@ -72,8 +72,6 @@ open Pp_control this block is small enough to fit on a single line \item[hovbox:] Horizontal or Vertical block: breaks lead to new line only when necessary to print the content of the block - \item[tbox:] Tabulation block: go to tabulation marks and no line breaking - (except if no mark yet on the reste of the line) \end{description} *) @@ -82,7 +80,6 @@ type block_type = | Pp_vbox of int | Pp_hvbox of int | Pp_hovbox of int - | Pp_tbox type str_token = | Str_def of string @@ -92,14 +89,11 @@ type 'a ppcmd_token = | Ppcmd_print of 'a | Ppcmd_box of block_type * ('a ppcmd_token Glue.t) | Ppcmd_print_break of int * int - | Ppcmd_set_tab - | Ppcmd_print_tbreak of int * int | Ppcmd_white_space of int | Ppcmd_force_newline | Ppcmd_print_if_broken | Ppcmd_open_box of block_type | Ppcmd_close_box - | Ppcmd_close_tbox | Ppcmd_comment of string list | Ppcmd_open_tag of Tag.t | Ppcmd_close_tag @@ -161,8 +155,6 @@ let utf8_length s = let str s = Glue.atom(Ppcmd_print (Str_def s)) let stras (i, s) = Glue.atom(Ppcmd_print (Str_len (s, i))) let brk (a,b) = Glue.atom(Ppcmd_print_break (a,b)) -let tbrk (a,b) = Glue.atom(Ppcmd_print_tbreak (a,b)) -let tab () = Glue.atom(Ppcmd_set_tab) let fnl () = Glue.atom(Ppcmd_force_newline) let pifb () = Glue.atom(Ppcmd_print_if_broken) let ws n = Glue.atom(Ppcmd_white_space n) @@ -212,16 +204,13 @@ let h n s = Glue.atom(Ppcmd_box(Pp_hbox n,s)) let v n s = Glue.atom(Ppcmd_box(Pp_vbox n,s)) let hv n s = Glue.atom(Ppcmd_box(Pp_hvbox n,s)) let hov n s = Glue.atom(Ppcmd_box(Pp_hovbox n,s)) -let t s = Glue.atom(Ppcmd_box(Pp_tbox,s)) (* Opening and closing of boxes *) let hb n = Glue.atom(Ppcmd_open_box(Pp_hbox n)) let vb n = Glue.atom(Ppcmd_open_box(Pp_vbox n)) let hvb n = Glue.atom(Ppcmd_open_box(Pp_hvbox n)) let hovb n = Glue.atom(Ppcmd_open_box(Pp_hovbox n)) -let tb () = Glue.atom(Ppcmd_open_box Pp_tbox) let close () = Glue.atom(Ppcmd_close_box) -let tclose () = Glue.atom(Ppcmd_close_tbox) (* Opening and closed of tags *) let open_tag t = Glue.atom(Ppcmd_open_tag t) @@ -263,7 +252,6 @@ let pp_dirs ?pp_tag ft = | Pp_vbox n -> Format.pp_open_vbox ft n | Pp_hvbox n -> Format.pp_open_hvbox ft n | Pp_hovbox n -> Format.pp_open_hovbox ft n - | Pp_tbox -> Format.pp_open_tbox ft () in let rec pp_cmd = function | Ppcmd_print tok -> @@ -280,11 +268,8 @@ let pp_dirs ?pp_tag ft = Format.pp_close_box ft () | Ppcmd_open_box bty -> pp_open_box bty | Ppcmd_close_box -> Format.pp_close_box ft () - | Ppcmd_close_tbox -> Format.pp_close_tbox ft () | Ppcmd_white_space n -> Format.pp_print_break ft n 0 | Ppcmd_print_break(m,n) -> Format.pp_print_break ft m n - | Ppcmd_set_tab -> Format.pp_set_tab ft () - | Ppcmd_print_tbreak(m,n) -> Format.pp_print_tbreak ft m n | Ppcmd_force_newline -> Format.pp_force_newline ft () | Ppcmd_print_if_broken -> Format.pp_print_if_newline ft () | Ppcmd_comment coms -> List.iter (pr_com ft) coms diff --git a/lib/pp.mli b/lib/pp.mli index 8342a983de..f17908262c 100644 --- a/lib/pp.mli +++ b/lib/pp.mli @@ -15,8 +15,6 @@ type std_ppcmds val str : string -> std_ppcmds val stras : int * string -> std_ppcmds val brk : int * int -> std_ppcmds -val tbrk : int * int -> std_ppcmds -val tab : unit -> std_ppcmds val fnl : unit -> std_ppcmds val pifb : unit -> std_ppcmds val ws : int -> std_ppcmds @@ -58,7 +56,6 @@ val h : int -> std_ppcmds -> std_ppcmds val v : int -> std_ppcmds -> std_ppcmds val hv : int -> std_ppcmds -> std_ppcmds val hov : int -> std_ppcmds -> std_ppcmds -val t : std_ppcmds -> std_ppcmds (** {6 Opening and closing of boxes} *) @@ -66,9 +63,7 @@ val hb : int -> std_ppcmds val vb : int -> std_ppcmds val hvb : int -> std_ppcmds val hovb : int -> std_ppcmds -val tb : unit -> std_ppcmds val close : unit -> std_ppcmds -val tclose : unit -> std_ppcmds (** {6 Opening and closing of tags} *) diff --git a/lib/richpp.ml b/lib/richpp.ml index a98273edb2..d1c6d158e4 100644 --- a/lib/richpp.ml +++ b/lib/richpp.ml @@ -55,7 +55,7 @@ let rich_pp annotate ppcmds = string_of_int index in - let pp_buffer = Buffer.create 13 in + let pp_buffer = Buffer.create 180 in let push_pcdata () = (** Push the optional PCData on the above node *) @@ -113,6 +113,13 @@ let rich_pp annotate ppcmds = pp_set_formatter_tag_functions ft tag_functions; pp_set_mark_tags ft true; + (* Set formatter width. This is currently a hack and duplicate code + with Pp_control. Hopefully it will be fixed better in Coq 8.7 *) + let w = pp_get_margin str_formatter () in + let m = max (64 * w / 100) (w-30) in + pp_set_margin ft w; + pp_set_max_indent ft m; + (** The whole output must be a valid document. To that end, we nest the document inside <pp> tags. *) pp_open_tag ft "pp"; diff --git a/lib/system.ml b/lib/system.ml index 74dd224a0a..e0e2c829d9 100644 --- a/lib/system.ml +++ b/lib/system.ml @@ -309,6 +309,7 @@ let with_time time f x = raise e let process_id () = - if Flags.async_proofs_is_worker () then !Flags.async_proofs_worker_id - else Printf.sprintf "master:%d" (Thread.id (Thread.self ())) - + Printf.sprintf "%d:%s:%d" (Unix.getpid ()) + (if Flags.async_proofs_is_worker () then !Flags.async_proofs_worker_id + else "master") + (Thread.id (Thread.self ())) diff --git a/lib/unicode.ml b/lib/unicode.ml index ced5e258c2..959ccaf73c 100644 --- a/lib/unicode.ml +++ b/lib/unicode.ml @@ -124,27 +124,11 @@ exception End_of_input let utf8_of_unicode n = if n < 128 then String.make 1 (Char.chr n) - else if n < 2048 then - let s = String.make 2 (Char.chr (128 + n mod 64)) in - begin - s.[0] <- Char.chr (192 + n / 64); - s - end - else if n < 65536 then - let s = String.make 3 (Char.chr (128 + n mod 64)) in - begin - s.[1] <- Char.chr (128 + (n / 64) mod 64); - s.[0] <- Char.chr (224 + n / 4096); - s - end else - let s = String.make 4 (Char.chr (128 + n mod 64)) in - begin - s.[2] <- Char.chr (128 + (n / 64) mod 64); - s.[1] <- Char.chr (128 + (n / 4096) mod 64); - s.[0] <- Char.chr (240 + n / 262144); - s - end + let (m,s) = if n < 2048 then (2,192) else if n < 65536 then (3,224) else (4,240) in + String.init m (fun i -> + let j = (n lsr ((m - 1 - i) * 6)) land 63 in + Char.chr (j + if i = 0 then s else 128)) (* If [s] is some UTF-8 encoded string and [i] is a position of some UTF-8 character within [s] |