Add dict literal syntax

jscomp/syntax/src/res_core.ml

@@ -14,6 +14,8 @@ module LoopProgress = struct
     | _ :: rest -> rest
 end
 
+type ('a, 'b) spreadInline = Spread of 'a | Inline of 'b
+
 let mkLoc startLoc endLoc =
   Location.{loc_start = startLoc; loc_end = endLoc; loc_ghost = false}
 
@@ -180,6 +182,7 @@ let taggedTemplateLiteralAttr =
   (Location.mknoloc "res.taggedTemplate", Parsetree.PStr [])
 
 let spreadAttr = (Location.mknoloc "res.spread", Parsetree.PStr [])
+let dictAttr = (Location.mknoloc "res.dict", Parsetree.PStr [])
 
 type argument = {
   dotted: bool;
@@ -229,6 +232,7 @@ let getClosingToken = function
   | Lbrace -> Rbrace
   | Lbracket -> Rbracket
   | List -> Rbrace
+  | Dict -> Rbrace
   | LessThan -> GreaterThan
   | _ -> assert false
 
@@ -240,7 +244,7 @@ let rec goToClosing closingToken state =
   | GreaterThan, GreaterThan ->
     Parser.next state;
     ()
-  | ((Token.Lbracket | Lparen | Lbrace | List | LessThan) as t), _ ->
+  | ((Token.Lbracket | Lparen | Lbrace | List | Dict | LessThan) as t), _ ->
     Parser.next state;
     goToClosing (getClosingToken t) state;
     goToClosing closingToken state
@@ -1917,6 +1921,9 @@ and parseAtomicExpr p =
     | List ->
       Parser.next p;
       parseListExpr ~startPos p
+    | Dict ->
+      Parser.next p;
+      parseDictExpr ~startPos p
     | Module ->
       Parser.next p;
       parseFirstClassModuleExpr ~startPos p
@@ -3876,6 +3883,18 @@ and parseSpreadExprRegionWithLoc p =
     Some (false, parseConstrainedOrCoercedExpr p, startPos, p.prevEndPos)
   | _ -> None
 
+and parseSpreadRecordExprRowWithStringKeyRegionWithLoc p =
+  let startPos = p.Parser.prevEndPos in
+  match p.Parser.token with
+  | DotDotDot ->
+    Parser.next p;
+    let expr = parseConstrainedOrCoercedExpr p in
+    Some (Spread expr, startPos, p.prevEndPos)
+  | token when Grammar.isExprStart token ->
+    parseRecordExprRowWithStringKey p
+    |> Option.map (fun parsedRow -> (Inline parsedRow, startPos, p.prevEndPos))
+  | _ -> None
+
 and parseListExpr ~startPos p =
   let split_by_spread exprs =
     List.fold_left
@@ -3920,6 +3939,100 @@ and parseListExpr ~startPos p =
             loc))
       [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc listExprs)]
 
