Update to latest stdune

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

Author: rgrinberg

fiber-test/fiber_test.ml

@@ -2,7 +2,7 @@ open Stdune
 
 let printf = Printf.printf
 
-let print pp = Format.printf "%a@." Pp.render_ignore_tags pp
+let print pp = Format.printf "%a@." Pp.to_fmt pp
 
 let print_dyn dyn = print (Dyn.pp dyn)
 

lsp/bin/ocaml/ocaml.ml

@@ -189,7 +189,7 @@ module Json = struct
     )
 
   let is_json_constr (constr : Ml.Type.constr) =
-    List.mem constr.name ~set:[ "String"; "Int"; "Bool" ]
+    List.mem [ "String"; "Int"; "Bool" ] constr.name ~equal:String.equal
 
   module Name = struct
     let of_ = sprintf "%s_of_yojson"
@@ -261,7 +261,7 @@ end
 
 let pp_file pp ch =
   let fmt = Format.formatter_of_out_channel ch in
-  Pp.render_ignore_tags fmt pp;
+  Pp.to_fmt fmt pp;
   Format.pp_print_flush fmt ()
 
 module Create = struct
@@ -531,7 +531,8 @@ module Mapper = struct
       [ Prim.Null; String; Bool; Number; Object; List ]
       |> List.map ~f:(fun s -> Resolved.Ident s)
     in
-    fun set -> List.for_all constrs ~f:(List.mem ~set)
+    fun set ->
+      List.for_all constrs ~f:(fun e -> List.mem set e ~equal:Poly.equal)
 
   let id = Type.name "Jsonrpc.Id.t"
 

ocaml-lsp-server/src/import.ml

@@ -9,6 +9,7 @@ module Table = Stdune.Table
 module String = Stdune.String
 module List = Stdune.List
 module Result = Stdune.Result
+module Poly = Stdune.Poly
 module Logger = Lsp.Logger
 module Loc = Location
 module Scheduler = Fiber_unix.Scheduler

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -179,7 +179,8 @@ let code_action (state : State.t) (params : CodeActionParams.t) =
   let* doc = Fiber.return (Document_store.get store uri) in
   let code_action (kind, f) =
     match params.context.only with
-    | Some set when not (List.mem kind ~set) -> Fiber.return (Ok None)
+    | Some set when not (List.mem set kind ~equal:Poly.equal) ->
+      Fiber.return (Ok None)
     | Some _
     | None ->
       let+ action_opt = f () in
@@ -250,7 +251,7 @@ let markdown_support (client_capabilities : ClientCapabilities.t) ~field =
     | None -> false
     | Some format ->
       let set = Option.value format ~default:[ MarkupKind.Markdown ] in
-      List.mem MarkupKind.Markdown ~set)
+      List.mem  set MarkupKind.Markdown ~equal:Poly.equal)
 
 let location_of_merlin_loc uri = function
   | `At_origin

vendor/stdune/ansi_color.ml vendor/stdune-unstable/ansi_color.mlvendor/stdune/ansi_color.ml renamed to vendor/stdune-unstable/ansi_color.ml

@@ -85,10 +85,10 @@ end
 
 let term_supports_color =
   lazy
-    ( match Stdlib.Sys.getenv "TERM" with
+    (match Stdlib.Sys.getenv "TERM" with
     | exception Not_found -> false
     | "dumb" -> false
-    | _ -> true )
+    | _ -> true)
 
 let stdout_supports_color =
   lazy (Lazy.force term_supports_color && Unix.isatty Unix.stdout)
@@ -98,16 +98,17 @@ let stderr_supports_color =
 
 let rec tag_handler current_styles ppf styles pp =
   Format.pp_print_as ppf 0 (Style.escape_sequence_no_reset styles);
-  Pp.render ppf pp ~tag_handler:(tag_handler (current_styles @ styles));
+  Pp.to_fmt_with_tags ppf pp
+    ~tag_handler:(tag_handler (current_styles @ styles));
   Format.pp_print_as ppf 0 (Style.escape_sequence current_styles)
 
 let make_printer supports_color ppf =
   let f =
     lazy
-      ( if Lazy.force supports_color then
-        Pp.render ppf ~tag_handler:(tag_handler [])
+      (if Lazy.force supports_color then
+        Pp.to_fmt_with_tags ppf ~tag_handler:(tag_handler [])
       else
-        Pp.render_ignore_tags ppf )
+        Pp.to_fmt ppf)
   in
   Staged.stage (fun pp ->
       Lazy.force f pp;
@@ -182,7 +183,7 @@ let parse_line str styles =
                      | _ -> s :: styles)
               |> List.rev
           in
-          loop styles (seq_end + 1) acc )
+          loop styles (seq_end + 1) acc)
   in
   loop styles 0 Pp.nop
 

vendor/stdune/ansi_color.mli vendor/stdune-unstable/ansi_color.mlivendor/stdune/ansi_color.mli renamed to vendor/stdune-unstable/ansi_color.mli

@@ -7,3 +7,8 @@ let singleton x k = x :: k
 let to_list l = l []
 
 let ( @ ) a b k = a (b k)
+
+let rec concat l k =
+  match l with
+  | [] -> k
+  | t :: l -> t (concat l k)

vendor/stdune/appendable_list.ml vendor/stdune-unstable/appendable_list.mlvendor/stdune/appendable_list.ml renamed to vendor/stdune-unstable/appendable_list.ml

@@ -9,4 +9,6 @@ val singleton : 'a -> 'a t
 
 val ( @ ) : 'a t -> 'a t -> 'a t
 
+val concat : 'a t list -> 'a t
+
 val to_list : 'a t -> 'a list

vendor/stdune/appendable_list.mli …ndor/stdune-unstable/appendable_list.mlivendor/stdune/appendable_list.mli renamed to vendor/stdune-unstable/appendable_list.mli vendor/stdune/appendable_list.mli renamed to vendor/stdune-unstable/appendable_list.mli

@@ -1,4 +1,6 @@
-module Make (A : Applicative_intf.S1_base) = struct
+module type Basic = Applicative_intf.Basic
+
+module Make (A : Applicative_intf.Basic) = struct
   include A
 
   module O = struct
@@ -21,6 +23,7 @@ module Make (A : Applicative_intf.S1_base) = struct
       and+ xs = all xs in
       x :: xs
 end
+[@@inlined always]
 
 module Id = struct
   include Make (struct

vendor/stdune/applicative.ml vendor/stdune-unstable/applicative.mlvendor/stdune/applicative.ml renamed to vendor/stdune-unstable/applicative.ml

@@ -0,0 +1,6 @@
+module type Basic = Applicative_intf.Basic
+
+module Make (A : Basic) : Applicative_intf.S with type 'a t := 'a A.t
+[@@inlined always]
+
+module Id : Applicative_intf.S with type 'a t = 'a