Sync outcome printer.

Author: cristianoc

src/rescript-editor-support/vendor/res_outcome_printer/res_doc.ml

@@ -15,10 +15,10 @@ type t =
   | Text of string
   | Concat of t list
   | Indent of t
-  | IfBreaks of {yes: t; no: t}
+  | IfBreaks of {yes: t; no: t; mutable broken: bool} (* when broken is true, treat as the yes branch *)
   | LineSuffix of t
   | LineBreak of lineStyle
-  | Group of {shouldBreak: bool; doc: t}
+  | Group of {mutable shouldBreak: bool; doc: t}
   | CustomLayout of t list
   | BreakParent
 
@@ -43,7 +43,7 @@ let rec _concat acc l =
 let concat l = Concat(_concat [] l)
 
 let indent d = Indent d
-let ifBreaks t f = IfBreaks {yes = t; no = f}
+let ifBreaks t f = IfBreaks {yes = t; no = f; broken = false}
 let lineSuffix d = LineSuffix d
 let group d = Group {shouldBreak = false; doc = d}
 let breakableGroup ~forceBreak d = Group {shouldBreak = forceBreak; doc = d}
@@ -66,55 +66,52 @@ let rbracket = Text "]"
 let question = Text "?"
 let tilde = Text "~"
 let equal = Text "="
-let trailingComma = IfBreaks {yes = comma; no = nil}
+let trailingComma = ifBreaks comma nil
 let doubleQuote = Text "\""
 
 let propagateForcedBreaks doc =
   let rec walk doc = match doc with
   | Text _ | Nil | LineSuffix _ ->
-    (false, doc)
+    false
   | BreakParent ->
-    (true, Nil)
+    true
   | LineBreak (Hard | Literal) ->
-    (true, doc)
+    true
   | LineBreak (Classic | Soft) ->
-    (false, doc)
+    false
   | Indent children ->
-    let (childForcesBreak, newChildren) = walk children in
-    (childForcesBreak, Indent newChildren)
-  | IfBreaks {yes = trueDoc; no = falseDoc} ->
-    let (falseForceBreak, falseDoc) = walk falseDoc in
+    let childForcesBreak = walk children in
+    childForcesBreak
+  | IfBreaks ({yes = trueDoc; no = falseDoc} as ib) ->
+    let falseForceBreak = walk falseDoc in
     if falseForceBreak then
-      let (_, trueDoc) = walk trueDoc in
-      (true, trueDoc)
+      let _ = walk trueDoc in
+      ib.broken <- true;
+      true
     else
-      let forceBreak, trueDoc = walk trueDoc in
-      (forceBreak, IfBreaks {yes = trueDoc; no = falseDoc})
-  | Group {shouldBreak = forceBreak; doc = children} ->
-    let (childForcesBreak, newChildren) = walk children in
+      let forceBreak = walk trueDoc in
+      forceBreak
+  | Group ({shouldBreak = forceBreak; doc = children} as gr) ->
+    let childForcesBreak = walk children in
     let shouldBreak = forceBreak || childForcesBreak in
-    (shouldBreak, Group {shouldBreak; doc = newChildren})
+    gr.shouldBreak <- shouldBreak;
+    shouldBreak
   | Concat children ->
-    let (forceBreak, newChildren) = List.fold_left (fun (forceBreak, newChildren) child ->
-      let (childForcesBreak, newChild) = walk child in
-      (forceBreak || childForcesBreak, newChild::newChildren)
-    ) (false, []) children
-    in
-    (forceBreak, Concat (List.rev newChildren))
+    List.fold_left (fun forceBreak child ->
+      let childForcesBreak = walk child in
+      forceBreak || childForcesBreak
+    ) false children
   | CustomLayout children ->
     (* When using CustomLayout, we don't want to propagate forced breaks
      * from the children up. By definition it picks the first layout that fits
      * otherwise it takes the last of the list.
      * However we do want to propagate forced breaks in the sublayouts. They
      * might need to be broken. We just don't propagate them any higher here *)
-    let children = match walk (Concat children) with
-    | (_, Concat children) -> children
-    | _ -> assert false
-    in
-    (false, CustomLayout children)
+    let _ = walk (Concat children) in
+    false
   in
-  let (_, processedDoc) = walk doc in
-  processedDoc
+  let _ = walk doc in
+  ()
 
 (* See documentation in interface file *)
 let rec willBreak doc = match doc with
@@ -153,6 +150,7 @@ let fits w stack =
     | Break, LineBreak _ -> result := Some true
     | _, Group {shouldBreak = true; doc} -> calculate indent Break doc
     | _, Group {doc} -> calculate indent mode doc
+    | _, IfBreaks {yes = breakDoc; broken = true} -> calculate indent mode breakDoc
     | Break, IfBreaks {yes = breakDoc} -> calculate indent mode breakDoc
     | Flat, IfBreaks {no = flatDoc} -> calculate indent mode flatDoc
     | _, Concat docs -> calculateConcat indent mode docs
@@ -180,7 +178,7 @@ let fits w stack =
   calculateAll stack
 
 let toString ~width doc =
-  let doc = propagateForcedBreaks doc in
+  propagateForcedBreaks doc;
   let buffer = MiniBuffer.create 1000 in
 
   let rec process ~pos lineSuffices stack =
@@ -199,6 +197,8 @@ let toString ~width doc =
         process ~pos lineSuffices (List.append ops rest)
       | Indent doc ->
         process ~pos lineSuffices ((ind + 2, mode, doc)::rest)
+      | IfBreaks {yes = breakDoc; broken = true} ->
+        process ~pos lineSuffices ((ind, mode, breakDoc)::rest)
       | IfBreaks {yes = breakDoc; no = flatDoc} ->
         if mode = Break then
           process ~pos lineSuffices ((ind, mode, breakDoc)::rest)
@@ -309,6 +309,7 @@ let debug t =
           softLine;
           text ")";
         ]
+    | IfBreaks {yes = trueDoc; broken = true} -> toDoc trueDoc
     | IfBreaks {yes = trueDoc; no = falseDoc} ->
       group(
         concat [

src/rescript-editor-support/vendor/res_outcome_printer/res_outcome_printer.ml

@@ -435,8 +435,8 @@ let printPolyVarIdent txt =
              )
            ]
          );
-         Doc.softLine;
          Doc.trailingComma;
+         Doc.softLine;
          Doc.rbrace;
        ]
      )
@@ -678,29 +678,22 @@ let printPolyVarIdent txt =
      let constraints =  match outTypeDecl.otype_cstrs with
      | [] -> Doc.nil
      | _ -> Doc.group (
-       Doc.concat [
-         Doc.line;
-         Doc.indent (
-           Doc.concat [
-             Doc.hardLine;
-             Doc.join ~sep:Doc.line (List.map (fun (typ1, typ2) ->
-               Doc.group (
-                 Doc.concat [
-                   Doc.text "constraint ";
-                   printOutTypeDoc typ1;
-                   Doc.text " =";
-                   Doc.indent (
-                     Doc.concat [
-                       Doc.line;
-                       printOutTypeDoc typ2;
-                     ]
-                   )
-                 ]
-               )
-             ) outTypeDecl.otype_cstrs)
-           ]
-         )
-       ]
+       Doc.indent (
+         Doc.concat [
+           Doc.hardLine;
+           Doc.join ~sep:Doc.line (List.map (fun (typ1, typ2) ->
+             Doc.group (
+               Doc.concat [
+                 Doc.text "constraint ";
+                 printOutTypeDoc typ1;
+                 Doc.text " =";
+                     Doc.space;
+                     printOutTypeDoc typ2;
+               ]
+             )
+           ) outTypeDecl.otype_cstrs)
+         ]
+       )
      ) in
      Doc.group (
        Doc.concat [

src/rescript-editor-support/vendor/res_outcome_printer/res_token.ml

@@ -44,7 +44,7 @@ type t =
   | Lazy
   | Tilde
   | Question
-  | If | Else | For | In | To | Downto | While | Switch
+  | If | Else | For | In | While | Switch
   | When
   | EqualGreater | MinusGreater
   | External
@@ -55,7 +55,6 @@ type t =
   | Include
   | Module
   | Of
-  | With
   | Land | Lor
   | Band (* Bitwise and: & *)
   | BangEqual | BangEqualEqual
@@ -131,8 +130,6 @@ let toString = function
   | Else -> "else"
   | For -> "for"
   | In -> "in"
-  | To -> "to"
-  | Downto -> "downto"
   | While -> "while"
   | Switch -> "switch"
   | When -> "when"
@@ -145,7 +142,6 @@ let toString = function
   | Include -> "include"
   | Module -> "module"
   | Of -> "of"
-  | With -> "with"
   | Lor -> "||"
   | Band -> "&" | Land -> "&&"
   | BangEqual -> "!=" | BangEqualEqual -> "!=="
@@ -164,48 +160,43 @@ let toString = function
   | Export -> "export"
 
 let keywordTable = function
-| "true" -> True
-| "false" -> False
-| "open" -> Open
-| "let" -> Let
-| "rec" -> Rec
 | "and" -> And
 | "as" -> As
-| "exception" -> Exception
 | "assert" -> Assert
-| "lazy" -> Lazy
-| "if" -> If
+| "constraint" -> Constraint
 | "else" -> Else
+| "exception" -> Exception
+| "export" -> Export
+| "external" -> External
+| "false" -> False
 | "for" -> For
+| "if" -> If
+| "import" -> Import
 | "in" -> In
-| "to" -> To
-| "downto" -> Downto
-| "while" -> While
-| "switch" -> Switch
-| "when" -> When
-| "external" -> External
-| "type" -> Typ
-| "private" -> Private
-| "mutable" -> Mutable
-| "constraint" -> Constraint
 | "include" -> Include
+| "lazy" -> Lazy
+| "let" -> Let
+| "list{" -> List
 | "module" -> Module
+| "mutable" -> Mutable
 | "of" -> Of
-| "list{" -> List
-| "with" -> With
+| "open" -> Open
+| "private" -> Private
+| "rec" -> Rec
+| "switch" -> Switch
+| "true" -> True
 | "try" -> Try
-| "import" -> Import
-| "export" -> Export
+| "type" -> Typ
+| "when" -> When
+| "while" -> While
 | _ -> raise Not_found
 [@@raises Not_found]
 
 let isKeyword = function
-  | True | False | Open | Let | Rec | And | As
-  | Exception | Assert | Lazy | If | Else | For | In | To
-  | Downto | While | Switch | When | External | Typ | Private
-  | Mutable | Constraint | Include | Module | Of
-  | Land | Lor | List | With
-  | Try | Import | Export -> true
+  | And | As | Assert | Constraint | Else | Exception | Export
+  | External | False | For | If | Import | In | Include | Land | Lazy
+  | Let | List | Lor | Module | Mutable | Of | Open | Private | Rec
+  | Switch | True | Try | Typ | When | While -> true
   | _ -> false
 
 let lookupKeyword str =