Fix stack overflow on large string constants (#1562)

CHANGES.md

@@ -16,9 +16,11 @@
   + Fix comments on the same line as prev and next elements (#1556, @gpetiot)
 
   + Break or-patterns after comments and preserve their position at the end of line (#1555, @gpetiot)
-  
+
   + Fix linebreak between signature items of the same group (#1560, @gpetiot)
 
+  + Fix stack overflow on large string constants (#1562, @gpetiot)
+
 #### Changes
 
   + Add buffer filename in the logs when applying ocamlformat (#1557, @dannywillems)

lib/Fmt.ml

@@ -137,16 +137,18 @@ let list_pn x1N pp =
   | [] -> noop
   | [x1] -> lazy_ (fun () -> pp ~prev:None x1 ~next:None)
   | x1 :: (x2 :: _ as x2N) ->
-      lazy_ (fun () -> pp ~prev:None x1 ~next:(Some x2))
-      $
-      let rec list_pn_ prev = function
-        | [] -> noop
-        | [xI] -> lazy_ (fun () -> pp ~prev:(Some prev) xI ~next:None)
-        | xI :: (xJ :: _ as xJN) ->
-            lazy_ (fun () -> pp ~prev:(Some prev) xI ~next:(Some xJ))
-            $ list_pn_ xI xJN
+      let l =
+        let rec aux (prev, acc) = function
+          | [] -> acc
+          | [xI] -> aux (xI, (Some prev, xI, None) :: acc) []
+          | xI :: (xJ :: _ as xJN) ->
+              aux (xI, (Some prev, xI, Some xJ) :: acc) xJN
+        in
+        aux (x1, [(None, x1, Some x2)]) x2N
       in
-      list_pn_ x1 x2N
+      List.rev_map l ~f:(fun (prev, x, next) ->
+          lazy_ (fun () -> pp ~prev x ~next) )
+      |> sequence
 
 let list_fl xs pp =
   list_pn xs (fun ~prev x ~next ->

test/cli/large_string.t

@@ -0,0 +1,3 @@
+  $ echo "let _ = \"$(printf '%*s' 300000 | sed 's/ /_ _/g')\"" > a.ml
+
+  $ ocamlformat --impl a.ml -o /dev/null