Spread anywhere feature (#692)

* let spread at anywhere when creating a list

* concat accept an array; tests update

* intead by fold_left to suppress reanalyze termination check

* remove unused error message

* printing test for spread anywhere feature

* add attribute  for Belt.List.concatMany

* tweak

* printer tests update

* tests

* format

* remove non-error test-cases from error

* pull out long branch to enhance readability

* remove useless comments

* simplify pattern match guard

* more tests about new feature

* one more edge test

* fix typo in comment

Author: butterunderflow

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 =

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 =

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 :

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

tests/parsing/errors/other/expected/spread.res.txt

@@ -42,79 +42,64 @@ 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.
 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<foo, {...x}>
+   7 │ let list{...x, ...y} = myList
+   8 │ 
+   9 │ type t = {...a}
+  10 │ type t = Foo({...a})
+  11 │ type t = option<foo, {...x}>
 
   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<foo, {...x}>
-  13 │ 
+   8 │ 
+   9 │ type t = {...a}
+  10 │ type t = Foo({...a})
+  11 │ type t = option<foo, {...x}>
+  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<foo, {...x}>
-  13 │ 
+   9 │ type t = {...a}
+  10 │ type t = Foo({...a})
+  11 │ type t = option<foo, {...x}>
+  12 │ 
 
   You're using a ... spread without extra fields. This is the same type.
 
 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 =

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}

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)

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<int>}

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,
+}