pygments.rb 0.6.3 → 1.0.0

data/vendor/pygments-main/tests/examplefiles/flipflop.sv

@@ -1,19 +0,0 @@
-module toplevel(clock,reset);
- input clock;
- input reset;
- 
- reg flop1;
- reg flop2;
- 
- always @ (posedge reset or posedge clock)
- if (reset)
-   begin
-     flop1 <= 0;
-     flop2 <= 1;
-   end
- else
-   begin
-     flop1 <= flop2;
-     flop2 <= flop1;
-   end
-endmodule

data/vendor/pygments-main/tests/examplefiles/foo.sce

@@ -1,6 +0,0 @@
-// Scilab
-//
-disp(%pi);
-
-assert_checkequal(2+2,4);
-

data/vendor/pygments-main/tests/examplefiles/format.ml

@@ -1,1213 +0,0 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the GNU Library General Public License, with    *)
-(*  the special exception on linking described in file ../LICENSE.     *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id: format.ml,v 1.65 2005/09/26 10:13:08 weis Exp $ *)
-
-(**************************************************************
-
-  Data structures definitions.
-
- **************************************************************)
-
-type size;;
-
-external size_of_int : int -> size = "%identity";;
-external int_of_size : size -> int = "%identity";;
-
-(* Tokens are one of the following : *)
-
-type pp_token =
-| Pp_text of string            (* normal text *)
-| Pp_break of int * int        (* complete break *)
-| Pp_tbreak of int * int       (* go to next tabulation *)
-| Pp_stab                      (* set a tabulation *)
-| Pp_begin of int * block_type (* beginning of a block *)
-| Pp_end                       (* end of a block *)
-| Pp_tbegin of tblock          (* beginning of a tabulation block *)
-| Pp_tend                      (* end of a tabulation block *)
-| Pp_newline                   (* to force a newline inside a block *)
-| Pp_if_newline                (* to do something only if this very
-                                  line has been broken *)
-| Pp_open_tag of string        (* opening a tag name *)
-| Pp_close_tag                 (* closing the most recently opened tag *)
-
-and tag = string
-
-and 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 *)
-
-and tblock = Pp_tbox of int list ref  (* Tabulation box *)
-;;
-
-(* The Queue:
-   contains all formatting elements.
-   elements are tuples (size, token, length), where
-   size is set when the size of the block is known
-   len is the declared length of the token. *)
-type pp_queue_elem = {
-  mutable elem_size : size; token : pp_token; length : int
-};;
-
-(* Scan stack:
-   each element is (left_total, queue element) where left_total
-   is the value of pp_left_total when the element has been enqueued. *)
-type pp_scan_elem = Scan_elem of int * pp_queue_elem;;
-
-(* Formatting stack:
-   used to break the lines while printing tokens.
-   The formatting stack contains the description of
-   the currently active blocks. *)
-type pp_format_elem = Format_elem of block_type * int;;
-
-(* General purpose queues, used in the formatter. *)
-type 'a queue_elem = | Nil | Cons of 'a queue_cell
-and 'a queue_cell = {mutable head : 'a; mutable tail : 'a queue_elem};;
-
-type 'a queue = {
- mutable insert : 'a queue_elem;
- mutable body : 'a queue_elem
-};;
-
-(* The formatter specific tag handling functions. *)
-type formatter_tag_functions = {
- mark_open_tag : tag -> string;
- mark_close_tag : tag -> string;
- print_open_tag : tag -> unit;
- print_close_tag : tag -> unit;
-
-};;
-
-(* A formatter with all its machinery. *)
-type formatter = {
- mutable pp_scan_stack : pp_scan_elem list;
- mutable pp_format_stack : pp_format_elem list;
- mutable pp_tbox_stack : tblock list;
- mutable pp_tag_stack : tag list;
- mutable pp_mark_stack : tag list;
- (* Global variables: default initialization is
-    set_margin 78
-    set_min_space_left 0. *)
- (* Value of right margin. *)
- mutable pp_margin : int;
- (* Minimal space left before margin, when opening a block. *)
- mutable pp_min_space_left : int;
- (* Maximum value of indentation:
-    no blocks can be opened further. *)
- mutable pp_max_indent : int;
- (* Space remaining on the current line. *)
- mutable pp_space_left : int;
- (* Current value of indentation. *)
- mutable pp_current_indent : int;
- (* True when the line has been broken by the pretty-printer. *)
- mutable pp_is_new_line : bool;
- (* Total width of tokens already printed. *)
- mutable pp_left_total : int;
- (* Total width of tokens ever put in queue. *)
- mutable pp_right_total : int;
- (* Current number of opened blocks. *)
- mutable pp_curr_depth : int;
- (* Maximum number of blocks which can be simultaneously opened. *)
- mutable pp_max_boxes : int;
- (* Ellipsis string. *)
- mutable pp_ellipsis : string;
- (* Output function. *)
- mutable pp_output_function : string -> int -> int -> unit;
- (* Flushing function. *)
- mutable pp_flush_function : unit -> unit;
- (* Output of new lines. *)
- mutable pp_output_newline : unit -> unit;
- (* Output of indentation spaces. *)
- mutable pp_output_spaces : int -> unit;
- (* Are tags printed ? *)
- mutable pp_print_tags : bool;
- (* Are tags marked ? *)
- mutable pp_mark_tags : bool;
- (* Find opening and closing markers of tags. *)
- mutable pp_mark_open_tag : tag -> string;
- mutable pp_mark_close_tag : tag -> string;
- mutable pp_print_open_tag : tag -> unit;
- mutable pp_print_close_tag : tag -> unit;
- (* The pretty-printer queue. *)
- mutable pp_queue : pp_queue_elem queue
-};;
-
-(**************************************************************
-
-  Auxilliaries and basic functions.
-
- **************************************************************)
-
-
-(* Queues auxilliaries. *)
-let make_queue () = {insert = Nil; body = Nil};;
-
-let clear_queue q = q.insert <- Nil; q.body <- Nil;;
-
-let add_queue x q =
- let c = Cons {head = x; tail = Nil} in
- match q with
- | {insert = Cons cell} -> q.insert <- c; cell.tail <- c
- (* Invariant: when insert is Nil body should be Nil. *)
- | _ -> q.insert <- c; q.body <- c;;
-
-exception Empty_queue;;
-
-let peek_queue = function
- | {body = Cons {head = x}} -> x
- | _ -> raise Empty_queue;;
-
-let take_queue = function
- | {body = Cons {head = x; tail = tl}} as q ->
-    q.body <- tl;
-    if tl = Nil then q.insert <- Nil; (* Maintain the invariant. *)
-    x
- | _ -> raise Empty_queue;;
-
-(* Enter a token in the pretty-printer queue. *)
-let pp_enqueue state ({length = len} as token) =
-    state.pp_right_total <- state.pp_right_total + len;
-    add_queue token state.pp_queue;;
-
-let pp_clear_queue state =
-    state.pp_left_total <- 1; state.pp_right_total <- 1;
-    clear_queue state.pp_queue;;
-
-(* Pp_infinity: large value for default tokens size.
-
-   Pp_infinity is documented as being greater than 1e10; to avoid
-   confusion about the word ``greater'', we choose pp_infinity greater
-   than 1e10 + 1; for correct handling of tests in the algorithm,
-   pp_infinity must be even one more than 1e10 + 1; let's stand on the
-   safe side by choosing 1.e10+10.
-
-   Pp_infinity could probably be 1073741823 that is 2^30 - 1, that is
-   the minimal upper bound for integers; now that max_int is defined,
-   this limit could also be defined as max_int - 1.
-
-   However, before setting pp_infinity to something around max_int, we
-   must carefully double-check all the integer arithmetic operations
-   that involve pp_infinity, since any overflow would wreck havoc the
-   pretty-printing algorithm's invariants. Given that this arithmetic
-   correctness check is difficult and error prone and given that 1e10
-   + 1 is in practice large enough, there is no need to attempt to set
-   pp_infinity to the theoretically maximum limit. Is it not worth the
-   burden ! *)
-
-let pp_infinity = 1000000010;;
-
-(* Output functions for the formatter. *)
-let pp_output_string state s = state.pp_output_function s 0 (String.length s)
-and pp_output_newline state = state.pp_output_newline ();;
-
-let pp_display_blanks state n = state.pp_output_spaces n;;
-
-(* To format a break, indenting a new line. *)
-let break_new_line state offset width =
-    pp_output_newline state;
-    state.pp_is_new_line <- true;
-    let indent = state.pp_margin - width + offset in
-    (* Don't indent more than pp_max_indent. *)
-    let real_indent = min state.pp_max_indent indent in
-    state.pp_current_indent <- real_indent;
-    state.pp_space_left <- state.pp_margin - state.pp_current_indent;
-    pp_display_blanks state state.pp_current_indent;;
-
-(* To force a line break inside a block: no offset is added. *)
-let break_line state width = break_new_line state 0 width;;
-
-(* To format a break that fits on the current line. *)
-let break_same_line state width =
-    state.pp_space_left <- state.pp_space_left - width;
-    pp_display_blanks state width;;
-
-(* To indent no more than pp_max_indent, if one tries to open a block
-   beyond pp_max_indent, then the block is rejected on the left
-   by simulating a break. *)
-let pp_force_break_line state =
-    match state.pp_format_stack with
-    | Format_elem (bl_ty, width) :: _ ->
-        if width > state.pp_space_left then
-         (match bl_ty with
-          | Pp_fits -> () | Pp_hbox -> () | _ -> break_line state width)
-    | _ -> pp_output_newline state;;
-
-(* To skip a token, if the previous line has been broken. *)
-let pp_skip_token state =
-    (* When calling pp_skip_token the queue cannot be empty. *)
-    match take_queue state.pp_queue with
-    {elem_size = size; length = len} ->
-       state.pp_left_total <- state.pp_left_total - len;
-       state.pp_space_left <- state.pp_space_left + int_of_size size;;
-
-(**************************************************************
-
-  The main pretting printing functions.
-
- **************************************************************)
-
-(* To format a token. *)
-let format_pp_token state size = function
-
-  | Pp_text s ->
-      state.pp_space_left <- state.pp_space_left - size;
-      pp_output_string state s;
-      state.pp_is_new_line <- false
-
-  | Pp_begin (off, ty) ->
-      let insertion_point = state.pp_margin - state.pp_space_left in
-      if insertion_point > state.pp_max_indent then
-         (* can't open a block right there. *)
-         begin pp_force_break_line state end;
-      let offset = state.pp_space_left - off in
-      let bl_type =
-       begin match ty with
-        | Pp_vbox -> Pp_vbox
-        | _ -> if size > state.pp_space_left then ty else Pp_fits
-       end in
-       state.pp_format_stack <-
-        Format_elem (bl_type, offset) :: state.pp_format_stack
-
-  | Pp_end ->
-      begin match state.pp_format_stack with
-        | x :: (y :: l as ls) -> state.pp_format_stack <- ls
-        | _ -> () (* No more block to close. *)
-      end
-
-  | Pp_tbegin (Pp_tbox _ as tbox) ->
-      state.pp_tbox_stack <- tbox :: state.pp_tbox_stack
-
-  | Pp_tend ->
-      begin match state.pp_tbox_stack with
-        | x :: ls -> state.pp_tbox_stack <- ls
-        | _ -> () (* No more tabulation block to close. *)
-      end
-
-  | Pp_stab ->
-     begin match state.pp_tbox_stack with
-     | Pp_tbox tabs :: _ ->
-        let rec add_tab n = function
-          | [] -> [n]
-          | x :: l as ls -> if n < x then n :: ls else x :: add_tab n l in
-        tabs := add_tab (state.pp_margin - state.pp_space_left) !tabs
-     | _ -> () (* No opened tabulation block. *)
-     end
-
-  | Pp_tbreak (n, off) ->
-      let insertion_point = state.pp_margin - state.pp_space_left in
-      begin match state.pp_tbox_stack with
-      | Pp_tbox tabs :: _ ->
-         let rec find n = function
-           | x :: l -> if x >= n then x else find n l
-           | [] -> raise Not_found in
-         let tab =
-             match !tabs with
-             | x :: l ->
-                begin try find insertion_point !tabs with Not_found -> x end
-             | _ -> insertion_point in
-         let offset = tab - insertion_point in
-         if offset >= 0 then break_same_line state (offset + n) else
-          break_new_line state (tab + off) state.pp_margin
-      | _ -> () (* No opened tabulation block. *)
-      end
-
-  | Pp_newline ->
-     begin match state.pp_format_stack with
-     | Format_elem (_, width) :: _ -> break_line state width
-     | _ -> pp_output_newline state
-     end
-
-  | Pp_if_newline ->
-     if state.pp_current_indent != state.pp_margin - state.pp_space_left
-     then pp_skip_token state
-
-  | Pp_break (n, off) ->
-     begin match state.pp_format_stack with
-     | Format_elem (ty, width) :: _ ->
-        begin match ty with
-        | Pp_hovbox ->
-           if size > state.pp_space_left
-           then break_new_line state off width
-           else break_same_line state n
-        | Pp_box ->
-           (* Have the line just been broken here ? *)
-           if state.pp_is_new_line then break_same_line state n else
-           if size > state.pp_space_left
-            then break_new_line state off width else
-           (* break the line here leads to new indentation ? *)
-           if state.pp_current_indent > state.pp_margin - width + off
-           then break_new_line state off width
-           else break_same_line state n
-        | Pp_hvbox -> break_new_line state off width
-        | Pp_fits -> break_same_line state n
-        | Pp_vbox -> break_new_line state off width
-        | Pp_hbox -> break_same_line state n
-        end
-     | _ -> () (* No opened block. *)
-     end
-
-   | Pp_open_tag tag_name ->
-      let marker = state.pp_mark_open_tag tag_name in
-      pp_output_string state marker;
-      state.pp_mark_stack <- tag_name :: state.pp_mark_stack
-
-   | Pp_close_tag ->
-      begin match state.pp_mark_stack with
-      | tag_name :: tags ->
-          let marker = state.pp_mark_close_tag tag_name in
-          pp_output_string state marker;
-          state.pp_mark_stack <- tags
-      | _ -> () (* No more tag to close. *)
-      end;;
-
-(* Print if token size is known or printing is delayed.
-   Size is known when not negative.
-   Printing is delayed when the text waiting in the queue requires
-   more room to format than exists on the current line. *)
-let rec advance_left state =
-    try
-     match peek_queue state.pp_queue with
-      {elem_size = size; token = tok; length = len} ->
-       let size = int_of_size size in
-       if not
-        (size < 0 &&
-         (state.pp_right_total - state.pp_left_total < state.pp_space_left))
-        then begin
-         ignore(take_queue state.pp_queue);
-         format_pp_token state (if size < 0 then pp_infinity else size) tok;
-         state.pp_left_total <- len + state.pp_left_total;
-         advance_left state
-        end
-    with Empty_queue -> ();;
-
-let enqueue_advance state tok = pp_enqueue state tok; advance_left state;;
-
-(* To enqueue a string : try to advance. *)
-let make_queue_elem size tok len =
- {elem_size = size; token = tok; length = len};;
-
-let enqueue_string_as state size s =
-  let len = int_of_size size in
-  enqueue_advance state (make_queue_elem size (Pp_text s) len);;
-
-let enqueue_string state s =
-  let len = String.length s in
-  enqueue_string_as state (size_of_int len) s;;
-
-(* Routines for scan stack
-   determine sizes of blocks. *)
-
-(* The scan_stack is never empty. *)
-let scan_stack_bottom =
-  let q_elem = make_queue_elem (size_of_int (-1)) (Pp_text "") 0 in
-  [Scan_elem (-1, q_elem)];;
-
-(* Set size of blocks on scan stack:
-   if ty = true then size of break is set else size of block is set;
-   in each case pp_scan_stack is popped. *)
-let clear_scan_stack state = state.pp_scan_stack <- scan_stack_bottom;;
-
-(* Pattern matching on scan stack is exhaustive,
-   since scan_stack is never empty.
-   Pattern matching on token in scan stack is also exhaustive,
-   since scan_push is used on breaks and opening of boxes. *)
-let set_size state ty =
-    match state.pp_scan_stack with
-    | Scan_elem
-        (left_tot,
-         ({elem_size = size; token = tok} as queue_elem)) :: t ->
-       let size = int_of_size size in
-       (* test if scan stack contains any data that is not obsolete. *)
-       if left_tot < state.pp_left_total then clear_scan_stack state else
-        begin match tok with
-        | Pp_break (_, _) | Pp_tbreak (_, _) ->
-           if ty then
-            begin
-             queue_elem.elem_size <- size_of_int (state.pp_right_total + size);
-             state.pp_scan_stack <- t
-            end
-        | Pp_begin (_, _) ->
-           if not ty then
-            begin
-             queue_elem.elem_size <- size_of_int (state.pp_right_total + size);
-             state.pp_scan_stack <- t
-            end
-        | _ -> () (* scan_push is only used for breaks and boxes. *)
-        end
-    | _ -> () (* scan_stack is never empty. *);;
-
-(* Push a token on scan stack. If b is true set_size is called. *)
-let scan_push state b tok =
-    pp_enqueue state tok;
-    if b then set_size state true;
-    state.pp_scan_stack <-
-     Scan_elem (state.pp_right_total, tok) :: state.pp_scan_stack;;
-
-(* To open a new block :
-   the user may set the depth bound pp_max_boxes
-   any text nested deeper is printed as the ellipsis string. *)
-let pp_open_box_gen state indent br_ty =
-    state.pp_curr_depth <- state.pp_curr_depth + 1;
-    if state.pp_curr_depth < state.pp_max_boxes then
-      let elem =
-        make_queue_elem
-          (size_of_int (- state.pp_right_total))
-          (Pp_begin (indent, br_ty))
-          0 in
-      scan_push state false elem else
-    if state.pp_curr_depth = state.pp_max_boxes
-    then enqueue_string state state.pp_ellipsis;;
-
-(* The box which is always opened. *)
-let pp_open_sys_box state = pp_open_box_gen state 0 Pp_hovbox;;
-
-(* Close a block, setting sizes of its subblocks. *)
-let pp_close_box state () =
-    if state.pp_curr_depth > 1 then
-     begin
-      if state.pp_curr_depth < state.pp_max_boxes then
-       begin
-        pp_enqueue state
-          {elem_size = size_of_int 0; token = Pp_end; length = 0};
-        set_size state true; set_size state false
-       end;
-      state.pp_curr_depth <- state.pp_curr_depth - 1;
-     end;;
-
-(* Open a tag, pushing it on the tag stack. *)
-let pp_open_tag state tag_name =
-    if state.pp_print_tags then begin
-      state.pp_tag_stack <- tag_name :: state.pp_tag_stack;
-      state.pp_print_open_tag tag_name end;
-    if state.pp_mark_tags then
-      pp_enqueue state
-        {elem_size = size_of_int 0; token = Pp_open_tag tag_name; length = 0};;
-
-(* Close a tag, popping it from the tag stack. *)
-let pp_close_tag state () =
-    if state.pp_mark_tags then
-      pp_enqueue state
-        {elem_size = size_of_int 0; token = Pp_close_tag; length = 0};
-    if state.pp_print_tags then
-      begin match state.pp_tag_stack with
-      | tag_name :: tags ->
-          state.pp_print_close_tag tag_name;
-          state.pp_tag_stack <- tags
-      | _ -> () (* No more tag to close. *)
-      end;;
-
-let pp_set_print_tags state b = state.pp_print_tags <- b;;
-let pp_set_mark_tags state b = state.pp_mark_tags <- b;;
-let pp_get_print_tags state () = state.pp_print_tags;;
-let pp_get_mark_tags state () = state.pp_mark_tags;;
-let pp_set_tags state b = pp_set_print_tags state b; pp_set_mark_tags state b;;
-
-let pp_get_formatter_tag_functions state () = {
-   mark_open_tag = state.pp_mark_open_tag;
-   mark_close_tag = state.pp_mark_close_tag;
-   print_open_tag = state.pp_print_open_tag;
-   print_close_tag = state.pp_print_close_tag;
-};;
-
-let pp_set_formatter_tag_functions state {
-     mark_open_tag = mot;
-     mark_close_tag = mct;
-     print_open_tag = pot;
-     print_close_tag = pct;
-  } =
-   state.pp_mark_open_tag <- mot;
-   state.pp_mark_close_tag <- mct;
-   state.pp_print_open_tag <- pot;
-   state.pp_print_close_tag <- pct;;
-
-(* Initialize pretty-printer. *)
-let pp_rinit state =
-    pp_clear_queue state;
-    clear_scan_stack state;
-    state.pp_format_stack <- [];
-    state.pp_tbox_stack <- [];
-    state.pp_tag_stack <- [];
-    state.pp_mark_stack <- [];
-    state.pp_current_indent <- 0;
-    state.pp_curr_depth <- 0;
-    state.pp_space_left <- state.pp_margin;
-    pp_open_sys_box state;;
-
-(* Flushing pretty-printer queue. *)
-let pp_flush_queue state b =
-    while state.pp_curr_depth > 1 do
-     pp_close_box state ()
-    done;
-    state.pp_right_total <- pp_infinity;
-    advance_left state;
-    if b then pp_output_newline state;
-    pp_rinit state;;
-
-(**************************************************************
-
-  Procedures to format objects, and use boxes
-
- **************************************************************)
-
-(* To format a string. *)
-let pp_print_as_size state size s =
-  if state.pp_curr_depth < state.pp_max_boxes
-  then enqueue_string_as state size s;;
-
-let pp_print_as state isize s =
-  pp_print_as_size state (size_of_int isize) s;;
-
-let pp_print_string state s =
-  pp_print_as state (String.length s) s;;
-
-(* To format an integer. *)
-let pp_print_int state i = pp_print_string state (string_of_int i);;
-
-(* To format a float. *)
-let pp_print_float state f = pp_print_string state (string_of_float f);;
-
-(* To format a boolean. *)
-let pp_print_bool state b = pp_print_string state (string_of_bool b);;
-
-(* To format a char. *)
-let pp_print_char state c =
-  let s = String.create 1 in
-  s.[0] <- c;
-  pp_print_as state 1 s;;
-
-(* Opening boxes. *)
-let pp_open_hbox state () = pp_open_box_gen state 0 Pp_hbox
-and pp_open_vbox state indent = pp_open_box_gen state indent Pp_vbox
-
-and pp_open_hvbox state indent = pp_open_box_gen state indent Pp_hvbox
-and pp_open_hovbox state indent = pp_open_box_gen state indent Pp_hovbox
-and pp_open_box state indent = pp_open_box_gen state indent Pp_box;;
-
-(* Print a new line after printing all queued text
-   (same for print_flush but without a newline). *)
-let pp_print_newline state () =
-    pp_flush_queue state true; state.pp_flush_function ()
-and pp_print_flush state () =
-    pp_flush_queue state false; state.pp_flush_function ();;
-
-(* To get a newline when one does not want to close the current block. *)
-let pp_force_newline state () =
-  if state.pp_curr_depth < state.pp_max_boxes then
-    enqueue_advance state (make_queue_elem (size_of_int 0) Pp_newline 0);;
-
-(* To format something if the line has just been broken. *)
-let pp_print_if_newline state () =
-  if state.pp_curr_depth < state.pp_max_boxes then
-    enqueue_advance state (make_queue_elem (size_of_int 0) Pp_if_newline 0);;
-
-(* Breaks: indicate where a block may be broken.
-   If line is broken then offset is added to the indentation of the current
-   block else (the value of) width blanks are printed.
-   To do (?) : add a maximum width and offset value. *)
-let pp_print_break state width offset =
-  if state.pp_curr_depth < state.pp_max_boxes then
-    let elem =
-      make_queue_elem
-        (size_of_int (- state.pp_right_total))
-        (Pp_break (width, offset))
-        width in
-    scan_push state true elem;;
-
-let pp_print_space state () = pp_print_break state 1 0
-and pp_print_cut state () = pp_print_break state 0 0;;
-
-(* Tabulation boxes. *)
-let pp_open_tbox state () =
-  state.pp_curr_depth <- state.pp_curr_depth + 1;
-  if state.pp_curr_depth < state.pp_max_boxes then
-    let elem =
-      make_queue_elem (size_of_int 0) (Pp_tbegin (Pp_tbox (ref []))) 0 in
-    enqueue_advance state elem;;
-
-(* Close a tabulation block. *)
-let pp_close_tbox state () =
-  if state.pp_curr_depth > 1 then begin
-   if state.pp_curr_depth < state.pp_max_boxes then
-     let elem = make_queue_elem (size_of_int 0) Pp_tend 0 in
-     enqueue_advance state elem;
-     state.pp_curr_depth <- state.pp_curr_depth - 1 end;;
-
-(* Print a tabulation break. *)
-let pp_print_tbreak state width offset =
-  if state.pp_curr_depth < state.pp_max_boxes then
-    let elem =
-      make_queue_elem
-        (size_of_int (- state.pp_right_total))
-        (Pp_tbreak (width, offset))
-        width in
-    scan_push state true elem;;
-
-let pp_print_tab state () = pp_print_tbreak state 0 0;;
-
-let pp_set_tab state () =
-  if state.pp_curr_depth < state.pp_max_boxes then
-    let elem =
-      make_queue_elem (size_of_int 0) Pp_stab 0 in
-    enqueue_advance state elem;;
-
-(**************************************************************
-
-  Procedures to control the pretty-printers
-
- **************************************************************)
-
-(* Fit max_boxes. *)
-let pp_set_max_boxes state n = if n > 1 then state.pp_max_boxes <- n;;
-
-(* To know the current maximum number of boxes allowed. *)
-let pp_get_max_boxes state () = state.pp_max_boxes;;
-
-let pp_over_max_boxes state () = state.pp_curr_depth = state.pp_max_boxes;;
-
-(* Ellipsis. *)
-let pp_set_ellipsis_text state s = state.pp_ellipsis <- s
-and pp_get_ellipsis_text state () = state.pp_ellipsis;;
-
-(* To set the margin of pretty-printer. *)
-let pp_limit n =
-  if n < pp_infinity then n else pred pp_infinity;;
-
-let pp_set_min_space_left state n =
-  if n >= 1 then
-    let n = pp_limit n in
-    state.pp_min_space_left <- n;
-    state.pp_max_indent <- state.pp_margin - state.pp_min_space_left;
-    pp_rinit state;;
-
-(* Initially, we have :
-  pp_max_indent = pp_margin - pp_min_space_left, and
-  pp_space_left = pp_margin. *)
-let pp_set_max_indent state n =
-  pp_set_min_space_left state (state.pp_margin - n);;
-let pp_get_max_indent state () = state.pp_max_indent;;
-
-let pp_set_margin state n =
-  if n >= 1 then
-    let n = pp_limit n in
-    state.pp_margin <- n;
-    let new_max_indent =
-        (* Try to maintain max_indent to its actual value. *)
-        if state.pp_max_indent <= state.pp_margin
-        then state.pp_max_indent else
-        (* If possible maintain pp_min_space_left to its actual value,
-           if this leads to a too small max_indent, take half of the
-           new margin, if it is greater than 1. *)
-         max (max (state.pp_margin - state.pp_min_space_left)
-                  (state.pp_margin / 2)) 1 in
-    (* Rebuild invariants. *)
-    pp_set_max_indent state new_max_indent;;
-
-let pp_get_margin state () = state.pp_margin;;
-
-let pp_set_formatter_output_functions state f g =
-  state.pp_output_function <- f; state.pp_flush_function <- g;;
-let pp_get_formatter_output_functions state () =
-  (state.pp_output_function, state.pp_flush_function);;
-
-let pp_set_all_formatter_output_functions state
-    ~out:f ~flush:g ~newline:h ~spaces:i =
-  pp_set_formatter_output_functions state f g;
-  state.pp_output_newline <- (function () -> h ());
-  state.pp_output_spaces <- (function n -> i n);;
-let pp_get_all_formatter_output_functions state () =
-  (state.pp_output_function, state.pp_flush_function,
-   state.pp_output_newline, state.pp_output_spaces);;
-
-let pp_set_formatter_out_channel state os =
-  state.pp_output_function <- output os;
-  state.pp_flush_function <- (fun () -> flush os);;
-
-(**************************************************************
-
-  Creation of specific formatters
-
- **************************************************************)
-
-let default_pp_mark_open_tag s = "<" ^ s ^ ">";;
-let default_pp_mark_close_tag s = "</" ^ s ^ ">";;
-
-let default_pp_print_open_tag s = ();;
-let default_pp_print_close_tag = default_pp_print_open_tag;;
-
-let pp_make_formatter f g h i =
- (* The initial state of the formatter contains a dummy box. *)
- let pp_q = make_queue () in
- let sys_tok =
-   make_queue_elem (size_of_int (-1)) (Pp_begin (0, Pp_hovbox)) 0 in
- add_queue sys_tok pp_q;
- let sys_scan_stack =
-     (Scan_elem (1, sys_tok)) :: scan_stack_bottom in
- {pp_scan_stack = sys_scan_stack;
-  pp_format_stack = [];
-  pp_tbox_stack = [];
-  pp_tag_stack = [];
-  pp_mark_stack = [];
-  pp_margin = 78;
-  pp_min_space_left = 10;
-  pp_max_indent = 78 - 10;
-  pp_space_left = 78;
-  pp_current_indent = 0;
-  pp_is_new_line = true;
-  pp_left_total = 1;
-  pp_right_total = 1;
-  pp_curr_depth = 1;
-  pp_max_boxes = max_int;
-  pp_ellipsis = ".";
-  pp_output_function = f;
-  pp_flush_function = g;
-  pp_output_newline = h;
-  pp_output_spaces = i;
-  pp_print_tags = false;
-  pp_mark_tags = false;
-  pp_mark_open_tag = default_pp_mark_open_tag;
-  pp_mark_close_tag = default_pp_mark_close_tag;
-  pp_print_open_tag = default_pp_print_open_tag;
-  pp_print_close_tag = default_pp_print_close_tag;
-  pp_queue = pp_q
- };;
-
-(* Default function to output spaces. *)
-let blank_line = String.make 80 ' ';;
-let rec display_blanks state n =
-    if n > 0 then
-    if n <= 80 then state.pp_output_function blank_line 0 n else
-     begin
-      state.pp_output_function blank_line 0 80;
-      display_blanks state (n - 80)
-     end;;
-
-(* Default function to output new lines. *)
-let display_newline state () = state.pp_output_function "\n" 0  1;;
-
-let make_formatter f g =
-  let ff = pp_make_formatter f g ignore ignore in
-  ff.pp_output_newline <- display_newline ff;
-  ff.pp_output_spaces <- display_blanks ff;
-  ff;;
-
-let formatter_of_out_channel oc =
-  make_formatter (output oc) (fun () -> flush oc);;
-
-let formatter_of_buffer b =
-  make_formatter (Buffer.add_substring b) ignore;;
-
-let stdbuf = Buffer.create 512;;
-
-let str_formatter = formatter_of_buffer stdbuf;;
-let std_formatter = formatter_of_out_channel stdout;;
-let err_formatter = formatter_of_out_channel stderr;;
-
-let flush_str_formatter () =
-  pp_flush_queue str_formatter false;
-  let s = Buffer.contents stdbuf in
-  Buffer.reset stdbuf;
-  s;;
-
-(**************************************************************
-
-  Basic functions on the standard formatter
-
- **************************************************************)
-
-let open_hbox = pp_open_hbox std_formatter
-and open_vbox = pp_open_vbox std_formatter
-and open_hvbox = pp_open_hvbox std_formatter
-and open_hovbox = pp_open_hovbox std_formatter
-and open_box = pp_open_box std_formatter
-and close_box = pp_close_box std_formatter
-and open_tag = pp_open_tag std_formatter
-and close_tag = pp_close_tag std_formatter
-and print_as = pp_print_as std_formatter
-and print_string = pp_print_string std_formatter
-and print_int = pp_print_int std_formatter
-and print_float = pp_print_float std_formatter
-and print_char = pp_print_char std_formatter
-and print_bool = pp_print_bool std_formatter
-and print_break = pp_print_break std_formatter
-and print_cut = pp_print_cut std_formatter
-and print_space = pp_print_space std_formatter
-and force_newline = pp_force_newline std_formatter
-and print_flush = pp_print_flush std_formatter
-and print_newline = pp_print_newline std_formatter
-and print_if_newline = pp_print_if_newline std_formatter
-
-and open_tbox = pp_open_tbox std_formatter
-and close_tbox = pp_close_tbox std_formatter
-and print_tbreak = pp_print_tbreak std_formatter
-
-and set_tab = pp_set_tab std_formatter
-and print_tab = pp_print_tab std_formatter
-
-and set_margin = pp_set_margin std_formatter
-and get_margin = pp_get_margin std_formatter
-
-and set_max_indent = pp_set_max_indent std_formatter
-and get_max_indent = pp_get_max_indent std_formatter
-
-and set_max_boxes = pp_set_max_boxes std_formatter
-and get_max_boxes = pp_get_max_boxes std_formatter
-and over_max_boxes = pp_over_max_boxes std_formatter
-
-and set_ellipsis_text = pp_set_ellipsis_text std_formatter
-and get_ellipsis_text = pp_get_ellipsis_text std_formatter
-
-and set_formatter_out_channel =
-    pp_set_formatter_out_channel std_formatter
-
-and set_formatter_output_functions =
-    pp_set_formatter_output_functions std_formatter
-and get_formatter_output_functions =
-    pp_get_formatter_output_functions std_formatter
-
-and set_all_formatter_output_functions =
-    pp_set_all_formatter_output_functions std_formatter
-and get_all_formatter_output_functions =
-    pp_get_all_formatter_output_functions std_formatter
-
-and set_formatter_tag_functions =
-    pp_set_formatter_tag_functions std_formatter
-and get_formatter_tag_functions =
-    pp_get_formatter_tag_functions std_formatter
-and set_print_tags =
-    pp_set_print_tags std_formatter
-and get_print_tags =
-    pp_get_print_tags std_formatter
-and set_mark_tags =
-    pp_set_mark_tags std_formatter
-and get_mark_tags =
-    pp_get_mark_tags std_formatter
-and set_tags =
-    pp_set_tags std_formatter
-;;
-
-
-(**************************************************************
-
-  Printf implementation.
-
- **************************************************************)
-
-(* Error messages when processing formats. *)
-
-(* Trailer: giving up at character number ... *)
-let giving_up mess fmt i =
-  "fprintf: " ^ mess ^ " ``" ^ fmt ^ "'', \
-   giving up at character number " ^ string_of_int i ^
-  (if i < String.length fmt
-   then " (" ^ String.make 1 fmt.[i] ^ ")."
-   else String.make 1 '.');;
-
-(* When an invalid format deserves a special error explanation. *)
-let format_invalid_arg mess fmt i = invalid_arg (giving_up mess fmt i);;
-
-(* Standard invalid format. *)
-let invalid_format fmt i = format_invalid_arg "bad format" fmt i;;
-
-(* Cannot find a valid integer into that format. *)
-let invalid_integer fmt i =
-  invalid_arg (giving_up "bad integer specification" fmt i);;
-
-(* Finding an integer out of a sub-string of the format. *)
-let format_int_of_string fmt i s =
-  let sz =
-    try int_of_string s with
-    | Failure s -> invalid_integer fmt i in
-  size_of_int sz;;
-
-(* Getting strings out of buffers. *)
-let get_buffer_out b =
- let s = Buffer.contents b in
- Buffer.reset b;
- s;;
-
-(* [ppf] is supposed to be a pretty-printer that outputs in buffer [b]:
-   to extract contents of [ppf] as a string we flush [ppf] and get the string
-   out of [b]. *)
-let string_out b ppf =
- pp_flush_queue ppf false;
- get_buffer_out b;;
-
-(* Applies [printer] to a formatter that outputs on a fresh buffer,
-   then returns the resulting material. *)
-let exstring printer arg =
- let b = Buffer.create 512 in
- let ppf = formatter_of_buffer b in
- printer ppf arg;
- string_out b ppf;;
-
-(* To turn out a character accumulator into the proper string result. *)
-let implode_rev s0 = function
-  | [] -> s0
-  | l -> String.concat "" (List.rev (s0 :: l));;
-
-external format_to_string : ('a, 'b, 'c, 'd) format4 -> string = "%identity";;
-
-(* [fprintf_out] is the printf-like function generator: given the
-   - [str] flag that tells if we are printing into a string,
-   - the [out] function that has to be called at the end of formatting,
-   it generates a [fprintf] function that takes as arguments a [ppf]
-   formatter and a printing format to print the rest of arguments
-   according to the format.
-   Regular [fprintf]-like functions of this module are obtained via partial
-   applications of [fprintf_out]. *)
-let mkprintf str get_out =
-  let rec kprintf k fmt =
-    let fmt = format_to_string fmt in
-    let len = String.length fmt in
-
-    let kpr fmt v =
-      let ppf = get_out fmt in
-      let print_as = ref None in
-      let pp_print_as_char c =
-          match !print_as with
-          | None -> pp_print_char ppf c
-          | Some size ->
-             pp_print_as_size ppf size (String.make 1 c);
-             print_as := None
-      and pp_print_as_string s =
-          match !print_as with
-          | None -> pp_print_string ppf s
-          | Some size ->
-             pp_print_as_size ppf size s;
-             print_as := None in
-
-      let rec doprn n i =
-        if i >= len then Obj.magic (k ppf) else
-        match fmt.[i] with
-        | '%' ->
-            Printf.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
-        | '@' ->
-            let i = succ i in
-            if i >= len then invalid_format fmt i else
-            begin match fmt.[i] with
-            | '[' ->
-               do_pp_open_box ppf n (succ i)
-            | ']' ->
-               pp_close_box ppf ();
-               doprn n (succ i)
-            | '{' ->
-               do_pp_open_tag ppf n (succ i)
-            | '}' ->
-               pp_close_tag ppf ();
-               doprn n (succ i)
-            | ' ' ->
-               pp_print_space ppf ();
-               doprn n (succ i)
-            | ',' ->
-               pp_print_cut ppf ();
-               doprn n (succ i)
-            | '?' ->
-               pp_print_flush ppf ();
-               doprn n (succ i)
-            | '.' ->
-               pp_print_newline ppf ();
-               doprn n (succ i)
-            | '\n' ->
-               pp_force_newline ppf ();
-               doprn n (succ i)
-            | ';' ->
-               do_pp_break ppf n (succ i)
-            | '<' ->
-               let got_size size n i =
-                 print_as := Some size;
-                 doprn n (skip_gt i) in
-               get_int n (succ i) got_size
-            | '@' as c ->
-               pp_print_as_char c;
-               doprn n (succ i)
-            | c -> invalid_format fmt i
-            end
-        | c ->
-           pp_print_as_char c;
-           doprn n (succ i)
-
-      and cont_s n s i =
-        pp_print_as_string s; doprn n i
-      and cont_a n printer arg i =
-        if str then
-          pp_print_as_string ((Obj.magic printer : unit -> _ -> string) () arg)
-        else
-          printer ppf arg;
-        doprn n i
-      and cont_t n printer i =
-        if str then
-          pp_print_as_string ((Obj.magic printer : unit -> string) ())
-        else
-          printer ppf;
-        doprn n i
-      and cont_f n i =
-        pp_print_flush ppf (); doprn n i
-
-      and cont_m n sfmt i =
-        kprintf (Obj.magic (fun _ -> doprn n i)) sfmt
-
-      and get_int n i c =
-       if i >= len then invalid_integer fmt i else
-       match fmt.[i] with
-       | ' ' -> get_int n (succ i) c
-       | '%' ->
-          let cont_s n s i = c (format_int_of_string fmt i s) n i
-          and cont_a n printer arg i = invalid_integer fmt i
-          and cont_t n printer i = invalid_integer fmt i
-          and cont_f n i = invalid_integer fmt i
-          and cont_m n sfmt i = invalid_integer fmt i in
-          Printf.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
-       | _ ->
-          let rec get j =
-           if j >= len then invalid_integer fmt j else
-           match fmt.[j] with
-           | '0' .. '9' | '-' -> get (succ j)
-           | _ ->
-             let size =
-             if j = i then size_of_int 0 else
-                format_int_of_string fmt j (String.sub fmt i (j - i)) in
-             c size n j in
-          get i
-
-      and skip_gt i =
-       if i >= len then invalid_format fmt i else
-       match fmt.[i] with
-       | ' ' -> skip_gt (succ i)
-       | '>' -> succ i
-       | _ -> invalid_format fmt i
-
-      and get_box_kind i =
-       if i >= len then Pp_box, i else
-       match fmt.[i] with
-       | 'h' ->
-          let i = succ i in
-          if i >= len then Pp_hbox, i else
-          begin match fmt.[i] with
-          | 'o' ->
-             let i = succ i in
-             if i >= len then format_invalid_arg "bad box format" fmt i else
-             begin match fmt.[i] with
-             | 'v' -> Pp_hovbox, succ i
-             | c ->
-                format_invalid_arg
-                  ("bad box name ho" ^ String.make 1 c) fmt i end
-          | 'v' -> Pp_hvbox, succ i
-          | c -> Pp_hbox, i
-          end
-       | 'b' -> Pp_box, succ i
-       | 'v' -> Pp_vbox, succ i
-       | _ -> Pp_box, i
-
-      and get_tag_name n i c =
-       let rec get accu n i j =
-        if j >= len
-        then c (implode_rev (String.sub fmt i (j - i)) accu) n j else
-        match fmt.[j] with
-        | '>' -> c (implode_rev (String.sub fmt i (j - i)) accu) n j
-        | '%' ->
-          let s0 = String.sub fmt i (j - i) in
-          let cont_s n s i = get (s :: s0 :: accu) n i i
-          and cont_a n printer arg i =
-            let s =
-              if str
-              then (Obj.magic printer : unit -> _ -> string) () arg
-              else exstring printer arg in
-            get (s :: s0 :: accu) n i i
-          and cont_t n printer i =
-            let s =
-              if str
-              then (Obj.magic printer : unit -> string) ()
-              else exstring (fun ppf () -> printer ppf) () in
-            get (s :: s0 :: accu) n i i
-          and cont_f n i =
-            format_invalid_arg "bad tag name specification" fmt i
-          and cont_m n sfmt i =
-            format_invalid_arg "bad tag name specification" fmt i in
-          Printf.scan_format fmt v n j cont_s cont_a cont_t cont_f cont_m
-        | c -> get accu n i (succ j) in
-       get [] n i i
-
-      and do_pp_break ppf n i =
-       if i >= len then begin pp_print_space ppf (); doprn n i end else
-       match fmt.[i] with
-       | '<' ->
-          let rec got_nspaces nspaces n i =
-            get_int n i (got_offset nspaces)
-          and got_offset nspaces offset n i =
-            pp_print_break ppf (int_of_size nspaces) (int_of_size offset);
-            doprn n (skip_gt i) in
-          get_int n (succ i) got_nspaces
-       | c -> pp_print_space ppf (); doprn n i
-
-      and do_pp_open_box ppf n i =
-       if i >= len then begin pp_open_box_gen ppf 0 Pp_box; doprn n i end else
-       match fmt.[i] with
-       | '<' ->
-          let kind, i = get_box_kind (succ i) in
-          let got_size size n i =
-            pp_open_box_gen ppf (int_of_size size) kind;
-            doprn n (skip_gt i) in
-          get_int n i got_size
-       | c -> pp_open_box_gen ppf 0 Pp_box; doprn n i
-
-      and do_pp_open_tag ppf n i =
-       if i >= len then begin pp_open_tag ppf ""; doprn n i end else
-       match fmt.[i] with
-       | '<' ->
-          let got_name tag_name n i =
-            pp_open_tag ppf tag_name;
-            doprn n (skip_gt i) in
-          get_tag_name n (succ i) got_name
-       | c -> pp_open_tag ppf ""; doprn n i in
-
-      doprn (Printf.index_of_int 0) 0 in
-
-   Printf.kapr kpr fmt in
-
-  kprintf;;
-
-(**************************************************************
-
-  Defining [fprintf] and various flavors of [fprintf].
-
- **************************************************************)
-
-let kfprintf k ppf = mkprintf false (fun _ -> ppf) k;;
-
-let fprintf ppf = kfprintf ignore ppf;;
-let printf fmt = fprintf std_formatter fmt;;
-let eprintf fmt = fprintf err_formatter fmt;;
-
-let kbprintf k b =
-  mkprintf false (fun _ -> formatter_of_buffer b) k;;
-
-let bprintf b = kbprintf ignore b;;
-
-let ksprintf k =
-  let b = Buffer.create 512 in
-  let k ppf = k (string_out b ppf) in
-  mkprintf true (fun _ -> formatter_of_buffer b) k;;
-
-let kprintf = ksprintf;;
-
-let sprintf fmt = ksprintf (fun s -> s) fmt;;
-
-at_exit print_flush;;