Skip to content
This repository was archived by the owner on Apr 24, 2021. It is now read-only.

Sync outcome printer. #82

Merged
merged 1 commit into from
Mar 29, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
67 changes: 34 additions & 33 deletions src/rescript-editor-support/vendor/res_outcome_printer/res_doc.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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}
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand All @@ -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)
Expand Down Expand Up @@ -309,6 +309,7 @@ let debug t =
softLine;
text ")";
]
| IfBreaks {yes = trueDoc; broken = true} -> toDoc trueDoc
| IfBreaks {yes = trueDoc; no = falseDoc} ->
group(
concat [
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -435,8 +435,8 @@ let printPolyVarIdent txt =
)
]
);
Doc.softLine;
Doc.trailingComma;
Doc.softLine;
Doc.rbrace;
]
)
Expand Down Expand Up @@ -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 [
Expand Down
57 changes: 24 additions & 33 deletions src/rescript-editor-support/vendor/res_outcome_printer/res_token.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -55,7 +55,6 @@ type t =
| Include
| Module
| Of
| With
| Land | Lor
| Band (* Bitwise and: & *)
| BangEqual | BangEqualEqual
Expand Down Expand Up @@ -131,8 +130,6 @@ let toString = function
| Else -> "else"
| For -> "for"
| In -> "in"
| To -> "to"
| Downto -> "downto"
| While -> "while"
| Switch -> "switch"
| When -> "when"
Expand All @@ -145,7 +142,6 @@ let toString = function
| Include -> "include"
| Module -> "module"
| Of -> "of"
| With -> "with"
| Lor -> "||"
| Band -> "&" | Land -> "&&"
| BangEqual -> "!=" | BangEqualEqual -> "!=="
Expand All @@ -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 =
Expand Down