Format: Add functions for printing conditionally on line breaks

stdlib/format.ml

@@ -62,6 +62,15 @@ type pp_token =
   | Pp_newline                 (* to force a newline inside a box *)
   | Pp_if_newline              (* to do something only if this very
                                   line has been broken *)
+  | Pp_string_if_newline of string
+                               (* print a string only if this very
+                                  line has been broken *)
+  | Pp_break_or_string_if_newline of int * int * string
+                               (* print a break if this very line has not
+                                  been broken, otherwise print a string *)
+  | Pp_fits_or_breaks of string * int * int * string
+                               (* print a string if the enclosing box fits,
+                                  otherwise print a break and a string *)
   | Pp_open_tag of tag         (* opening a tag name *)
   | Pp_close_tag               (* closing the most recently open tag *)
 
@@ -419,6 +428,13 @@ let format_pp_token state size = function
     if state.pp_current_indent != state.pp_margin - state.pp_space_left
     then pp_skip_token state
 
+  | Pp_string_if_newline s ->
+    if state.pp_is_new_line then begin
+      state.pp_space_left <- state.pp_space_left - (String.length s);
+      pp_output_string state s;
+      state.pp_is_new_line <- false
+    end
+
   | Pp_break (n, off) ->
     begin match state.pp_format_stack with
     | Format_elem (ty, width) :: _ ->
@@ -444,6 +460,59 @@ let format_pp_token state size = function
     | [] -> () (* No open box. *)
     end
 
+  | Pp_break_or_string_if_newline (n, off, s) ->
+    if state.pp_is_new_line then begin
+      state.pp_space_left <- state.pp_space_left - (String.length s);
+      pp_output_string state s;
+      state.pp_is_new_line <- false
+    end
+    else
+    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 open box. *)
+    end
+
+  | Pp_fits_or_breaks (fits, n, off, breaks) ->
+    begin match state.pp_format_stack with
+    | Format_elem (ty, width) :: _ ->
+        let text =
+          if ty = Pp_fits then
+            fits
+          else begin
+            if off >= 0 then begin
+              if size + String.length breaks >= state.pp_space_left
+              then break_new_line state off width
+              else break_same_line state n
+            end;
+            breaks
+          end in
+        if text <> "" then begin
+          state.pp_space_left <- state.pp_space_left - (String.length text);
+          pp_output_string state text;
+          state.pp_is_new_line <- false
+        end
+    | [] -> () (* No open box. *)
+    end
+
    | Pp_open_tag tag_name ->
      let marker = state.pp_mark_open_tag tag_name in
      pp_output_string state marker;
