Add Out_channel.{is,set}_buffered to control buffering of output channels

Changes

@@ -45,6 +45,10 @@ Working version
   (Nicolás Ojeda Bär, review by Daniel Bünzli, Simon Cruanes, Gabriel Scherer,
   Guillaume Munch-Maccagnoni, Alain Frisch and Xavier Leroy)
 
+- #10538: add Out_channel.set_buffering_mode to allow changing the buffering
+  mode of output channels.
+  (Nicolás Ojeda Bär, review by John Whitington, David Allsopp and Xavier Leroy)
+
 ### Other libraries:
 
 - #10192: Add support for Unix domain sockets on Windows and use them

runtime/caml/io.h

@@ -52,6 +52,7 @@ enum {
   CHANNEL_FLAG_FROM_SOCKET = 1,  /* For Windows */
   CHANNEL_FLAG_MANAGED_BY_GC = 4,  /* Free and close using GC finalization */
   CHANNEL_TEXT_MODE = 8,           /* "Text mode" for Windows and Cygwin */
+  CHANNEL_FLAG_UNBUFFERED = 16     /* Unbuffered (for output channels only) */
 };
 
 /* For an output channel:
@@ -109,6 +110,8 @@ CAMLextern struct channel * caml_all_opened_channels;
   if (caml_channel_mutex_unlock != NULL) (*caml_channel_mutex_unlock)(channel)
 #define Unlock_exn() \
   if (caml_channel_mutex_unlock_exn != NULL) (*caml_channel_mutex_unlock_exn)()
+#define Flush_if_unbuffered(channel) \
+  if (channel->flags & CHANNEL_FLAG_UNBUFFERED) caml_flush(channel)
 
 /* Conversion between file_offset and int64_t */
 

runtime/extern.c

@@ -899,6 +899,7 @@ void caml_output_val(struct channel *chan, value v, value flags)
     caml_stat_free(blk);
     blk = nextblk;
   }
+  Flush_if_unbuffered(chan);
 }
 
 CAMLprim value caml_output_value(value vchan, value v, value flags)

runtime/io.c

@@ -650,6 +650,18 @@ CAMLprim value caml_ml_set_binary_mode(value vchannel, value mode)
   return Val_unit;
 }
 
+CAMLprim value caml_ml_set_buffering_mode(value vchannel, value mode)
+{
+  struct channel * channel = Channel(vchannel);
+  if (Bool_val(mode)) {
+    channel->flags &= ~CHANNEL_FLAG_UNBUFFERED;
+  } else {
+    channel->flags |= CHANNEL_FLAG_UNBUFFERED;
+    caml_flush(channel);
+  }
+  return Val_unit;
+}
+
 /*
    If the channel is closed, DO NOT raise a "bad file descriptor"
    exception, but do nothing (the buffer is already empty).
@@ -676,6 +688,7 @@ CAMLprim value caml_ml_output_char(value vchannel, value ch)
 
   Lock(channel);
   Putch(channel, Long_val(ch));
+  Flush_if_unbuffered(channel);
   Unlock(channel);
   CAMLreturn (Val_unit);
 }
@@ -687,6 +700,7 @@ CAMLprim value caml_ml_output_int(value vchannel, value w)
 
   Lock(channel);
   caml_putword(channel, (uint32_t) Long_val(w));
+  Flush_if_unbuffered(channel);
   Unlock(channel);
   CAMLreturn (Val_unit);
 }
@@ -707,6 +721,7 @@ CAMLprim value caml_ml_output_bytes(value vchannel, value buff, value start,
       pos += written;
       len -= written;
     }
+    Flush_if_unbuffered(channel);
   Unlock(channel);
   CAMLreturn (Val_unit);
 }

stdlib/out_channel.ml

@@ -45,3 +45,6 @@ let output_bytes = Stdlib.output_bytes
 let output = Stdlib.output
 let output_substring = Stdlib.output_substring
 let set_binary_mode = Stdlib.set_binary_mode_out
+
+external set_buffering_mode : out_channel -> bool -> unit
+    = "caml_ml_set_buffering_mode"

stdlib/out_channel.mli

@@ -129,3 +129,15 @@ val set_binary_mode : t -> bool -> unit
 
     This function has no effect under operating systems that do not distinguish
     between text mode and binary mode. *)
+
+val set_buffering_mode : out_channel -> bool -> unit
+(** [set_buffering_mode oc true] sets the channel [oc] to {e buffered} mode. In
+    this mode, data output on [oc] will be buffered until either the internal
+    buffer is full or the function {!flush} or {!flush_all} is called, at which
+    point it will be sent to the output device.
+
+    [set_buffering_mode oc false] sets the channel [oc] to {e unbuffered}
+    mode. In this mode, data output on [oc] will be sent to the output device
+    immediately.
+
+    All channels are open in {e buffered} mode by default. *)