Add initial dict literal implementation

Author: JonoPrest

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}
 
@@ -184,6 +186,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;
@@ -233,6 +236,7 @@ let getClosingToken = function
   | Lbrace -> Rbrace
   | Lbracket -> Rbracket
   | List -> Rbrace
+  | Dict -> Rbrace
   | LessThan -> GreaterThan
   | _ -> assert false
 
@@ -244,7 +248,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
@@ -1055,6 +1059,7 @@ let rec parsePattern ?(alias = true) ?(or_ = true) p =
             ppat_attributes = attrs @ pat.Parsetree.ppat_attributes;
           }))
     | Lbracket -> parseArrayPattern ~attrs p
+    (* | Dict -> parseDictPattern ~attrs p *)
     | Lbrace -> parseRecordPattern ~attrs p
     | Underscore ->
       let endPos = p.endPos in
@@ -1921,6 +1926,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 +3884,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 +3940,105 @@ 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 []
+    (*empty case*)
+    (* TODO: Disallow empty dict? *)
+    (* single case*)
+    (* multiple case*)
+    (* | [] -> makeDictKeyTuplesArray loc [] None *)
+    | [singleArrDictEntries] -> singleArrDictEntries
+    | multipleArrDictEntries ->
+      multipleArrDictEntries |> List.rev |> concatManyExpr ~loc
+  in
+  makeDictFromRowTuples ~loc arrDictEntries
+
 (* Overparse ... and give a nice error message *)
 and parseNonSpreadExp ~msg p =
   let () =

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,10 +269,12 @@ 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
+  | StringFieldDeclarations ->
+    print_string "is string field declaration\n";
+    isStringFieldDeclStart token
   | FieldDeclarations -> isFieldDeclStart token
   | RecordDecl -> isRecordDeclStart token
   | TypExprList -> isTypExprStart token || token = Token.LessThan
@@ -324,3 +328,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

@@ -104,6 +104,12 @@ let hasAwaitAttribute attrs =
       | _ -> false)
     attrs
 
+let collectDictExpressions expr =
+  (* Expresssion is either a spread dict or a tuple *)
+  match expr.pexp_desc with
+  | Pexp_tuple [field; expr] -> (Some (field, expr), None)
+  | _ -> (None, Some expr)
+
 let collectListExpressions expr =
   let rec collect acc expr =
     match expr.pexp_desc with
@@ -678,6 +684,37 @@ let isSpreadBeltListConcat expr =
     hasSpreadAttr expr.pexp_attributes
   | _ -> false
 
+let isSpreadBeltArrayConcat expr =
+  match expr.pexp_desc with
+  | Pexp_ident
+      {
+        txt =
+          Longident.Ldot
+            (Longident.Ldot (Longident.Lident "Belt", "Array"), "concatMany");
+      } ->
+    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

@@ -50,6 +50,11 @@ val collectListExpressions :
   Parsetree.expression ->
   Parsetree.expression list * Parsetree.expression option
 
+val collectDictExpressions :
+  Parsetree.expression ->
+  (Parsetree.expression * Parsetree.expression) option
+  * Parsetree.expression option
+
 type funParamKind =
   | Parameter of {
       attrs: Parsetree.attributes;
@@ -140,7 +145,11 @@ 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 isSpreadBeltArrayConcat : Parsetree.expression -> bool
+val hasDictAttr : (string Location.loc * 'a) list -> bool
+val isDictFromArray : Parsetree.expression -> bool
 
 val collectOrPatternChain : Parsetree.pattern -> Parsetree.pattern list