diff --git a/src/res_core.ml b/src/res_core.ml index 8fd30a4d..b38430df 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -81,15 +81,6 @@ module ErrorMessages = struct ...b}` wouldn't make sense, as `b` would override every field of `a` \ anyway." - let listExprSpread = - "Lists can only have one `...` spread, and at the end.\n\ - Explanation: lists are singly-linked list, where a node contains a value \ - and points to the next node. `list{a, ...bc}` efficiently creates a new \ - item and links `bc` as its next nodes. `list{...bc, a}` would be \ - expensive, as it'd need to traverse `bc` and prepend each item to `a` one \ - by one. We therefore disallow such syntax sugar.\n\ - Solution: directly use `concat`." - let variantIdent = "A polymorphic variant (e.g. #id) must start with an alphabetical letter \ or be a number (e.g. #742)" @@ -181,6 +172,8 @@ let suppressFragileMatchWarningAttr = let makeBracesAttr loc = (Location.mkloc "ns.braces" loc, Parsetree.PStr []) let templateLiteralAttr = (Location.mknoloc "res.template", Parsetree.PStr []) +let spreadAttr = (Location.mknoloc "res.spread", Parsetree.PStr []) + type typDefOrExt = | TypeDef of { recFlag: Asttypes.rec_flag; @@ -3705,38 +3698,60 @@ and parseTupleExpr ~first ~startPos p = let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.tuple ~loc exprs -and parseSpreadExprRegion p = +and parseSpreadExprRegionWithLoc p = + let startPos = p.Parser.prevEndPos in match p.Parser.token with | DotDotDot -> Parser.next p; let expr = parseConstrainedOrCoercedExpr p in - Some (true, expr) + Some (true, expr, startPos, p.prevEndPos) | token when Grammar.isExprStart token -> - Some (false, parseConstrainedOrCoercedExpr p) + Some (false, parseConstrainedOrCoercedExpr p, startPos, p.prevEndPos) | _ -> None and parseListExpr ~startPos p = - let check_all_non_spread_exp exprs = - exprs - |> List.map (fun (spread, expr) -> - if spread then - Parser.err p (Diagnostics.message ErrorMessages.listExprSpread); - expr) - |> List.rev + let split_by_spread exprs = + List.fold_left + (fun acc curr -> + match (curr, acc) with + | (true, expr, startPos, endPos), _ -> + (* find a spread expression, prepend a new sublist *) + ([], Some expr, startPos, endPos) :: acc + | ( (false, expr, startPos, _endPos), + (no_spreads, spread, _accStartPos, accEndPos) :: acc ) -> + (* find a non-spread expression, and the accumulated is not empty, + * prepend to the first sublist, and update the loc of the first sublist *) + (expr :: no_spreads, spread, startPos, accEndPos) :: acc + | (false, expr, startPos, endPos), [] -> + (* find a non-spread expression, and the accumulated is empty *) + [([expr], None, startPos, endPos)]) + [] exprs + in + let make_sub_expr = function + | exprs, Some spread, startPos, endPos -> + makeListExpression (mkLoc startPos endPos) exprs (Some spread) + | exprs, None, startPos, endPos -> + makeListExpression (mkLoc startPos endPos) exprs None in let listExprsRev = parseCommaDelimitedReversedList p ~grammar:Grammar.ListExpr ~closing:Rbrace - ~f:parseSpreadExprRegion + ~f:parseSpreadExprRegionWithLoc in Parser.expect Rbrace p; let loc = mkLoc startPos p.prevEndPos in - match listExprsRev with - | (true (* spread expression *), expr) :: exprs -> - let exprs = check_all_non_spread_exp exprs in - makeListExpression loc exprs (Some expr) + match split_by_spread listExprsRev with + | [] -> makeListExpression loc [] None + | [(exprs, Some spread, _, _)] -> makeListExpression loc exprs (Some spread) + | [(exprs, None, _, _)] -> makeListExpression loc exprs None | exprs -> - let exprs = check_all_non_spread_exp exprs in - makeListExpression loc exprs None + let listExprs = List.map make_sub_expr exprs in + Ast_helper.Exp.apply ~loc + (Ast_helper.Exp.ident ~loc ~attrs:[spreadAttr] + (Location.mkloc + (Longident.Ldot + (Longident.Ldot (Longident.Lident "Belt", "List"), "concatMany")) + loc)) + [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc listExprs)] (* Overparse ... and give a nice error message *) and parseNonSpreadExp ~msg p = diff --git a/src/res_parsetree_viewer.ml b/src/res_parsetree_viewer.ml index 8ab7b31e..7ab2a373 100644 --- a/src/res_parsetree_viewer.ml +++ b/src/res_parsetree_viewer.ml @@ -618,6 +618,25 @@ let isTemplateLiteral expr = | Pexp_constant _ when hasTemplateLiteralAttr expr.pexp_attributes -> true | _ -> false +let hasSpreadAttr attrs = + List.exists + (fun attr -> + match attr with + | {Location.txt = "res.spread"}, _ -> true + | _ -> false) + attrs + +let isSpreadBeltListConcat expr = + match expr.pexp_desc with + | Pexp_ident + { + txt = + Longident.Ldot + (Longident.Ldot (Longident.Lident "Belt", "List"), "concatMany"); + } -> + hasSpreadAttr expr.pexp_attributes + | _ -> false + (* Blue | Red | Green -> [Blue; Red; Green] *) let collectOrPatternChain pat = let rec loop pattern chain = diff --git a/src/res_parsetree_viewer.mli b/src/res_parsetree_viewer.mli index f1f5fa32..abed6a31 100644 --- a/src/res_parsetree_viewer.mli +++ b/src/res_parsetree_viewer.mli @@ -132,6 +132,8 @@ val isBlockExpr : Parsetree.expression -> bool val isTemplateLiteral : Parsetree.expression -> bool val hasTemplateLiteralAttr : Parsetree.attributes -> bool +val isSpreadBeltListConcat : Parsetree.expression -> bool + val collectOrPatternChain : Parsetree.pattern -> Parsetree.pattern list val processBracesAttr : diff --git a/src/res_printer.ml b/src/res_printer.ml index f3625e88..8179ca0f 100644 --- a/src/res_printer.ml +++ b/src/res_printer.ml @@ -2980,6 +2980,9 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ]) | extension -> printExtension ~customLayout ~atModuleLvl:false extension cmtTbl) + | Pexp_apply (e, [(Nolabel, {pexp_desc = Pexp_array subLists})]) + when ParsetreeViewer.isSpreadBeltListConcat e -> + printBeltListConcatApply ~customLayout subLists cmtTbl | Pexp_apply _ -> if ParsetreeViewer.isUnaryExpression e then printUnaryExpression ~customLayout e cmtTbl @@ -3768,6 +3771,63 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = ]) | _ -> Doc.nil +and printBeltListConcatApply ~customLayout subLists cmtTbl = + let makeSpreadDoc commaBeforeSpread = function + | Some expr -> + Doc.concat + [ + commaBeforeSpread; + Doc.dotdotdot; + (let doc = printExpressionWithComments ~customLayout expr cmtTbl in + match Parens.expr expr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces + | Nothing -> doc); + ] + | None -> Doc.nil + in + let makeSubListDoc (expressions, spread) = + let commaBeforeSpread = + match expressions with + | [] -> Doc.nil + | _ -> Doc.concat [Doc.text ","; Doc.line] + in + let spreadDoc = makeSpreadDoc commaBeforeSpread spread in + Doc.concat + [ + Doc.join + ~sep:(Doc.concat [Doc.text ","; Doc.line]) + (List.map + (fun expr -> + let doc = + printExpressionWithComments ~customLayout expr cmtTbl + in + match Parens.expr expr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces + | Nothing -> doc) + expressions); + spreadDoc; + ] + in + Doc.group + (Doc.concat + [ + Doc.text "list{"; + Doc.indent + (Doc.concat + [ + Doc.softLine; + Doc.join + ~sep:(Doc.concat [Doc.text ","; Doc.line]) + (List.map makeSubListDoc + (List.map ParsetreeViewer.collectListExpressions subLists)); + ]); + Doc.trailingComma; + Doc.softLine; + Doc.rbrace; + ]) + (* callExpr(arg1, arg2) *) and printPexpApply ~customLayout expr cmtTbl = match expr.pexp_desc with diff --git a/tests/parsing/errors/other/expected/spread.res.txt b/tests/parsing/errors/other/expected/spread.res.txt index b6b0b914..300ceb05 100644 --- a/tests/parsing/errors/other/expected/spread.res.txt +++ b/tests/parsing/errors/other/expected/spread.res.txt @@ -42,7 +42,7 @@ Explanation: since records have a known, fixed shape, a spread like `{a, ...b}` 4 │ let record = {...x, ...y} 5 │ let {...x, ...y} = myRecord 6 │ - 7 │ let myList = list{...x, ...y} + 7 │ let list{...x, ...y} = myList Record's `...` spread is not supported in pattern matches. Explanation: you can't collect a subset of a record's field into its own record, since a record needs an explicit declaration and that subset wouldn't have one. @@ -50,63 +50,49 @@ Solution: you need to pull out each field you want explicitly. Syntax error! - tests/parsing/errors/other/spread.res:8:1-3 + tests/parsing/errors/other/spread.res:7:13-22 - 6 │ - 7 │ let myList = list{...x, ...y} - 8 │ let list{...x, ...y} = myList - 9 │ - 10 │ type t = {...a} - - Lists can only have one `...` spread, and at the end. -Explanation: lists are singly-linked list, where a node contains a value and points to the next node. `list{a, ...bc}` efficiently creates a new item and links `bc` as its next nodes. `list{...bc, a}` would be expensive, as it'd need to traverse `bc` and prepend each item to `a` one by one. We therefore disallow such syntax sugar. -Solution: directly use `concat`. - - - Syntax error! - tests/parsing/errors/other/spread.res:8:13-22 - - 6 │ - 7 │ let myList = list{...x, ...y} - 8 │ let list{...x, ...y} = myList - 9 │ - 10 │ type t = {...a} + 5 │ let {...x, ...y} = myRecord + 6 │ + 7 │ let list{...x, ...y} = myList + 8 │ + 9 │ type t = {...a} List pattern matches only supports one `...` spread, at the end. Explanation: a list spread at the tail is efficient, but a spread in the middle would create new lists; out of performance concern, our pattern matching currently guarantees to never create new intermediate data. Syntax error! - tests/parsing/errors/other/spread.res:10:11-13 + tests/parsing/errors/other/spread.res:9:11-13 - 8 │ let list{...x, ...y} = myList - 9 │ - 10 │ type t = {...a} - 11 │ type t = Foo({...a}) - 12 │ type t = option + 7 │ let list{...x, ...y} = myList + 8 │ + 9 │ type t = {...a} + 10 │ type t = Foo({...a}) + 11 │ type t = option You're using a ... spread without extra fields. This is the same type. Syntax error! - tests/parsing/errors/other/spread.res:11:15-17 + tests/parsing/errors/other/spread.res:10:15-17 - 9 │ - 10 │ type t = {...a} - 11 │ type t = Foo({...a}) - 12 │ type t = option - 13 │ + 8 │ + 9 │ type t = {...a} + 10 │ type t = Foo({...a}) + 11 │ type t = option + 12 │ You're using a ... spread without extra fields. This is the same type. Syntax error! - tests/parsing/errors/other/spread.res:12:23-26 + tests/parsing/errors/other/spread.res:11:23-26 - 10 │ type t = {...a} - 11 │ type t = Foo({...a}) - 12 │ type t = option - 13 │ + 9 │ type t = {...a} + 10 │ type t = Foo({...a}) + 11 │ type t = option + 12 │ You're using a ... spread without extra fields. This is the same type. @@ -114,7 +100,6 @@ let arr = [|x;y|] let [|arr;_|] = [|1;2;3|] let record = { x with y } let { x; y } = myRecord -let myList = x :: y let x::y = myList type nonrec t = < a > type nonrec t = diff --git a/tests/parsing/errors/other/spread.res b/tests/parsing/errors/other/spread.res index e30a6129..64c92c80 100644 --- a/tests/parsing/errors/other/spread.res +++ b/tests/parsing/errors/other/spread.res @@ -4,7 +4,6 @@ let [...arr, _] = [1, 2, 3] let record = {...x, ...y} let {...x, ...y} = myRecord -let myList = list{...x, ...y} let list{...x, ...y} = myList type t = {...a} diff --git a/tests/parsing/grammar/expressions/expected/list.res.txt b/tests/parsing/grammar/expressions/expected/list.res.txt index 1c1eb53d..4205548d 100644 --- a/tests/parsing/grammar/expressions/expected/list.res.txt +++ b/tests/parsing/grammar/expressions/expected/list.res.txt @@ -3,4 +3,5 @@ let x = [1; 2; 3] let x = [1; 2; 3] let x = [(1 : int); (2 : int); (3 : int)] let x = 4 :: 5 :: y +let x = ((Belt.List.concatMany)[@res.spread ]) [|(1 :: x);(2 :: 3 :: x)|] let x = 1 :: 2 :: (y : int list) \ No newline at end of file diff --git a/tests/parsing/grammar/expressions/list.res b/tests/parsing/grammar/expressions/list.res index 0841baa9..376db1a2 100644 --- a/tests/parsing/grammar/expressions/list.res +++ b/tests/parsing/grammar/expressions/list.res @@ -12,5 +12,8 @@ let x = list{1: int, (2: int), 3: int} // spread let x = list{4, 5, ...y} +// spread anywhere +let x = list{1, ...x, 2, 3, ...x} + // spread constrained expression let x = list{1, 2, ...y: list} diff --git a/tests/printer/expr/expected/list.res.txt b/tests/printer/expr/expected/list.res.txt index f7fcbf88..a2d1b7a0 100644 --- a/tests/printer/expr/expected/list.res.txt +++ b/tests/printer/expr/expected/list.res.txt @@ -2,6 +2,13 @@ let x = list{} let x = list{1} let x = list{1, 2} let x = list{1, 2, 3} +let x = xs +let x = list{1, ...xs} +let x = list{xs, ...ys} +let x = list{...xs, ...ys} +let x = list{...xs, 1, ...ys} +let x = list{1, 2, ...xs, 3, ...xs} +let x = Belt.List.concatMany([list{1, 2, ...x}, [list{3, ...x}]]) let x = list{ superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, @@ -17,3 +24,23 @@ let x = list{ superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, ...superLoooooooooooooooooooooooooooooongListHere, } + +let x = Belt.List.concatMany([ + list{ + superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, + superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, + ...superLoooooooooooooooooooooooooooooongListHere, + }, + list{ + superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, + ...superLoooooooooooooooooooooooooooooongListHere, + }, +]) + +let x = list{ + superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, + superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, + ...superLoooooooooooooooooooooooooooooongListHere, + superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, + ...superLoooooooooooooooooooooooooooooongListHere, +} diff --git a/tests/printer/expr/list.res b/tests/printer/expr/list.res index 06d3210b..86b02f08 100644 --- a/tests/printer/expr/list.res +++ b/tests/printer/expr/list.res @@ -2,6 +2,14 @@ let x = list{} let x = list{1} let x = list{1, 2} let x = list{1, 2, 3} +let x = list{...xs} +let x = list{1, ... xs} +let x = list{xs, ... ys} +let x = list{...xs, ... ys} +let x = list{...xs, 1, ...ys} +let x = list{1, 2, ...xs, 3, ...xs} +let x = Belt.List.concatMany([list{1, 2, ...x}, [list{3, ...x}]]) + let x = list{ superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, @@ -18,3 +26,23 @@ let x = list{ superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, ...superLoooooooooooooooooooooooooooooongListHere, } + +let x = Belt.List.concatMany([ + list{ + superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, + superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, + ...superLoooooooooooooooooooooooooooooongListHere, + }, + list{ + superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, + ...superLoooooooooooooooooooooooooooooongListHere, + }, +]) + + +let x = list{ + superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, + superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, ...superLoooooooooooooooooooooooooooooongListHere, + superLoooooooooooooooooooooooooooooongIiiiiiiiiideeeentifieeeeeeeeeeeeeeeeer, + ...superLoooooooooooooooooooooooooooooongListHere, +}