1 (***********************************************************************)
5 (* Kim Nguyen, LRI UMR8623 *)
6 (* Université Paris-Sud & CNRS *)
8 (* Copyright 2010-2012 Université Paris-Sud and Centre National de la *)
9 (* Recherche Scientifique. All rights reserved. This file is *)
10 (* distributed under the terms of the GNU Lesser General Public *)
11 (* License, with the special exception on linking described in file *)
14 (***********************************************************************)
18 exception InvalidUtf8Codepoint of int
20 let subscripts = "₀₁₂₃₄₅₆₇₈₉"
21 let superscripts = "⁰¹²³⁴⁵⁶⁷⁸⁹"
24 let code = Char.code c in
25 if code <= 0x7f then 1
26 else if 0xc2 <= code && code <= 0xdf then 2
27 else if 0xe0 <= code && code <= 0xef then 3
28 else if 0xf0 <= code && code <= 0xf4 then 4
29 else raise (InvalidUtf8Codepoint code)
32 let next_char s i len =
33 let n = i + char_length s.[i] in
34 if n >= len then -1 else n
37 let len = String.length s in
40 else loop (next_char s i len) (acc+1)
47 let len = String.length s in
48 let rec loop j count =
49 if count == i then String.sub s j (char_length s.[j])
50 else loop (next_char s j len) (count+1)
55 let format_number digits i =
56 let s = string_of_int i in
57 let len = String.length s in
58 let buf = Buffer.create (len*4) in
59 for i = 0 to len - 1 do
60 let d = Char.code s.[i] - Char.code '0' in
61 Buffer.add_string buf (get_char digits d)
66 let len = str_len s in
70 loop (i+1) ((get_char s i) :: acc)
75 let explode s = List.rev (rev_explode s)
77 let combine_all comp s =
78 let l = rev_explode s in
79 String.concat "" (List.fold_left (fun acc e -> comp::e::acc) [] l)
82 let subscript = format_number subscripts
83 let superscript = format_number superscripts
100 let double_right_arrow = "⇒"
101 let combining_overbar = "\204\133"
102 let combining_underbar = "\204\178"
103 let combining_stroke = "\204\182"
104 let combining_vertical_line = "\226\131\146"
107 let overline s = combine_all combining_overbar s
108 let underline s = combine_all combining_underbar s
109 let strike s = combine_all combining_stroke s
111 let padding i = String.make i ' '
112 let line i = String.make i '_'
118 pp_print_string fmt (f s)
120 let pp_overline = ppf overline
121 let pp_underline = ppf underline
122 let pp_strike = ppf strike
123 let pp_subscript = ppf subscript
124 let pp_superscript = ppf superscript
125 let dummy_printer _ () = ()
127 let pp_print_list ?(sep=dummy_printer) printer fmt l =
130 | [ e ] -> printer fmt e
131 | e :: es -> printer fmt e;
135 fprintf fmt "%a" printer x) es
138 let pp_print_range ?(sep=dummy_printer) printer fmt (first, last) =
139 for i = first to last - 1 do
143 if first <= last then printer fmt last
145 let pp_print_array ?(sep=dummy_printer) printer fmt a =
146 pp_print_range ~sep:sep (fun fmt i -> printer fmt a.(i)) fmt
147 (0, (Array.length a - 1))
149 let with_printer (f : ?sep:('a) -> 'b) strsep pr fmt =
150 let sep_printer fmt () =
151 pp_print_string fmt strsep
153 fun x -> f ~sep:sep_printer pr fmt x
156 let print_list ?(sep=" ") printer fmt l =
157 with_printer pp_print_list sep printer fmt l
159 let print_array ?(sep=" ") printer fmt a =
160 with_printer pp_print_array sep printer fmt a
162 let print_range ?(sep=" ") printer fmt r =
163 with_printer pp_print_range sep printer fmt r