SHARE
TWEET

Untitled

a guest Feb 16th, 2019 77 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. diff -Naur ocaml-4.00.1-old/stdlib/camlinternalFormat.ml ocaml-4.00.1-new/stdlib/camlinternalFormat.ml
  2. --- ocaml-4.00.1-old/stdlib/camlinternalFormat.ml   2013-05-26 16:24:33.089744387 +0200
  3. +++ ocaml-4.00.1-new/stdlib/camlinternalFormat.ml   2013-05-26 16:25:09.928281312 +0200
  4. @@ -6,11 +6,12 @@
  5.  (* Reversed list of printing atoms. *)
  6.  (* Used to accumulate printf arguments. *)
  7.  type ('b, 'c) acc =
  8. -  | Acc_formatting of ('b, 'c) acc * formatting (* Special formatting (box)   *)
  9. -  | Acc_string     of ('b, 'c) acc * string     (* Literal or generated string*)
  10. -  | Acc_char       of ('b, 'c) acc * char       (* Literal or generated char  *)
  11. -  | Acc_delay      of ('b, 'c) acc * ('b -> 'c) (* Delayed printing (%a, %t)  *)
  12. -  | Acc_flush      of ('b, 'c) acc              (* Flush                      *)
  13. +  | Acc_formatting  of ('b, 'c) acc * formatting(* Special formatting (box)   *)
  14. +  | Acc_string      of ('b, 'c) acc * string    (* Literal or generated string*)
  15. +  | Acc_char        of ('b, 'c) acc * char      (* Literal or generated char  *)
  16. +  | Acc_delay       of ('b, 'c) acc * ('b -> 'c)(* Delayed printing (%a, %t)  *)
  17. +  | Acc_flush       of ('b, 'c) acc             (* Flush                      *)
  18. +  | Acc_invalid_arg of ('b, 'c) acc * string    (* Raise Invalid_argument msg *)
  19.    | End_of_acc
  20.  
  21.  (* List of heterogeneous values. *)
  22. @@ -617,8 +618,9 @@
  23.      fun fmt -> make_printf k o acc
  24.        (CamlinternalFormatBasics.(type_format fmt fmtty ^^ rest))
  25.  
  26. -  | Scan_char_set (_, _, _) ->
  27. -    invalid_arg "Printf: bad conversion %["
  28. +  | Scan_char_set (_, _, rest) ->
  29. +    let new_acc = Acc_invalid_arg (acc, "Printf: bad conversion %[") in
  30. +    fun _ -> make_printf k o new_acc rest
  31.    | Scan_get_counter (_, rest) ->
  32.      (* This case should be refused for Printf. *)
  33.      (* Accepted for backward compatibility. *)
  34. @@ -626,8 +628,8 @@
  35.      fun n ->
  36.        let new_acc = Acc_string (acc, format_int "%d" n) in
  37.        make_printf k o new_acc rest
  38. -  | Ignored_param (_, _) ->
  39. -    invalid_arg "Printf: bad conversion %_"
  40. +  | Ignored_param (ign, rest) ->
  41. +    make_ignored_param k o acc ign rest
  42.  
  43.    | Formatting (fmting, rest) ->
  44.      make_printf k o (Acc_formatting (acc, fmting)) rest
  45. @@ -635,6 +637,59 @@
  46.    | End_of_format ->
  47.      k o acc
  48.  
  49. +(* Delay the error (Invalid_argument "Printf: bad conversion %_"). *)
  50. +(* Generate functions to take remaining arguments (after the "%_"). *)
  51. +and make_ignored_param : type x y a b c f .
  52. +    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
  53. +    (a, b, c, c, y, x) CamlinternalFormatBasics.ignored ->
  54. +    (x, b, c, y, c, f) CamlinternalFormatBasics.format6 -> a =
  55. +fun k o acc ign fmt -> match ign with
  56. +  | Ignored_char                    -> make_invalid_arg k o acc fmt
  57. +  | Ignored_caml_char               -> make_invalid_arg k o acc fmt
  58. +  | Ignored_string _                -> make_invalid_arg k o acc fmt
  59. +  | Ignored_caml_string _           -> make_invalid_arg k o acc fmt
  60. +  | Ignored_int (_, _)              -> make_invalid_arg k o acc fmt
  61. +  | Ignored_int32 (_, _)            -> make_invalid_arg k o acc fmt
  62. +  | Ignored_nativeint (_, _)        -> make_invalid_arg k o acc fmt
  63. +  | Ignored_int64 (_, _)            -> make_invalid_arg k o acc fmt
  64. +  | Ignored_float (_, _)            -> make_invalid_arg k o acc fmt
  65. +  | Ignored_bool                    -> make_invalid_arg k o acc fmt
  66. +  | Ignored_format_arg _            -> make_invalid_arg k o acc fmt
  67. +  | Ignored_format_subst (_, fmtty) -> make_from_fmtty k o acc fmtty fmt
  68. +  | Ignored_reader                  -> assert false
  69. +  | Ignored_scan_char_set _         -> make_invalid_arg k o acc fmt
  70. +
  71. +(* Special case of printf "%_(". *)
  72. +and make_from_fmtty : type x y a b c f .
  73. +    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
  74. +    (a, b, c, c, y, x) CamlinternalFormatBasics.fmtty ->
  75. +    (x, b, c, y, c, f) CamlinternalFormatBasics.format6 -> a =
  76. +fun k o acc fmtty fmt -> match fmtty with
  77. +  | Char_ty rest            -> fun _ -> make_from_fmtty k o acc rest fmt
  78. +  | String_ty rest          -> fun _ -> make_from_fmtty k o acc rest fmt
  79. +  | Int_ty rest             -> fun _ -> make_from_fmtty k o acc rest fmt
  80. +  | Int32_ty rest           -> fun _ -> make_from_fmtty k o acc rest fmt
  81. +  | Nativeint_ty rest       -> fun _ -> make_from_fmtty k o acc rest fmt
  82. +  | Int64_ty rest           -> fun _ -> make_from_fmtty k o acc rest fmt
  83. +  | Float_ty rest           -> fun _ -> make_from_fmtty k o acc rest fmt
  84. +  | Bool_ty rest            -> fun _ -> make_from_fmtty k o acc rest fmt
  85. +  | Alpha_ty rest           -> fun _ _ -> make_from_fmtty k o acc rest fmt
  86. +  | Theta_ty rest           -> fun _ -> make_from_fmtty k o acc rest fmt
  87. +  | Reader_ty _             -> assert false
  88. +  | Ignored_reader_ty _     -> assert false
  89. +  | Format_arg_ty (_, rest) -> fun _ -> make_from_fmtty k o acc rest fmt
  90. +  | End_of_fmtty            -> make_invalid_arg k o acc fmt
  91. +  | Format_subst_ty (_, ty, rest) ->
  92. +    fun _ -> make_from_fmtty k o acc (ty ^^^ rest) fmt
  93. +
  94. +(* Insert an Acc_invalid_arg in the accumulator and continue to generate
  95. +   closures to get the remaining arguments. *)
  96. +and make_invalid_arg : type a b c f .
  97. +    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
  98. +    (a, b, c, c, c, f) CamlinternalFormatBasics.format6 -> a =
  99. +fun k o acc fmt ->
  100. +  make_printf k o (Acc_invalid_arg (acc, "Printf: bad conversion %_")) fmt
  101. +
  102.  (* Fix padding, take it as an extra integer argument if needed. *)
  103.  and make_string_padding : type x z a b c d .
  104.      (b -> (b, c) acc -> d) -> b -> (b, c) acc ->
  105. @@ -756,11 +811,12 @@
  106.      let s = string_of_formatting fmting in
  107.      output_acc o p;
  108.      output_string o s;
  109. -  | Acc_string (p, s) -> output_acc o p; output_string o s
  110. -  | Acc_char (p, c)   -> output_acc o p; output_char o c
  111. -  | Acc_delay (p, f)  -> output_acc o p; f o
  112. -  | Acc_flush p       -> output_acc o p; flush o
  113. -  | End_of_acc        -> ()
  114. +  | Acc_string (p, s)        -> output_acc o p; output_string o s
  115. +  | Acc_char (p, c)          -> output_acc o p; output_char o c
  116. +  | Acc_delay (p, f)         -> output_acc o p; f o
  117. +  | Acc_flush p              -> output_acc o p; flush o
  118. +  | Acc_invalid_arg (p, msg) -> output_acc o p; invalid_arg msg;
  119. +  | End_of_acc               -> ()
  120.  
  121.  (* Recursively output an "accumulator" containing a reversed list of
  122.     printing entities (string, char, flus, ...) in a buffer. *)
  123. @@ -770,11 +826,12 @@
  124.      let s = string_of_formatting fmting in
  125.      bufput_acc b p;
  126.      Buffer.add_string b s;
  127. -  | Acc_string (p, s) -> bufput_acc b p; Buffer.add_string b s
  128. -  | Acc_char (p, c)   -> bufput_acc b p; Buffer.add_char b c
  129. -  | Acc_delay (p, f)  -> bufput_acc b p; f b
  130. -  | Acc_flush p       -> bufput_acc b p;
  131. -  | End_of_acc        -> ()
  132. +  | Acc_string (p, s)        -> bufput_acc b p; Buffer.add_string b s
  133. +  | Acc_char (p, c)          -> bufput_acc b p; Buffer.add_char b c
  134. +  | Acc_delay (p, f)         -> bufput_acc b p; f b
  135. +  | Acc_flush p              -> bufput_acc b p;
  136. +  | Acc_invalid_arg (p, msg) -> bufput_acc b p; invalid_arg msg;
  137. +  | End_of_acc               -> ()
  138.  
  139.  (* Recursively output an "accumulator" containing a reversed list of
  140.     printing entities (string, char, flus, ...) in a buffer. *)
  141. @@ -785,11 +842,12 @@
  142.      let s = string_of_formatting fmting in
  143.      strput_acc b p;
  144.      Buffer.add_string b s;
  145. -  | Acc_string (p, s) -> strput_acc b p; Buffer.add_string b s
  146. -  | Acc_char (p, c)   -> strput_acc b p; Buffer.add_char b c
  147. -  | Acc_delay (p, f)  -> strput_acc b p; Buffer.add_string b (f ())
  148. -  | Acc_flush p       -> strput_acc b p;
  149. -  | End_of_acc        -> ()
  150. +  | Acc_string (p, s)        -> strput_acc b p; Buffer.add_string b s
  151. +  | Acc_char (p, c)          -> strput_acc b p; Buffer.add_char b c
  152. +  | Acc_delay (p, f)         -> strput_acc b p; Buffer.add_string b (f ())
  153. +  | Acc_flush p              -> strput_acc b p;
  154. +  | Acc_invalid_arg (p, msg) -> strput_acc b p; invalid_arg msg;
  155. +  | End_of_acc               -> ()
  156.  
  157.  (******************************************************************************)
  158.                            (* Error managment *)
  159. diff -Naur ocaml-4.00.1-old/stdlib/camlinternalFormat.mli ocaml-4.00.1-new/stdlib/camlinternalFormat.mli
  160. --- ocaml-4.00.1-old/stdlib/camlinternalFormat.mli  2013-05-26 16:24:33.120743996 +0200
  161. +++ ocaml-4.00.1-new/stdlib/camlinternalFormat.mli  2013-05-26 16:25:09.928281312 +0200
  162. @@ -3,11 +3,12 @@
  163.  open CamlinternalFormatBasics
  164.  
  165.  type ('b, 'c) acc =
  166. -  | Acc_formatting of ('b, 'c) acc * formatting
  167. -  | Acc_string     of ('b, 'c) acc * string
  168. -  | Acc_char       of ('b, 'c) acc * char
  169. -  | Acc_delay      of ('b, 'c) acc * ('b -> 'c)
  170. -  | Acc_flush      of ('b, 'c) acc
  171. +  | Acc_formatting  of ('b, 'c) acc * formatting
  172. +  | Acc_string      of ('b, 'c) acc * string
  173. +  | Acc_char        of ('b, 'c) acc * char
  174. +  | Acc_delay       of ('b, 'c) acc * ('b -> 'c)
  175. +  | Acc_flush       of ('b, 'c) acc
  176. +  | Acc_invalid_arg of ('b, 'c) acc * string
  177.    | End_of_acc
  178.  
  179.  type ('a, 'b) heter_list =
  180. diff -Naur ocaml-4.00.1-old/stdlib/format.ml ocaml-4.00.1-new/stdlib/format.ml
  181. --- ocaml-4.00.1-old/stdlib/format.ml   2013-05-26 16:24:40.340653241 +0200
  182. +++ ocaml-4.00.1-new/stdlib/format.ml   2013-05-26 16:24:59.690410005 +0200
  183. @@ -972,12 +972,13 @@
  184.    | Acc_char (Acc_formatting (p, Magic_size (_, size)), c) ->
  185.      output_acc ppf p;
  186.      pp_print_as_size ppf (size_of_int size) (String.make 1 c);
  187. -  | Acc_formatting (p, f) -> output_acc ppf p; output_formatting ppf f;
  188. -  | Acc_string (p, s)     -> output_acc ppf p; pp_print_string ppf s;
  189. -  | Acc_char (p, c)       -> output_acc ppf p; pp_print_char ppf c;
  190. -  | Acc_delay (p, f)      -> output_acc ppf p; f ppf;
  191. -  | Acc_flush p           -> output_acc ppf p; pp_print_flush ppf ();
  192. -  | End_of_acc            -> ()
  193. +  | Acc_formatting (p, f)    -> output_acc ppf p; output_formatting ppf f;
  194. +  | Acc_string (p, s)        -> output_acc ppf p; pp_print_string ppf s;
  195. +  | Acc_char (p, c)          -> output_acc ppf p; pp_print_char ppf c;
  196. +  | Acc_delay (p, f)         -> output_acc ppf p; f ppf;
  197. +  | Acc_flush p              -> output_acc ppf p; pp_print_flush ppf ();
  198. +  | Acc_invalid_arg (p, msg) -> output_acc ppf p; invalid_arg msg;
  199. +  | End_of_acc               -> ()
  200.  
  201.  (* Recursively output an "accumulator" containing a reversed list of
  202.     printing entities (string, char, flus, ...) in a buffer. *)
  203. @@ -993,12 +994,13 @@
  204.    | Acc_delay (Acc_formatting (p, Magic_size (_, size)), f) ->
  205.      strput_acc ppf p;
  206.      pp_print_as_size ppf (size_of_int size) (f ());
  207. -  | Acc_formatting (p, f) -> strput_acc ppf p; output_formatting ppf f;
  208. -  | Acc_string (p, s)     -> strput_acc ppf p; pp_print_string ppf s;
  209. -  | Acc_char (p, c)       -> strput_acc ppf p; pp_print_char ppf c;
  210. -  | Acc_delay (p, f)      -> strput_acc ppf p; pp_print_string ppf (f ());
  211. -  | Acc_flush p           -> strput_acc ppf p; pp_print_flush ppf ();
  212. -  | End_of_acc            -> ()
  213. +  | Acc_formatting (p, f)    -> strput_acc ppf p; output_formatting ppf f;
  214. +  | Acc_string (p, s)        -> strput_acc ppf p; pp_print_string ppf s;
  215. +  | Acc_char (p, c)          -> strput_acc ppf p; pp_print_char ppf c;
  216. +  | Acc_delay (p, f)         -> strput_acc ppf p; pp_print_string ppf (f ());
  217. +  | Acc_flush p              -> strput_acc ppf p; pp_print_flush ppf ();
  218. +  | Acc_invalid_arg (p, msg) -> strput_acc ppf p; invalid_arg msg;
  219. +  | End_of_acc               -> ()
  220.  
  221.  
  222.  (**************************************************************
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top