From 6a32808c5dba1b1d14c24e43274ea8999bc2530d Mon Sep 17 00:00:00 2001 From: Cheng Lou Date: Mon, 8 Mar 2021 13:11:27 -0800 Subject: [PATCH] Sync up outcome printer No new changes really. Tracking https://github.com/rescript-lang/syntax/commit/9907b82a8ef452c0d5eeaccc54c44a91bd93d19a --- .../res_character_codes.ml | 160 ------------------ .../vendor/res_outcome_printer/res_comment.ml | 7 +- .../vendor/res_outcome_printer/res_doc.ml | 95 +++++++---- .../vendor/res_outcome_printer/res_doc.mli | 2 +- .../res_outcome_printer/res_minibuffer.ml | 2 +- .../res_outcome_printer.ml | 19 ++- .../vendor/res_outcome_printer/res_token.ml | 9 +- 7 files changed, 85 insertions(+), 209 deletions(-) delete mode 100644 src/rescript-editor-support/vendor/res_outcome_printer/res_character_codes.ml diff --git a/src/rescript-editor-support/vendor/res_outcome_printer/res_character_codes.ml b/src/rescript-editor-support/vendor/res_outcome_printer/res_character_codes.ml deleted file mode 100644 index aec713a7..00000000 --- a/src/rescript-editor-support/vendor/res_outcome_printer/res_character_codes.ml +++ /dev/null @@ -1,160 +0,0 @@ -let eof = -1 - -let space = 0x0020 -let newline = 0x0A (* \n *) [@@live] -let lineFeed = 0x0A (* \n *) -let carriageReturn = 0x0D (* \r *) -let lineSeparator = 0x2028 -let paragraphSeparator = 0x2029 - -let tab = 0x09 - -let bang = 0x21 -let dot = 0x2E -let colon = 0x3A -let comma = 0x2C -let backtick = 0x60 -(* let question = 0x3F *) -let semicolon = 0x3B -let underscore = 0x5F -let singleQuote = 0x27 -let doubleQuote = 0x22 -let equal = 0x3D -let bar = 0x7C -let tilde = 0x7E -let question = 0x3F -let ampersand = 0x26 -let at = 0x40 -let dollar = 0x24 -let percent = 0x25 - -let lparen = 0x28 -let rparen = 0x29 -let lbracket = 0x5B -let rbracket = 0x5D -let lbrace = 0x7B -let rbrace = 0x7D - -let forwardslash = 0x2F (* / *) -let backslash = 0x5C (* \ *) - -let greaterThan = 0x3E -let hash = 0x23 -let lessThan = 0x3C - -let minus = 0x2D -let plus = 0x2B -let asterisk = 0x2A - -let _0 = 0x30 -let _1 = 0x31 [@@live] -let _2 = 0x32 [@@live] -let _3 = 0x33 [@@live] -let _4 = 0x34 [@@live] -let _5 = 0x35 [@@live] -let _6 = 0x36 [@@live] -let _7 = 0x37 [@@live] -let _8 = 0x38 [@@live] -let _9 = 0x39 - -module Lower = struct - let a = 0x61 - let b = 0x62 - let c = 0x63 [@@live] - let d = 0x64 [@@live] - let e = 0x65 - let f = 0x66 - let g = 0x67 - let h = 0x68 [@@live] - let i = 0x69 [@@live] - let j = 0x6A [@@live] - let k = 0x6B [@@live] - let l = 0x6C [@@live] - let m = 0x6D [@@live] - let n = 0x6E - let o = 0x6F - let p = 0x70 - let q = 0x71 [@@live] - let r = 0x72 - let s = 0x73 [@@live] - let t = 0x74 - let u = 0x75 [@@live] - let v = 0x76 [@@live] - let w = 0x77 [@@live] - let x = 0x78 - let y = 0x79 [@@live] - let z = 0x7A -end - -module Upper = struct - let a = 0x41 - (* let b = 0x42 *) - let c = 0x43 [@@live] - let d = 0x44 [@@live] - let e = 0x45 [@@live] - let f = 0x46 [@@live] - let g = 0x47 - let h = 0x48 [@@live] - let i = 0x49 [@@live] - let j = 0x4A [@@live] - let k = 0x4B [@@live] - let l = 0x4C [@@live] - let m = 0x4D [@@live] - let b = 0x4E [@@live] - let o = 0x4F [@@live] - let p = 0x50 [@@live] - let q = 0x51 [@@live] - let r = 0x52 [@@live] - let s = 0x53 [@@live] - let t = 0x54 [@@live] - let u = 0x55 [@@live] - let v = 0x56 [@@live] - let w = 0x57 [@@live] - let x = 0x58 [@@live] - let y = 0x59 [@@live] - let z = 0x5a -end - -(* returns lower-case ch, ch should be ascii *) -let lower ch = - (* if ch >= Lower.a && ch <= Lower.z then ch else ch + 32 *) - 32 lor ch - -let isLetter ch = - Lower.a <= ch && ch <= Lower.z || - Upper.a <= ch && ch <= Upper.z - -let isUpperCase ch = - Upper.a <= ch && ch <= Upper.z - -let isDigit ch = _0 <= ch && ch <= _9 - -let isHex ch = - (_0 <= ch && ch <= _9) || - (Lower.a <= (lower ch) && (lower ch) <= Lower.f) - - (* - // ES5 7.3: - // The ECMAScript line terminator characters are listed in Table 3. - // Table 3: Line Terminator Characters - // Code Unit Value Name Formal Name - // \u000A Line Feed - // \u000D Carriage Return - // \u2028 Line separator - // \u2029 Paragraph separator - // Only the characters in Table 3 are treated as line terminators. Other new line or line - // breaking characters are treated as white space but not as line terminators. -*) -let isLineBreak ch = - ch == lineFeed - || ch == carriageReturn - || ch == lineSeparator - || ch == paragraphSeparator - -let digitValue ch = - if _0 <= ch && ch <= _9 then - ch - 48 - else if Lower.a <= (lower ch) && (lower ch) <= Lower.f then - (lower ch) - Lower.a + 10 - else - 16 (* larger than any legal value *) diff --git a/src/rescript-editor-support/vendor/res_outcome_printer/res_comment.ml b/src/rescript-editor-support/vendor/res_outcome_printer/res_comment.ml index a582dcda..bdcd7e56 100644 --- a/src/rescript-editor-support/vendor/res_outcome_printer/res_comment.ml +++ b/src/rescript-editor-support/vendor/res_outcome_printer/res_comment.ml @@ -57,17 +57,16 @@ let trimSpaces s = let len = String.length s in if len = 0 then s else if String.unsafe_get s 0 = ' ' || String.unsafe_get s (len - 1) = ' ' then ( - let b = Bytes.of_string s in let i = ref 0 in - while !i < len && (Bytes.unsafe_get b !i) = ' ' do + while !i < len && (String.unsafe_get s !i) = ' ' do incr i done; let j = ref (len - 1) in - while !j >= !i && (Bytes.unsafe_get b !j) = ' ' do + while !j >= !i && (String.unsafe_get s !j) = ' ' do decr j done; if !j >= !i then - (Bytes.sub [@doesNotRaise]) b !i (!j - !i + 1) |> Bytes.to_string + (String.sub [@doesNotRaise]) s !i (!j - !i + 1) else "" ) else s \ No newline at end of file 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 a3e7482b..2d798b94 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 @@ -28,7 +28,20 @@ let hardLine = LineBreak Hard let softLine = LineBreak Soft let literalLine = LineBreak Literal let text s = Text s -let concat l = Concat l + +(* Optimization. We eagerly collapse and reduce whatever allocation we can *) +let rec _concat acc l = + match l with + | Text s1 :: Text s2 :: rest -> Text (s1 ^ s2) :: _concat acc rest + | Nil :: rest -> _concat acc rest + | Concat l2 :: rest -> _concat (_concat acc rest) l2 (* notice the order here *) + | x :: rest -> + let rest1 = _concat acc rest in + if rest1 == rest then l else x :: rest1 + | [] -> acc + +let concat l = Concat(_concat [] l) + let indent d = Indent d let ifBreaks t f = IfBreaks {yes = t; no = f} let lineSuffix d = LineSuffix d @@ -118,39 +131,53 @@ let join ~sep docs = | [x] -> List.rev (x::acc) | x::xs -> loop (sep::x::acc) sep xs in - Concat(loop [] sep docs) + concat(loop [] sep docs) + +let fits w stack = + let width = ref w in + let result = ref None in -let rec fits w doc = match doc with - | _ when w < 0 -> false - | [] -> true - | (_ind, _mode, Text txt)::rest -> fits (w - String.length txt) rest - | (ind, mode, Indent doc)::rest -> fits w ((ind + 2, mode, doc)::rest) - | (_ind, Flat, LineBreak break)::rest -> - if break = Hard || break = Literal then true - else - let w = if break = Classic then w - 1 else w in - fits w rest - | (_ind, _mode, Nil)::rest -> fits w rest - | (_ind, Break, LineBreak _break)::_rest -> true - | (ind, mode, Group {shouldBreak = forceBreak; doc})::rest -> - let mode = if forceBreak then Break else mode in - fits w ((ind, mode, doc)::rest) - | (ind, mode, IfBreaks {yes = breakDoc; no = flatDoc})::rest -> - if mode = Break then - fits w ((ind, mode, breakDoc)::rest) - else - fits w ((ind, mode, flatDoc)::rest) - | (ind, mode, Concat docs)::rest -> - let ops = List.map (fun doc -> (ind, mode, doc)) docs in - fits w (List.append ops rest) - (* | (_ind, _mode, Cursor)::rest -> fits w rest *) - | (_ind, _mode, LineSuffix _)::rest -> fits w rest - | (_ind, _mode, BreakParent)::rest -> fits w rest - | (ind, mode, CustomLayout (hd::_))::rest -> - (* TODO: if we have nested custom layouts, what we should do here? *) - fits w ((ind, mode, hd)::rest) - | (_ind, _mode, CustomLayout _)::rest -> - fits w rest + let rec calculate indent mode doc = + match mode, doc with + | _ when result.contents != None -> () + | _ when width.contents < 0 -> result := Some false + | _, Nil + | _, LineSuffix _ + | _, BreakParent -> () + | _, Text txt -> width := width.contents - (String.length txt) + | _, Indent doc -> calculate (indent + 2) mode doc + | Flat, LineBreak Hard + | Flat, LineBreak Literal -> result := Some true + | Flat, LineBreak Classic -> width := width.contents - 1 + | Flat, LineBreak Soft -> () + | Break, LineBreak _ -> result := Some true + | _, Group {shouldBreak = true; doc} -> calculate indent Break doc + | _, Group {doc} -> calculate indent mode doc + | Break, IfBreaks {yes = breakDoc} -> calculate indent mode breakDoc + | Flat, IfBreaks {no = flatDoc} -> calculate indent mode flatDoc + | _, Concat docs -> calculateConcat indent mode docs + | _, CustomLayout (hd::_) -> + (* TODO: if we have nested custom layouts, what we should do here? *) + calculate indent mode hd + | _, CustomLayout [] -> () + and calculateConcat indent mode docs = + if result.contents == None then ( + match docs with + | [] -> () + | doc::rest -> + calculate indent mode doc; + calculateConcat indent mode rest + ) + in + let rec calculateAll stack = + match result.contents, stack with + | Some r, _ -> r + | None, [] -> !width >= 0 + | None, (indent, mode, doc)::rest -> + calculate indent mode doc; + calculateAll rest + in + calculateAll stack let toString ~width doc = let doc = propagateForcedBreaks doc in @@ -226,7 +253,7 @@ let toString ~width doc = process ~pos:0 [] (List.rev suffices) end in - process ~pos:0 [] [0, Flat, doc]; + process ~pos:0 [] [(0, Flat, doc)]; MiniBuffer.contents buffer diff --git a/src/rescript-editor-support/vendor/res_outcome_printer/res_doc.mli b/src/rescript-editor-support/vendor/res_outcome_printer/res_doc.mli index 97348759..031afbaf 100644 --- a/src/rescript-editor-support/vendor/res_outcome_printer/res_doc.mli +++ b/src/rescript-editor-support/vendor/res_outcome_printer/res_doc.mli @@ -36,7 +36,7 @@ val question: t val tilde: t val equal: t val trailingComma: t -val doubleQuote: t +val doubleQuote: t [@@live] (* * `willBreak doc` checks whether `doc` contains forced line breaks. diff --git a/src/rescript-editor-support/vendor/res_outcome_printer/res_minibuffer.ml b/src/rescript-editor-support/vendor/res_outcome_printer/res_minibuffer.ml index 43ba4334..174b5ec6 100644 --- a/src/rescript-editor-support/vendor/res_outcome_printer/res_minibuffer.ml +++ b/src/rescript-editor-support/vendor/res_outcome_printer/res_minibuffer.ml @@ -9,7 +9,7 @@ let create n = let s = (Bytes.create [@doesNotRaise]) n in {buffer = s; position = 0; length = n} -let contents b = Bytes.sub_string b.buffer 0 b.position +let contents b = (Bytes.sub_string [@doesNotRaise]) b.buffer 0 b.position (* Can't be called directly, don't add to the interface *) let resize_internal b more = 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 dbbd678a..e7bfac47 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 @@ -29,7 +29,7 @@ let classifyIdentContent ~allowUident txt = let c = String.unsafe_get txt i in if i == 0 && not ( (allowUident && (c >= 'A' && c <= 'Z')) || - (c >= 'a' && c <= 'z') || c = '_' || (c >= '0' && c <= '9')) then + (c >= 'a' && c <= 'z') || c = '_') then ExoticIdent else if not ( (c >= 'a' && c <= 'z') @@ -56,6 +56,15 @@ let printIdentLike ~allowUident txt = ] | NormalIdent -> Doc.text txt +let printPolyVarIdent txt = + match classifyIdentContent ~allowUident:true txt with + | ExoticIdent -> Doc.concat [ + Doc.text "\""; + Doc.text txt; + Doc.text"\"" + ] + | NormalIdent -> Doc.text txt + (* ReScript doesn't have parenthesized identifiers. * We don't support custom operators. *) let parenthesized_ident _name = true @@ -301,6 +310,8 @@ let printIdentLike ~allowUident txt = Doc.join ~sep:Doc.space ( List.map (fun var -> Doc.text ("'" ^ var)) vars ); + Doc.dot; + Doc.space; printOutTypeDoc outType; ] ) @@ -376,7 +387,7 @@ let printIdentLike ~allowUident txt = Doc.group ( Doc.concat [ Doc.text "#"; - printIdentLike ~allowUident:true name; + printPolyVarIdent name; match types with | [] -> Doc.nil | types -> @@ -1023,7 +1034,7 @@ let printIdentLike ~allowUident txt = Doc.rparen; ] ) - (* Not supported by NapkinScript *) + (* Not supported by ReScript *) | Oval_variant _ -> Doc.nil let printOutExceptionDoc exc outValue = @@ -1130,7 +1141,7 @@ let printIdentLike ~allowUident txt = -(* Not supported in Napkin *) +(* Not supported in ReScript *) (* Oprint.out_class_type *) let setup = lazy begin Oprint.out_value := printOutValue; 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 c7b77770..b6a3eede 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 @@ -1,5 +1,4 @@ module Comment = Res_comment -module CharacterCodes = Res_character_codes type t = | Open @@ -154,7 +153,7 @@ let toString = function | ColonEqual -> ":=" | At -> "@" | AtAt -> "@@" | Percent -> "%" | PercentPercent -> "%%" - | Comment c -> "Comment(" ^ (Comment.toString c) ^ ")" + | Comment c -> "Comment" ^ (Comment.toString c) | List -> "list{" | TemplatePart text -> text ^ "${" | TemplateTail text -> "TemplateTail(" ^ text ^ ")" @@ -212,9 +211,9 @@ let isKeyword = function let lookupKeyword str = try keywordTable str with | Not_found -> - if CharacterCodes.isUpperCase (int_of_char (str.[0] [@doesNotRaise])) then - Uident str - else Lident str + match str.[0] [@doesNotRaise] with + | 'A'..'Z' -> Uident str + | _ -> Lident str let isKeywordTxt str = try let _ = keywordTable str in true with