+and parseDictExpr ~startPos p =
+  let makeDictRowTuples ~loc idExps =
+    idExps
+    |> List.map (fun ((id, exp) : Ast_helper.lid * Parsetree.expression) ->
+           Ast_helper.Exp.tuple
+             [
+               Ast_helper.Exp.constant ~loc:id.loc
+                 (Pconst_string (Longident.last id.txt, None));
+               exp;
+             ])
+    |> Ast_helper.Exp.array ~loc
+  in
+
+  let makeSpreadDictRowTuples ~loc spreadDict =
+    Ast_helper.Exp.apply ~loc
+      (Ast_helper.Exp.ident ~loc ~attrs:[dictAttr]
+         (Location.mkloc
+            (Longident.Ldot
+               (Longident.Ldot (Longident.Lident "Js", "Dict"), "entries"))
+            loc))
+      [(Asttypes.Nolabel, spreadDict)]
+  in
+
+  let concatManyExpr ~loc listExprs =
+    Ast_helper.Exp.apply ~loc
+      (Ast_helper.Exp.ident ~loc ~attrs:[spreadAttr]
+         (Location.mkloc
+            (Longident.Ldot
+               (Longident.Ldot (Longident.Lident "Belt", "Array"), "concatMany"))
+            loc))
+      [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc listExprs)]
+  in
+
+  let makeDictFromRowTuples ~loc arrayEntriesExp =
+    Ast_helper.Exp.apply ~loc
+      (Ast_helper.Exp.ident ~loc ~attrs:[dictAttr]
+         (Location.mkloc
+            (Longident.Ldot
+               (Longident.Ldot (Longident.Lident "Js", "Dict"), "fromArray"))
+            loc))
+      [(Asttypes.Nolabel, arrayEntriesExp)]
+  in
+  let split_by_spread exprs =
+    List.fold_left
+      (fun acc curr ->
+        match (curr, acc) with
+        | (Spread expr, startPos, endPos), _ ->
+          (* find a spread expression, prepend a new sublist *)
+          ([], Some expr, startPos, endPos) :: acc
+        | ( (Inline fieldExprTuple, 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 *)
+          (fieldExprTuple :: no_spreads, spread, startPos, accEndPos) :: acc
+        | (Inline fieldExprTuple, startPos, endPos), [] ->
+          (* find a non-spread expression, and the accumulated is empty *)
+          [([fieldExprTuple], None, startPos, endPos)])
+      [] exprs
+  in
+  let rec getListOfEntryArraysReversed ?(accum = []) ~loc spreadSplit =
+    match spreadSplit with
+    | [] -> accum
+    | (idExps, None, _, _) :: tail ->
+      let accum = (idExps |> makeDictRowTuples ~loc) :: accum in
+      tail |> getListOfEntryArraysReversed ~loc ~accum
+    | ([], Some spread, _, _) :: tail ->
+      let accum = (spread |> makeSpreadDictRowTuples ~loc) :: accum in
+      tail |> getListOfEntryArraysReversed ~loc ~accum
+    | (idExps, Some spread, _, _) :: tail ->
+      let accum =
+        (spread |> makeSpreadDictRowTuples ~loc)
+        :: (idExps |> makeDictRowTuples ~loc)
+        :: accum
+      in
+      tail |> getListOfEntryArraysReversed ~loc ~accum
+  in
+
+  let dictExprsRev =
+    parseCommaDelimitedReversedList ~grammar:Grammar.RecordRowsStringKey
+      ~closing:Rbrace ~f:parseSpreadRecordExprRowWithStringKeyRegionWithLoc p
+  in
+  Parser.expect Rbrace p;
+  let loc = mkLoc startPos p.prevEndPos in
+  let arrDictEntries =
+    match
+      dictExprsRev |> split_by_spread |> getListOfEntryArraysReversed ~loc
+    with
+    | [] -> Ast_helper.Exp.array ~loc []
+    | [singleArrDictEntries] -> singleArrDictEntries
+    | multipleArrDictEntries ->
+      multipleArrDictEntries |> List.rev |> concatManyExpr ~loc
+  in
+  makeDictFromRowTuples ~loc arrDictEntries
+
 and parseArrayExp p =
   let startPos = p.Parser.startPos in
   Parser.expect Lbracket p;

jscomp/syntax/src/res_grammar.ml

@@ -56,6 +56,7 @@ type t =
   | TypeConstraint
   | AtomicTypExpr
   | ListExpr
+  | DictExpr
   | Pattern
   | AttributePayload
   | TagNames
@@ -114,6 +115,7 @@ let toString = function
   | TypeConstraint -> "constraints on a type"
   | AtomicTypExpr -> "a type"
   | ListExpr -> "an ocaml list expr"
+  | DictExpr -> "a dict literal expr"
   | PackageConstraint -> "a package constraint"
   | JsxChild -> "jsx child"
   | Pattern -> "pattern"
@@ -168,8 +170,8 @@ let isStructureItemStart = function
 
 let isPatternStart = function
   | Token.Int _ | Float _ | String _ | Codepoint _ | Backtick | True | False
-  | Minus | Plus | Lparen | Lbracket | Lbrace | List | Underscore | Lident _
-  | Uident _ | Hash | Exception | Lazy | Percent | Module | At ->
+  | Minus | Plus | Lparen | Lbracket | Lbrace | List | Dict | Underscore
+  | Lident _ | Uident _ | Hash | Exception | Lazy | Percent | Module | At ->
     true
   | _ -> false
 
@@ -267,7 +269,7 @@ let isBlockExprStart = function
 let isListElement grammar token =
   match grammar with
   | ExprList -> token = Token.DotDotDot || isExprStart token
-  | ListExpr -> token = DotDotDot || isExprStart token
+  | ListExpr | DictExpr -> token = DotDotDot || isExprStart token
   | PatternList -> token = DotDotDot || isPatternStart token
   | ParameterList -> isParameterStart token
   | StringFieldDeclarations -> isStringFieldDeclStart token
@@ -324,3 +326,7 @@ let isListTerminator grammar token =
 
 let isPartOfList grammar token =
   isListElement grammar token || isListTerminator grammar token
+
+let isDictElement = isListElement
+let isDictTerminator = isListTerminator
+let isPartOfDict = isPartOfList

jscomp/syntax/src/res_parsetree_viewer.ml

@@ -694,6 +694,26 @@ let isSpreadBeltArrayConcat expr =
     hasSpreadAttr expr.pexp_attributes
   | _ -> false
 
+let hasDictAttr attrs =
+  List.exists
+    (fun attr ->
+      match attr with
+      | {Location.txt = "res.dict"}, _ -> true
+      | _ -> false)
+    attrs
+
+let isDictFromArray expr =
+  match expr.pexp_desc with
+  | Pexp_ident
+      {
+        txt =
+          Longident.Ldot
+            (Longident.Ldot (Longident.Lident "Js", "Dict"), "fromArray");
+      } ->
+    let v = hasDictAttr expr.pexp_attributes in
+    v
+  | _ -> false
+
 (* Blue | Red | Green -> [Blue; Red; Green] *)
 let collectOrPatternChain pat =
   let rec loop pattern chain =

jscomp/syntax/src/res_parsetree_viewer.mli

@@ -144,7 +144,10 @@ val isTemplateLiteral : Parsetree.expression -> bool
 val isTaggedTemplateLiteral : Parsetree.expression -> bool
 val hasTemplateLiteralAttr : Parsetree.attributes -> bool
 
+val hasSpreadAttr : (string Location.loc * 'a) list -> bool
 val isSpreadBeltListConcat : Parsetree.expression -> bool
+val hasDictAttr : (string Location.loc * 'a) list -> bool
+val isDictFromArray : Parsetree.expression -> bool
 
 val isSpreadBeltArrayConcat : Parsetree.expression -> bool
 

jscomp/syntax/src/res_printer.ml

@@ -3048,6 +3048,32 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl =
                Doc.rbrace;
              ])
       | extension -> printExtension ~state ~atModuleLvl:false extension cmtTbl)
