diff options
Diffstat (limited to 'stdlib/pervasives.ml')
| -rw-r--r-- | stdlib/pervasives.ml | 607 |
1 files changed, 0 insertions, 607 deletions
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml index 54bf0ad4e..8f9e423f9 100644 --- a/stdlib/pervasives.ml +++ b/stdlib/pervasives.ml @@ -448,613 +448,6 @@ module LargeFile = (* Formats *) -module CamlinternalFormatBasics = struct -(* Type of a block used by the Format pretty-printer. *) -type block_type = - | Pp_hbox (* Horizontal block no line breaking *) - | Pp_vbox (* Vertical block each break leads to a new line *) - | Pp_hvbox (* Horizontal-vertical block: same as vbox, except if this block - is small enough to fit on a single line *) - | Pp_hovbox (* Horizontal or Vertical block: breaks lead to new line - only when necessary to print the content of the block *) - | Pp_box (* Horizontal or Indent block: breaks lead to new line - only when necessary to print the content of the block, or - when it leads to a new indentation of the current line *) - | Pp_fits (* Internal usage: when a block fits on a single line *) - -(* Formatting element used by the Format pretty-printter. *) -type formatting = - | Open_box of string * block_type * int (* @[ *) - | Close_box (* @] *) - | Open_tag of string * string (* @{ *) - | Close_tag (* @} *) - | Break of string * int * int (* @, | @ | @; | @;<> *) - | FFlush (* @? *) - | Force_newline (* @\n *) - | Flush_newline (* @. *) - | Magic_size of string * int (* @<n> *) - | Escaped_at (* @@ *) - | Escaped_percent (* @%% *) - | Scan_indic of char (* @X *) - -(***) - -(* Padding position. *) -type padty = - | Left (* Text is left justified ('-' option). *) - | Right (* Text is right justified (no '-' option). *) - | Zeros (* Text is right justified by zeros (see '0' option). *) - -(***) - -(* Integer conversion. *) -type int_conv = - | Int_d | Int_pd | Int_sd (* %d | %+d | % d *) - | Int_i | Int_pi | Int_si (* %i | %+i | % i *) - | Int_x | Int_Cx (* %x | %#x *) - | Int_X | Int_CX (* %X | %#X *) - | Int_o | Int_Co (* %o | %#o *) - | Int_u (* %u *) - -(* Float conversion. *) -type float_conv = - | Float_f | Float_pf | Float_sf (* %f | %+f | % f *) - | Float_e | Float_pe | Float_se (* %e | %+e | % e *) - | Float_E | Float_pE | Float_sE (* %E | %+E | % E *) - | Float_g | Float_pg | Float_sg (* %g | %+g | % g *) - | Float_G | Float_pG | Float_sG (* %G | %+G | % G *) - | Float_F (* %F *) - -(***) - -(* Char sets (see %[...]) are bitmaps implemented as 32-char strings. *) -type char_set = string - -(***) - -(* Counter used in Scanf. *) -type counter = - | Line_counter (* %l *) - | Char_counter (* %n *) - | Token_counter (* %N, %L *) - -(***) - -(* Padding of strings and numbers. *) -type ('a, 'b) padding = - (* No padding (ex: "%d") *) - | No_padding : ('a, 'a) padding - (* Literal padding (ex: "%8d") *) - | Lit_padding : padty * int -> ('a, 'a) padding - (* Padding as extra argument (ex: "%*d") *) - | Arg_padding : padty -> (int -> 'a, 'a) padding - -(* Some formats, such as %_d, - only accept an optional number as padding option (no extra argument) *) -type pad_option = int option - -(* Precision of floats and '0'-padding of integers. *) -type ('a, 'b) precision = - (* No precision (ex: "%f") *) - | No_precision : ('a, 'a) precision - (* Literal precision (ex: "%.3f") *) - | Lit_precision : int -> ('a, 'a) precision - (* Precision as extra argument (ex: "%.*f") *) - | Arg_precision : (int -> 'a, 'a) precision - -(* Some formats, such as %_f, - only accept an optional number as precision option (no extra argument) *) -type prec_option = int option - -(***) - -(* Relational format types - -In the first format+gadts implementation, the type for %(..%) in the -fmt GADT was as follows: - -| Format_subst : (* %(...%) *) - pad_option * ('d1, 'q1, 'd2, 'q2) reader_nb_unifier * - ('x, 'b, 'c, 'd1, 'q1, 'u) fmtty * - ('u, 'b, 'c, 'q1, 'e1, 'f) fmt -> - (('x, 'b, 'c, 'd2, 'q2, 'u) format6 -> 'x, 'b, 'c, 'd1, 'e1, 'f) fmt - -Notice that the 'u parameter in 'f position in the format argument -(('x, .., 'u) format6 -> ..) is equal to the 'u parameter in 'a -position in the format tail (('u, .., 'f) fmt). This means that the -type of the expected format parameter depends of where the %(...%) -are in the format string: - - # Printf.printf "%(%)";; - - : (unit, out_channel, unit, '_a, '_a, unit) - CamlinternalFormatBasics.format6 -> unit - = <fun> - # Printf.printf "%(%)%d";; - - : (int -> unit, out_channel, unit, '_a, '_a, int -> unit) - CamlinternalFormatBasics.format6 -> int -> unit - = <fun> - -On the contrary, the legacy typer gives a clever type that does not -depend on the position of %(..%) in the format string. For example, -%(%) will have the polymorphic type ('a, 'b, 'c, 'd, 'd, 'a): it can -be concatenated to any format type, and only enforces the constraint -that its 'a and 'f parameters are equal (no format arguments) and 'd -and 'e are equal (no reader argument). - -The weakening of this parameter type in the GADT version broke user -code (in fact it essentially made %(...%) unusable except at the last -position of a format). In particular, the following would not work -anymore: - - fun sep -> - Format.printf "foo%(%)bar%(%)baz" sep sep - -As the type-checker would require two *incompatible* types for the %(%) -in different positions. - -The solution to regain a general type for %(..%) is to generalize this -technique, not only on the 'd, 'e parameters, but on all six -parameters of a format: we introduce a "relational" type - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -whose values are proofs that ('a1, .., 'f1) and ('a2, .., 'f2) morally -correspond to the same format type: 'a1 is obtained from 'f1,'b1,'c1 -in the exact same way that 'a2 is obtained from 'f2,'b2,'c2, etc. - -For example, the relation between two format types beginning with a Char -parameter is as follows: - -| Char_ty : (* %c *) - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (char -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, - char -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - -In the general case, the term structure of fmtty_rel is (almost¹) -isomorphic to the fmtty of the previous implementation: every -constructor is re-read with a binary, relational type, instead of the -previous unary typing. fmtty can then be re-defined as the diagonal of -fmtty_rel: - - type ('a, 'b, 'c, 'd, 'e, 'f) fmtty = - ('a, 'b, 'c, 'd, 'e, 'f, - 'a, 'b, 'c, 'd, 'e, 'f) fmtty_rel - -Once we have this fmtty_rel type in place, we can give the more -general type to %(...%): - -| Format_subst : (* %(...%) *) - pad_option * - ('g, 'h, 'i, 'j, 'k, 'l, - 'g2, 'b, 'c, 'j2, 'd, 'a) fmtty_rel * - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b, 'c, 'j2, 'e, 'f) fmt - -We accept any format (('g, 'h, 'i, 'j, 'k, 'l) format6) (this is -completely unrelated to the type of the current format), but also -require a proof that this format is in relation to another format that -is concatenable to the format tail. When executing a %(...%) format -(in camlinternalFormat.ml:make_printf or scanf.ml:make_scanf), we -transtype the format along this relation using the 'recast' function -to transpose between related format types. - - val recast : - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1) fmt - -> ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - -> ('a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmt - -NOTE ¹: the typing of Format_subst_ty requires not one format type, but -two, one to establish the link between the format argument and the -first six parameters, and the other for the link between the format -argumant and the last six parameters. - -| Format_subst_ty : (* %(...%) *) - ('g, 'h, 'i, 'j, 'k, 'l, - 'g1, 'b1, 'c1, 'j1, 'd1, 'a1) fmtty_rel * - ('g, 'h, 'i, 'j, 'k, 'l, - 'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel * - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g1, 'b1, 'c1, 'j1, 'e1, 'f1, - ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel - -When we generate a format AST, we generate exactly the same witness -for both relations, and the witness-conversion functions in -camlinternalFormat do rely on this invariant. For example, the -function that proves that the relation is transitive - - val trans : - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - -> ('a2, 'b2, 'c2, 'd2, 'e2, 'f2, - 'a3, 'b3, 'c3, 'd3, 'e3, 'f3) fmtty_rel - -> ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a3, 'b3, 'c3, 'd3, 'e3, 'f3) fmtty_rel - -does assume that the two input have exactly the same term structure -(and is only every used for argument witnesses of the -Format_subst_ty constructor). -*) - -(* List of format type elements. *) -(* In particular used to represent %(...%) and %{...%} contents. *) -type ('a, 'b, 'c, 'd, 'e, 'f) fmtty = - ('a, 'b, 'c, 'd, 'e, 'f, - 'a, 'b, 'c, 'd, 'e, 'f) fmtty_rel -and ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel = - | Char_ty : (* %c *) - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (char -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, - char -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - | String_ty : (* %s *) - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (string -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, - string -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - | Int_ty : (* %d *) - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (int -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, - int -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - | Int32_ty : (* %ld *) - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (int32 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, - int32 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - | Nativeint_ty : (* %nd *) - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (nativeint -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, - nativeint -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - | Int64_ty : (* %Ld *) - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (int64 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, - int64 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - | Float_ty : (* %f *) - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (float -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, - float -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - | Bool_ty : (* %B *) - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (bool -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, - bool -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - - | Format_arg_ty : (* %{...%} *) - ('g, 'h, 'i, 'j, 'k, 'l) fmtty * - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, - ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - | Format_subst_ty : (* %(...%) *) - ('g, 'h, 'i, 'j, 'k, 'l, - 'g1, 'b1, 'c1, 'j1, 'd1, 'a1) fmtty_rel * - ('g, 'h, 'i, 'j, 'k, 'l, - 'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel * - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g1, 'b1, 'c1, 'j1, 'e1, 'f1, - ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel - - (* Printf and Format specific constructors. *) - | Alpha_ty : (* %a *) - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (('b1 -> 'x -> 'c1) -> 'x -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, - ('b2 -> 'x -> 'c2) -> 'x -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - | Theta_ty : (* %t *) - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - (('b1 -> 'c1) -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1, - ('b2 -> 'c2) -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel - - (* Scanf specific constructor. *) - | Reader_ty : (* %r *) - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - ('x -> 'a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1, - 'x -> 'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel - | Ignored_reader_ty : (* %_r *) - ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel -> - ('a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1, - 'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel - - | End_of_fmtty : - ('f1, 'b1, 'c1, 'd1, 'd1, 'f1, - 'f2, 'b2, 'c2, 'd2, 'd2, 'f2) fmtty_rel - -(***) - -(* List of format elements. *) -and ('a, 'b, 'c, 'd, 'e, 'f) fmt = - | Char : (* %c *) - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt - | Caml_char : (* %C *) - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt - | String : (* %s *) - ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - ('x, 'b, 'c, 'd, 'e, 'f) fmt - | Caml_string : (* %S *) - ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - ('x, 'b, 'c, 'd, 'e, 'f) fmt - | Int : (* %[dixXuo] *) - int_conv * ('x, 'y) padding * ('y, int -> 'a) precision * - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - ('x, 'b, 'c, 'd, 'e, 'f) fmt - | Int32 : (* %l[dixXuo] *) - int_conv * ('x, 'y) padding * ('y, int32 -> 'a) precision * - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - ('x, 'b, 'c, 'd, 'e, 'f) fmt - | Nativeint : (* %n[dixXuo] *) - int_conv * ('x, 'y) padding * ('y, nativeint -> 'a) precision * - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - ('x, 'b, 'c, 'd, 'e, 'f) fmt - | Int64 : (* %L[dixXuo] *) - int_conv * ('x, 'y) padding * ('y, int64 -> 'a) precision * - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - ('x, 'b, 'c, 'd, 'e, 'f) fmt - | Float : (* %[feEgGF] *) - float_conv * ('x, 'y) padding * ('y, float -> 'a) precision * - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - ('x, 'b, 'c, 'd, 'e, 'f) fmt - | Bool : (* %[bB] *) - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - (bool -> 'a, 'b, 'c, 'd, 'e, 'f) fmt - | Flush : (* %! *) - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - ('a, 'b, 'c, 'd, 'e, 'f) fmt - - | String_literal : (* abc *) - string * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - ('a, 'b, 'c, 'd, 'e, 'f) fmt - | Char_literal : (* x *) - char * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - ('a, 'b, 'c, 'd, 'e, 'f) fmt - - | Format_arg : (* %{...%} *) - pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty * - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a, 'b, 'c, 'd, 'e, 'f) fmt - | Format_subst : (* %(...%) *) - pad_option * - ('g, 'h, 'i, 'j, 'k, 'l, - 'g2, 'b, 'c, 'j2, 'd, 'a) fmtty_rel * - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b, 'c, 'j2, 'e, 'f) fmt - - (* Printf and Format specific constructor. *) - | Alpha : (* %a *) - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - (('b -> 'x -> 'c) -> 'x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt - | Theta : (* %t *) - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - (('b -> 'c) -> 'a, 'b, 'c, 'd, 'e, 'f) fmt - - (* Format specific constructor: *) - | Formatting : (* @_ *) - formatting * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - ('a, 'b, 'c, 'd, 'e, 'f) fmt - - (* Scanf specific constructors: *) - | Reader : (* %r *) - ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - ('x -> 'a, 'b, 'c, ('b -> 'x) -> 'd, 'e, 'f) fmt - | Scan_char_set : (* %[...] *) - pad_option * char_set * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - (string -> 'a, 'b, 'c, 'd, 'e, 'f) fmt - | Scan_get_counter : (* %[nlNL] *) - counter * ('a, 'b, 'c, 'd, 'e, 'f) fmt -> - (int -> 'a, 'b, 'c, 'd, 'e, 'f) fmt - | Ignored_param : (* %_ *) - ('a, 'b, 'c, 'd, 'y, 'x) ignored * ('x, 'b, 'c, 'y, 'e, 'f) fmt -> - ('a, 'b, 'c, 'd, 'e, 'f) fmt - - | End_of_format : - ('f, 'b, 'c, 'e, 'e, 'f) fmt - -(***) - -(* Type for ignored parameters (see "%_"). *) -and ('a, 'b, 'c, 'd, 'e, 'f) ignored = - | Ignored_char : (* %_c *) - ('a, 'b, 'c, 'd, 'd, 'a) ignored - | Ignored_caml_char : (* %_C *) - ('a, 'b, 'c, 'd, 'd, 'a) ignored - | Ignored_string : (* %_s *) - pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored - | Ignored_caml_string : (* %_S *) - pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored - | Ignored_int : (* %_d *) - int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored - | Ignored_int32 : (* %_ld *) - int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored - | Ignored_nativeint : (* %_nd *) - int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored - | Ignored_int64 : (* %_Ld *) - int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored - | Ignored_float : (* %_f *) - pad_option * prec_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored - | Ignored_bool : (* %_B *) - ('a, 'b, 'c, 'd, 'd, 'a) ignored - | Ignored_format_arg : (* %_{...%} *) - pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty -> - ('a, 'b, 'c, 'd, 'd, 'a) ignored - | Ignored_format_subst : (* %_(...%) *) - pad_option * ('a, 'b, 'c, 'd, 'e, 'f) fmtty -> - ('a, 'b, 'c, 'd, 'e, 'f) ignored - | Ignored_reader : (* %_r *) - ('a, 'b, 'c, ('b -> 'x) -> 'd, 'd, 'a) ignored - | Ignored_scan_char_set : (* %_[...] *) - pad_option * char_set -> ('a, 'b, 'c, 'd, 'd, 'a) ignored - | Ignored_scan_get_counter : (* %_[nlNL] *) - counter -> ('a, 'b, 'c, 'd, 'd, 'a) ignored - -and ('a, 'b, 'c, 'd, 'e, 'f) format6 = - Format of ('a, 'b, 'c, 'd, 'e, 'f) fmt * string - -let rec erase_rel : type a b c d e f g h i j k l . - (a, b, c, d, e, f, - g, h, i, j, k, l) fmtty_rel -> (a, b, c, d, e, f) fmtty -= function - | Char_ty rest -> - Char_ty (erase_rel rest) - | String_ty rest -> - String_ty (erase_rel rest) - | Int_ty rest -> - Int_ty (erase_rel rest) - | Int32_ty rest -> - Int32_ty (erase_rel rest) - | Int64_ty rest -> - Int64_ty (erase_rel rest) - | Nativeint_ty rest -> - Nativeint_ty (erase_rel rest) - | Float_ty rest -> - Float_ty (erase_rel rest) - | Bool_ty rest -> - Bool_ty (erase_rel rest) - | Format_arg_ty (ty, rest) -> - Format_arg_ty (ty, erase_rel rest) - | Format_subst_ty (ty1, ty2, rest) -> - Format_subst_ty (ty1, ty1, erase_rel rest) - | Alpha_ty rest -> - Alpha_ty (erase_rel rest) - | Theta_ty rest -> - Theta_ty (erase_rel rest) - | Reader_ty rest -> - Reader_ty (erase_rel rest) - | Ignored_reader_ty rest -> - Ignored_reader_ty (erase_rel rest) - | End_of_fmtty -> End_of_fmtty - -(******************************************************************************) - (* Format type concatenation *) - -(* Concatenate two format types. *) -(* Used by: - * reader_nb_unifier_of_fmtty to count readers in an fmtty, - * Scanf.take_fmtty_format_readers to extract readers inside %(...%), - * CamlinternalFormat.fmtty_of_ignored_format to extract format type. *) - -(* -let rec concat_fmtty : type a b c d e f g h . - (a, b, c, d, e, f) fmtty -> - (f, b, c, e, g, h) fmtty -> - (a, b, c, d, g, h) fmtty = -*) -let rec concat_fmtty : - type a1 b1 c1 d1 e1 f1 - a2 b2 c2 d2 e2 f2 - g1 j1 g2 j2 - . - (g1, b1, c1, j1, d1, a1, - g2, b2, c2, j2, d2, a2) fmtty_rel -> - (a1, b1, c1, d1, e1, f1, - a2, b2, c2, d2, e2, f2) fmtty_rel -> - (g1, b1, c1, j1, e1, f1, - g2, b2, c2, j2, e2, f2) fmtty_rel = -fun fmtty1 fmtty2 -> match fmtty1 with - | Char_ty rest -> - Char_ty (concat_fmtty rest fmtty2) - | String_ty rest -> - String_ty (concat_fmtty rest fmtty2) - | Int_ty rest -> - Int_ty (concat_fmtty rest fmtty2) - | Int32_ty rest -> - Int32_ty (concat_fmtty rest fmtty2) - | Nativeint_ty rest -> - Nativeint_ty (concat_fmtty rest fmtty2) - | Int64_ty rest -> - Int64_ty (concat_fmtty rest fmtty2) - | Float_ty rest -> - Float_ty (concat_fmtty rest fmtty2) - | Bool_ty rest -> - Bool_ty (concat_fmtty rest fmtty2) - | Alpha_ty rest -> - Alpha_ty (concat_fmtty rest fmtty2) - | Theta_ty rest -> - Theta_ty (concat_fmtty rest fmtty2) - | Reader_ty rest -> - Reader_ty (concat_fmtty rest fmtty2) - | Ignored_reader_ty rest -> - Ignored_reader_ty (concat_fmtty rest fmtty2) - | Format_arg_ty (ty, rest) -> - Format_arg_ty (ty, concat_fmtty rest fmtty2) - | Format_subst_ty (ty1, ty2, rest) -> - Format_subst_ty (ty1, ty2, concat_fmtty rest fmtty2) - | End_of_fmtty -> fmtty2 - -(******************************************************************************) - (* Format concatenation *) - -(* Concatenate two formats. *) -let rec concat_fmt : type a b c d e f g h . - (a, b, c, d, e, f) fmt -> - (f, b, c, e, g, h) fmt -> - (a, b, c, d, g, h) fmt = -fun fmt1 fmt2 -> match fmt1 with - | String (pad, rest) -> - String (pad, concat_fmt rest fmt2) - | Caml_string (pad, rest) -> - Caml_string (pad, concat_fmt rest fmt2) - - | Int (iconv, pad, prec, rest) -> - Int (iconv, pad, prec, concat_fmt rest fmt2) - | Int32 (iconv, pad, prec, rest) -> - Int32 (iconv, pad, prec, concat_fmt rest fmt2) - | Nativeint (iconv, pad, prec, rest) -> - Nativeint (iconv, pad, prec, concat_fmt rest fmt2) - | Int64 (iconv, pad, prec, rest) -> - Int64 (iconv, pad, prec, concat_fmt rest fmt2) - | Float (fconv, pad, prec, rest) -> - Float (fconv, pad, prec, concat_fmt rest fmt2) - - | Char (rest) -> - Char (concat_fmt rest fmt2) - | Caml_char rest -> - Caml_char (concat_fmt rest fmt2) - | Bool rest -> - Bool (concat_fmt rest fmt2) - | Alpha rest -> - Alpha (concat_fmt rest fmt2) - | Theta rest -> - Theta (concat_fmt rest fmt2) - | Reader rest -> - Reader (concat_fmt rest fmt2) - | Flush rest -> - Flush (concat_fmt rest fmt2) - - | String_literal (str, rest) -> - String_literal (str, concat_fmt rest fmt2) - | Char_literal (chr, rest) -> - Char_literal (chr, concat_fmt rest fmt2) - - | Format_arg (pad, fmtty, rest) -> - Format_arg (pad, fmtty, concat_fmt rest fmt2) - | Format_subst (pad, fmtty, rest) -> - Format_subst (pad, fmtty, concat_fmt rest fmt2) - - | Scan_char_set (width_opt, char_set, rest) -> - Scan_char_set (width_opt, char_set, concat_fmt rest fmt2) - | Scan_get_counter (counter, rest) -> - Scan_get_counter (counter, concat_fmt rest fmt2) - | Ignored_param (ign, rest) -> - Ignored_param (ign, concat_fmt rest fmt2) - - | Formatting (fmting, rest) -> - Formatting (fmting, concat_fmt rest fmt2) - - | End_of_format -> - fmt2 -end - type ('a, 'b, 'c, 'd, 'e, 'f) format6 = ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6 = Format of ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt |