diff --git a/src/rescript-editor-support/vendor/res_outcome_printer/res_doc.ml b/src/rescript-editor-support/vendor/res_outcome_printer/res_doc.ml index 2d798b94..63a9a731 100644 --- a/src/rescript-editor-support/vendor/res_outcome_printer/res_doc.ml +++ b/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 [ diff --git a/src/rescript-editor-support/vendor/res_outcome_printer/res_outcome_printer.ml b/src/rescript-editor-support/vendor/res_outcome_printer/res_outcome_printer.ml index e7bfac47..7300bef4 100644 --- a/src/rescript-editor-support/vendor/res_outcome_printer/res_outcome_printer.ml +++ b/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 [ diff --git a/src/rescript-editor-support/vendor/res_outcome_printer/res_token.ml b/src/rescript-editor-support/vendor/res_outcome_printer/res_token.ml index b6a3eede..a14491dd 100644 --- a/src/rescript-editor-support/vendor/res_outcome_printer/res_token.ml +++ b/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 =