1(**************************************************************************) 2(* *) 3(* OCaml *) 4(* *) 5(* Benoit Vaugon, ENSTA *) 6(* *) 7(* Copyright 2014 Institut National de Recherche en Informatique et *) 8(* en Automatique. *) 9(* *) 10(* All rights reserved. This file is distributed under the terms of *) 11(* the GNU Lesser General Public License version 2.1, with the *) 12(* special exception on linking described in the file LICENSE. *) 13(* *) 14(**************************************************************************) 15 16(* No comments, OCaml stdlib internal use only. *) 17 18type padty = Left | Right | Zeros 19 20type int_conv = 21 | Int_d | Int_pd | Int_sd | Int_i | Int_pi | Int_si 22 | Int_x | Int_Cx | Int_X | Int_CX | Int_o | Int_Co | Int_u 23 24type float_conv = 25 | Float_f | Float_pf | Float_sf | Float_e | Float_pe | Float_se 26 | Float_E | Float_pE | Float_sE | Float_g | Float_pg | Float_sg 27 | Float_G | Float_pG | Float_sG | Float_F 28 | Float_h | Float_ph | Float_sh | Float_H | Float_pH | Float_sH 29 30type char_set = string 31 32type counter = Line_counter | Char_counter | Token_counter 33 34type ('a, 'b) padding = 35 | No_padding : ('a, 'a) padding 36 | Lit_padding : padty * int -> ('a, 'a) padding 37 | Arg_padding : padty -> (int -> 'a, 'a) padding 38 39type pad_option = int option 40 41type ('a, 'b) precision = 42 | No_precision : ('a, 'a) precision 43 | Lit_precision : int -> ('a, 'a) precision 44 | Arg_precision : (int -> 'a, 'a) precision 45 46type prec_option = int option 47 48type ('a, 'b, 'c) custom_arity = 49 | Custom_zero : ('a, string, 'a) custom_arity 50 | Custom_succ : ('a, 'b, 'c) custom_arity -> 51 ('a, 'x -> 'b, 'x -> 'c) custom_arity 52 53type block_type = Pp_hbox | Pp_vbox | Pp_hvbox | Pp_hovbox | Pp_box | Pp_fits 54 55type formatting_lit = 56 | Close_box 57 | Close_tag 58 | Break of string * int * int 59 | FFlush 60 | Force_newline 61 | Flush_newline 62 | Magic_size of string * int 63 | Escaped_at 64 | Escaped_percent 65 | Scan_indic of char 66 67type ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen = 68 | Open_tag : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> 69 ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen 70 | Open_box : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> 71 ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen 72 73and ('a, 'b, 'c, 'd, 'e, 'f) fmtty = 74 ('a, 'b, 'c, 'd, 'e, 'f, 75 'a, 'b, 'c, 'd, 'e, 'f) fmtty_rel 76and ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 77 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel = 78| Char_ty : (* %c *) 79 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 80 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 81 (char -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, 82 char -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel 83| String_ty : (* %s *) 84 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 85 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 86 (string -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, 87 string -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel 88| Int_ty : (* %d *) 89 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 90 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 91 (int -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, 92 int -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel 93| Int32_ty : (* %ld *) 94 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 95 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 96 (int32 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, 97 int32 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel 98| Nativeint_ty : (* %nd *) 99 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 100 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 101 (nativeint -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, 102 nativeint -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel 103| Int64_ty : (* %Ld *) 104 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 105 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 106 (int64 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, 107 int64 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel 108| Float_ty : (* %f *) 109 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 110 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 111 (float -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, 112 float -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel 113| Bool_ty : (* %B *) 114 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 115 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 116 (bool -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, 117 bool -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel 118| Format_arg_ty : (* %{...%} *) 119 ('g, 'h, 'i, 'j, 'k, 'l) fmtty * 120 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 121 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 122 (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, 123 ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel 124| Format_subst_ty : (* %(...%) *) 125 ('g, 'h, 'i, 'j, 'k, 'l, 126 'g1, 'b1, 'c1, 'j1, 'd1, 'a1) fmtty_rel * 127 ('g, 'h, 'i, 'j, 'k, 'l, 128 'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel * 129 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 130 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 131 (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g1, 'b1, 'c1, 'j1, 'e1, 'f1, 132 ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel 133 134(* Printf and Format specific constructors. *) 135| Alpha_ty : (* %a *) 136 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 137 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 138 (('b1 -> 'x -> 'c1) -> 'x -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, 139 ('b2 -> 'x -> 'c2) -> 'x -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel 140| Theta_ty : (* %t *) 141 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 142 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 143 (('b1 -> 'c1) -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, 144 ('b2 -> 'c2) -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel 145| Any_ty : (* Used for custom formats *) 146 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 147 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 148 ('x -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, 149 'x -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel 150 151(* Scanf specific constructor. *) 152| Reader_ty : (* %r *) 153 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 154 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 155 ('x -> 'a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1, 156 'x -> 'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel 157| Ignored_reader_ty : (* %_r *) 158 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 159 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 160 ('a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1, 161 'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel 162 163| End_of_fmtty : 164 ('f1, 'b1, 'c1, 'd1, 'd1, 'f1, 165 'f2, 'b2, 'c2, 'd2, 'd2, 'f2) fmtty_rel 166 167(**) 168 169(** List of format elements. *) 170and ('a, 'b, 'c, 'd, 'e, 'f) fmt = 171| Char : (* %c *) 172 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 173 (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt 174| Caml_char : (* %C *) 175 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 176 (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt 177| String : (* %s *) 178 ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 179 ('x, 'b, 'c, 'd, 'e, 'f) fmt 180| Caml_string : (* %S *) 181 ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 182 ('x, 'b, 'c, 'd, 'e, 'f) fmt 183| Int : (* %[dixXuo] *) 184 int_conv * ('x, 'y) padding * ('y, int -> 'a) precision * 185 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 186 ('x, 'b, 'c, 'd, 'e, 'f) fmt 187| Int32 : (* %l[dixXuo] *) 188 int_conv * ('x, 'y) padding * ('y, int32 -> 'a) precision * 189 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 190 ('x, 'b, 'c, 'd, 'e, 'f) fmt 191| Nativeint : (* %n[dixXuo] *) 192 int_conv * ('x, 'y) padding * ('y, nativeint -> 'a) precision * 193 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 194 ('x, 'b, 'c, 'd, 'e, 'f) fmt 195| Int64 : (* %L[dixXuo] *) 196 int_conv * ('x, 'y) padding * ('y, int64 -> 'a) precision * 197 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 198 ('x, 'b, 'c, 'd, 'e, 'f) fmt 199| Float : (* %[feEgGF] *) 200 float_conv * ('x, 'y) padding * ('y, float -> 'a) precision * 201 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 202 ('x, 'b, 'c, 'd, 'e, 'f) fmt 203| Bool : (* %[bB] *) 204 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 205 (bool -> 'a, 'b, 'c, 'd, 'e, 'f) fmt 206| Flush : (* %! *) 207 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 208 ('a, 'b, 'c, 'd, 'e, 'f) fmt 209 210| String_literal : (* abc *) 211 string * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 212 ('a, 'b, 'c, 'd, 'e, 'f) fmt 213| Char_literal : (* x *) 214 char * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 215 ('a, 'b, 'c, 'd, 'e, 'f) fmt 216 217| Format_arg : (* %{...%} *) 218 pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty * 219 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 220 (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a, 'b, 'c, 'd, 'e, 'f) fmt 221| Format_subst : (* %(...%) *) 222 pad_option * 223 ('g, 'h, 'i, 'j, 'k, 'l, 224 'g2, 'b, 'c, 'j2, 'd, 'a) fmtty_rel * 225 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 226 (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b, 'c, 'j2, 'e, 'f) fmt 227 228(* Printf and Format specific constructor. *) 229| Alpha : (* %a *) 230 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 231 (('b -> 'x -> 'c) -> 'x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt 232| Theta : (* %t *) 233 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 234 (('b -> 'c) -> 'a, 'b, 'c, 'd, 'e, 'f) fmt 235 236(* Format specific constructor: *) 237| Formatting_lit : (* @_ *) 238 formatting_lit * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 239 ('a, 'b, 'c, 'd, 'e, 'f) fmt 240| Formatting_gen : (* @_ *) 241 ('a1, 'b, 'c, 'd1, 'e1, 'f1) formatting_gen * 242 ('f1, 'b, 'c, 'e1, 'e2, 'f2) fmt -> ('a1, 'b, 'c, 'd1, 'e2, 'f2) fmt 243 244(* Scanf specific constructors: *) 245| Reader : (* %r *) 246 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 247 ('x -> 'a, 'b, 'c, ('b -> 'x) -> 'd, 'e, 'f) fmt 248| Scan_char_set : (* %[...] *) 249 pad_option * char_set * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 250 (string -> 'a, 'b, 'c, 'd, 'e, 'f) fmt 251| Scan_get_counter : (* %[nlNL] *) 252 counter * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 253 (int -> 'a, 'b, 'c, 'd, 'e, 'f) fmt 254| Scan_next_char : (* %0c *) 255 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 256 (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt 257 (* %0c behaves as %c for printing, but when scanning it does not 258 consume the character from the input stream *) 259| Ignored_param : (* %_ *) 260 ('a, 'b, 'c, 'd, 'y, 'x) ignored * ('x, 'b, 'c, 'y, 'e, 'f) fmt -> 261 ('a, 'b, 'c, 'd, 'e, 'f) fmt 262 263(* Custom printing format *) 264| Custom : 265 ('a, 'x, 'y) custom_arity * (unit -> 'x) * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 266 ('y, 'b, 'c, 'd, 'e, 'f) fmt 267 268| End_of_format : 269 ('f, 'b, 'c, 'e, 'e, 'f) fmt 270 271and ('a, 'b, 'c, 'd, 'e, 'f) ignored = 272 | Ignored_char : 273 ('a, 'b, 'c, 'd, 'd, 'a) ignored 274 | Ignored_caml_char : 275 ('a, 'b, 'c, 'd, 'd, 'a) ignored 276 | Ignored_string : 277 pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored 278 | Ignored_caml_string : 279 pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored 280 | Ignored_int : 281 int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored 282 | Ignored_int32 : 283 int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored 284 | Ignored_nativeint : 285 int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored 286 | Ignored_int64 : 287 int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored 288 | Ignored_float : 289 pad_option * prec_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored 290 | Ignored_bool : 291 ('a, 'b, 'c, 'd, 'd, 'a) ignored 292 | Ignored_format_arg : 293 pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty -> 294 ('a, 'b, 'c, 'd, 'd, 'a) ignored 295 | Ignored_format_subst : 296 pad_option * ('a, 'b, 'c, 'd, 'e, 'f) fmtty -> 297 ('a, 'b, 'c, 'd, 'e, 'f) ignored 298 | Ignored_reader : 299 ('a, 'b, 'c, ('b -> 'x) -> 'd, 'd, 'a) ignored 300 | Ignored_scan_char_set : 301 pad_option * char_set -> ('a, 'b, 'c, 'd, 'd, 'a) ignored 302 | Ignored_scan_get_counter : 303 counter -> ('a, 'b, 'c, 'd, 'd, 'a) ignored 304 | Ignored_scan_next_char : 305 ('a, 'b, 'c, 'd, 'd, 'a) ignored 306 307and ('a, 'b, 'c, 'd, 'e, 'f) format6 = 308 Format of ('a, 'b, 'c, 'd, 'e, 'f) fmt * string 309 310val concat_fmtty : 311 ('g1, 'b1, 'c1, 'j1, 'd1, 'a1, 312 'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel -> 313 ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, 314 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> 315 ('g1, 'b1, 'c1, 'j1, 'e1, 'f1, 316 'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel 317 318val erase_rel : 319 ('a, 'b, 'c, 'd, 'e, 'f, 320 'g, 'h, 'i, 'j, 'k, 'l) fmtty_rel -> ('a, 'b, 'c, 'd, 'e, 'f) fmtty 321 322val concat_fmt : 323 ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 324 ('f, 'b, 'c, 'e, 'g, 'h) fmt -> 325 ('a, 'b, 'c, 'd, 'g, 'h) fmt 326