+    | Pexp_apply (dictFromArray, [(Nolabel, dictEntries)])
+      when ParsetreeViewer.isDictFromArray dictFromArray ->
+      let rows =
+        match dictEntries.pexp_desc with
+        | Pexp_apply (e, [(Nolabel, {pexp_desc = Pexp_array rows})])
+          when ParsetreeViewer.isSpreadBeltArrayConcat e ->
+          (*
+            There are one or more spreads in the dict
+            and the rows are nested in Belt.Array.concatMany
+            ie. dict{...otherDict, "first": 1, "second": 2 }
+          *)
+          rows
+        | Pexp_array rows ->
+          (*
+           There is only an array of key value paires defined in the dict
+            ie. dict{"first": 1, "second": 2 }
+           *)
+          rows
+        | _ ->
+          (*
+            This case only happens when there is a single spread dict inside an empty
+            ie. dict{...otherDict }
+          *)
+          [dictEntries]
+      in
+      printDictExpression ~state ~loc:dictEntries.pexp_loc ~rows cmtTbl
     | Pexp_apply (e, [(Nolabel, {pexp_desc = Pexp_array subLists})])
       when ParsetreeViewer.isSpreadBeltArrayConcat e ->
       printBeltArrayConcatApply ~state subLists cmtTbl