@@ -534,7 +603,8 @@ let set_size state ty =
     (* 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 (_, _) ->
+      | Pp_break (_, _) | Pp_tbreak (_, _)
+      | Pp_break_or_string_if_newline _ | Pp_fits_or_breaks _ ->
         if ty then
         begin
           queue_elem.elem_size <- size_of_int (state.pp_right_total + size);
@@ -547,7 +617,7 @@ let set_size state ty =
           state.pp_scan_stack <- t
         end
       | Pp_text _ | Pp_stab | Pp_tbegin _ | Pp_tend | Pp_end
-      | Pp_newline | Pp_if_newline
+      | Pp_newline | Pp_if_newline | Pp_string_if_newline _
       | Pp_open_tag _ | Pp_close_tag ->
         () (* scan_push is only used for breaks and boxes. *)
       end
@@ -757,6 +827,14 @@ let pp_print_if_newline state () =
     enqueue_advance state (make_queue_elem (size_of_int 0) Pp_if_newline 0)
 
 
+(* To format a string, only in case the line has just been broken. *)
+let pp_print_string_if_newline state s =
+  if state.pp_curr_depth < state.pp_max_boxes then
+    let len = String.length s in
+    let size = size_of_int 0 in
+    enqueue_advance state (make_queue_elem size (Pp_string_if_newline s) len)
+
+
 (* Printing break hints:
    A break hint indicates where a box may be broken.
    If line is broken then offset is added to the indentation of the current
@@ -771,6 +849,28 @@ let pp_print_break state width offset =
     scan_push state true elem
 
 
+(* To format a break, only in case the line has not just been broken, or a
+   string, in case the line has just been broken. *)
+let pp_print_break_or_string_if_newline state width offset s =
+  if state.pp_curr_depth < state.pp_max_boxes then
+    let elem =
+      make_queue_elem
+        (size_of_int (- state.pp_right_total))
+        (Pp_break_or_string_if_newline (width, offset, s))
+        width in
+    scan_push state true elem
+
+
+let pp_print_fits_or_breaks state fits nspaces offset breaks =
+  if state.pp_curr_depth < state.pp_max_boxes then
+    let elem =
+      make_queue_elem
+        (size_of_int (- state.pp_right_total))
+        (Pp_fits_or_breaks (fits, nspaces, offset, breaks))
+        (String.length fits) in
+    scan_push state true elem
+
+
 (* Print a space :
    a space is a break hint that prints a single space if the break does not
    split the line;
@@ -1142,6 +1242,9 @@ 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 print_string_if_newline = pp_print_string_if_newline std_formatter
+and print_break_or_string_if_newline = pp_print_break_or_string_if_newline std_formatter
+and print_fits_or_breaks = pp_print_fits_or_breaks std_formatter
 
 and open_tbox = pp_open_tbox std_formatter
 and close_tbox = pp_close_tbox std_formatter

stdlib/format.mli

@@ -262,6 +262,20 @@ val print_if_newline : unit -> unit
   command.
 *)
 
+val print_string_if_newline : string -> unit
+(** Similar to [print_if_newline] followed by [print_string] except that the
+  length of the string does not contribute to the width of the enclosing
+  box. *)
+
+val print_break_or_string_if_newline : int -> int -> string -> unit
+(** Print a full break hint if the preceding line has not just been split.
+  Otherwise, print a string. *)
+
+val print_fits_or_breaks : string -> int -> int -> string -> unit
+(** [print_fits_or_breaks fits nspaces offset breaks] prints [fits] if the
+  enclosing box fits on one line. Otherwise, prints a break as per
+  [print_break nspaces offset] followed by [breaks]. *)
+
 (** {6 Pretty-printing termination} *)
 
 val print_flush : unit -> unit
@@ -871,6 +885,11 @@ val pp_force_newline : formatter -> unit -> unit
 val pp_print_flush : formatter -> unit -> unit
 val pp_print_newline : formatter -> unit -> unit
 val pp_print_if_newline : formatter -> unit -> unit
+val pp_print_string_if_newline : formatter -> string -> unit
+val pp_print_break_or_string_if_newline :
+  formatter -> int -> int -> string -> unit
+val pp_print_fits_or_breaks :
+  formatter -> string -> int -> int -> string -> unit
 val pp_set_tags : formatter -> bool -> unit
 val pp_set_print_tags : formatter -> bool -> unit
 val pp_set_mark_tags : formatter -> bool -> unit

testsuite/tests/lib-format/prNNNN.ml

@@ -0,0 +1,83 @@
+let set_margin n =
+  Format.set_margin n;
+  Format.set_max_indent (n - 1)
+
+open Format;;
+
+let test_print_string_if_newline m b =
+  set_margin m;
+  open_hovbox 2;
+  print_string "before";
+  print_space ();
+  if b then (
+    print_if_newline ();
+    print_string "if newline"
+  ) else (
+    print_string_if_newline "if newline"
+  );
+  print_space ();
+  print_string "after";
+  open_hvbox 2;
+  print_space ();
+  print_string "later";
+  close_box ();
+  close_box ();
+  print_newline ()
+;;
+
+let print_if_newline_vs_print_string_if_newline m =
+  print_string "margin = ";
+  print_int m;
+  print_newline ();
+  print_endline "using print_if_newline:";
+  test_print_string_if_newline m true;
+  print_endline "using print_string_if_newline:";
+  test_print_string_if_newline m false;
+  print_newline ()
+;;
+
+print_if_newline_vs_print_string_if_newline 17;;
+print_if_newline_vs_print_string_if_newline 18;;
+print_if_newline_vs_print_string_if_newline 20;;
+print_if_newline_vs_print_string_if_newline 30;;
+
+let test_print_break_or_string_if_newline m =
+  print_string "margin = ";
+  print_int m;
+  print_newline ();
+  set_margin m;
+  open_hvbox 2;
+  print_string "before";
+  print_space ();
+  print_break_or_string_if_newline 1 0 "broke ";
+  print_string "after";
+  print_space ();
+  print_string "final";
+  close_box ();
+  print_newline ()
+;;
+
+test_print_break_or_string_if_newline 19;;
+test_print_break_or_string_if_newline 20;;
+
+print_newline ();;
+
+let test_print_fits_or_breaks m =
+  print_string "margin = ";
+  print_int m;
+  print_newline ();
+  set_margin m;
+  open_hvbox 2;
+  print_string "before";
+  print_space ();
+  print_string "after";
+  print_space ();
+  print_fits_or_breaks "fit" 1 0 "broke";
+  print_space ();
+  print_string "final";
+  close_box ();
+  print_newline ()
+;;
+
+test_print_fits_or_breaks 22;;
+test_print_fits_or_breaks 23;;

testsuite/tests/lib-format/prNNNN.reference

@@ -0,0 +1,50 @@
+margin = 17
+using print_if_newline:
+before
+  if newline
+  after later
+using print_string_if_newline:
+before
+  if newline
+  after later
+
+margin = 18
+using print_if_newline:
+before 
+  after
+        later
+using print_string_if_newline:
+before 
+  after later
+
+margin = 20
+using print_if_newline:
+before 
+  after
+        later
+using print_string_if_newline:
+before  after
+   later
+
+margin = 30
+using print_if_newline:
+before  after later
+using print_string_if_newline:
+before  after later
+
+margin = 19
+before
+  broke after
+  final
+margin = 20
+before  after final
+
+margin = 22
+before
+  after
+   broke
+  final
+margin = 23
+before after fit final
+
+All tests succeeded.