@@ -5271,6 +5297,73 @@ and printDirectionFlag flag =
   | Asttypes.Downto -> Doc.text " downto "
   | Asttypes.Upto -> Doc.text " to "
 
+and printExpressionDictRow ~state cmtTbl (expr : Parsetree.expression) =
+  match expr with
+  | {
+   pexp_loc = lbl_loc;
+   pexp_desc = Pexp_tuple [{pexp_desc = Pexp_constant field}; rowExpr];
+  } ->
+    let cmtLoc = {lbl_loc with loc_end = rowExpr.pexp_loc.loc_end} in
+    let doc =
+      Doc.group
+        (Doc.concat
+           [
+             printConstant field;
+             Doc.text ": ";
+             (let doc = printExpressionWithComments ~state rowExpr cmtTbl in
+              match Parens.exprRecordRowRhs rowExpr with
+              | Parens.Parenthesized -> addParens doc
+              | Braced braces -> printBraces doc rowExpr braces
+              | Nothing -> doc);
+           ])
+    in
+    printComments doc cmtTbl cmtLoc
+  | {pexp_desc = Pexp_apply ({pexp_attributes}, [(_, expr)])}
+    when Res_parsetree_viewer.hasDictAttr pexp_attributes ->
+    Doc.concat
+      [
+        Doc.dotdotdot;
+        (let doc = printExpressionWithComments ~state expr cmtTbl in
+         match Parens.expr expr with
+         | Parens.Parenthesized -> addParens doc
+         | Braced braces -> printBraces doc expr braces
+         | Nothing -> doc);
+      ]
+  | {pexp_desc = Pexp_array rows} ->
+    printDictExpressionInner ~state ~rows cmtTbl
+  | _ -> Doc.nil
+
+and printDictExpressionInner ~state ~rows cmtTbl =
+  Doc.concat
+    [
+      Doc.join
+        ~sep:(Doc.concat [Doc.text ","; Doc.line])
+        (List.map (printExpressionDictRow ~state cmtTbl) rows);
+    ]
+
+and printDictExpression ~state ~loc ~rows cmtTbl =
+  if rows = [] then
+    Doc.concat [Doc.text "dict{"; printCommentsInside cmtTbl loc; Doc.rbrace]
+  else
+    (* If the dict is written over multiple lines, break automatically
+     * `let x = dict{"a": 1, "b": 3}` -> same line, break when line-width exceeded
+     * `let x = dict{
+     *   "a": 1,
+     *   "b": 2,
+     *  }` -> record is written on multiple lines, break the group *)
+    let forceBreak = loc.loc_start.pos_lnum < loc.loc_end.pos_lnum in
+    Doc.breakableGroup ~forceBreak
+      (Doc.concat
+         [
+           Doc.text "dict{";
+           Doc.indent
+             (Doc.concat
+                [Doc.softLine; printDictExpressionInner ~state ~rows cmtTbl]);
+           Doc.trailingComma;
+           Doc.softLine;
+           Doc.rbrace;
+         ])
+
 and printExpressionRecordRow ~state (lbl, expr) cmtTbl punningAllowed =
   let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in
   let doc =

jscomp/syntax/src/res_scanner.ml

@@ -179,6 +179,8 @@ let digitValue ch =
 
 (* scanning helpers *)
 
+let objectLiterals = ["list"; "dict"]
+
 let scanIdentifier scanner =
   let startOff = scanner.offset in
   let rec skipGoodChars scanner =
@@ -195,11 +197,14 @@ let scanIdentifier scanner =
   let str =
     (String.sub [@doesNotRaise]) scanner.src startOff (scanner.offset - startOff)
   in
-  if '{' == scanner.ch && str = "list" then (
-    next scanner;
-    (* TODO: this isn't great *)
-    Token.lookupKeyword "list{")
-  else Token.lookupKeyword str
+  (if '{' == scanner.ch && objectLiterals |> List.mem str then (
+     (*If string is an object literal ie list{.. or dict{..
+       forward the scanner to include the opening '{' and
+       lookup including the '{'*)
+     next scanner;
+     str ^ "{")
+   else str)
+  |> Token.lookupKeyword
 
 let scanDigits scanner ~base =
   if base <= 10 then