From 530d0ebe6273d64a5258e737e26041eab3455c56 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 29 Oct 2022 07:04:57 +0200 Subject: [PATCH] Sync latest syntax. --- CHANGELOG.md | 10 + jscomp/napkin/CHANGELOG.md | 7 + lib/4.06.1/unstable/js_compiler.ml | 224 +++++++++++-- lib/4.06.1/unstable/js_playground_compiler.ml | 303 ++++++++++++++---- lib/4.06.1/whole_compiler.ml | 303 ++++++++++++++---- syntax | 2 +- 6 files changed, 692 insertions(+), 157 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 55ae2375fb..d78f5076d3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,12 +12,22 @@ # 10.1.0-rc.3 +#### :rocket: New Feature + +- Support the use of spread anywhere in list creation (e.g. `list{...x, 1, ...y, ...z}). https://github.com/rescript-lang/syntax/pull/692 + +- Add support for the argument of `@react.component` to set a props type from the outside. https://github.com/rescript-lang/syntax/pull/699 + #### :bug: Bug Fix - Fix issue where the JSX key type is not an optional string https://github.com/rescript-lang/syntax/pull/693 - Prevent inlining of async functions https://github.com/rescript-lang/rescript-compiler/issues/5754 +- Fix issue where the JSX fragment without children build error https://github.com/rescript-lang/syntax/pull/704 + +- Fix issue where async as an id cannot be used with application and labelled arguments https://github.com/rescript-lang/syntax/issues/707 + # 10.1.0-rc.2 #### :bug: Bug Fix diff --git a/jscomp/napkin/CHANGELOG.md b/jscomp/napkin/CHANGELOG.md index 5848015ded..064b2d342c 100644 --- a/jscomp/napkin/CHANGELOG.md +++ b/jscomp/napkin/CHANGELOG.md @@ -24,6 +24,10 @@ - Add support for empty record literal `{}` for records with only optional fields, and type definition of empty record (e.g. `type empty = {}`) https://github.com/rescript-lang/syntax/pull/632 +- Support the use of spread anywhere in list creation (e.g. `list{...x, 1, ...y, ...z}). https://github.com/rescript-lang/syntax/pull/692 + +- Add support for the argument of `@react.component` to set a props type from the outside. https://github.com/rescript-lang/syntax/pull/699 + #### :bug: Bug Fix - Fix issue in formatting JSX spread props https://github.com/rescript-lang/syntax/pull/644 @@ -44,6 +48,9 @@ - Fix issue where certain JSX expressions would be formatted differenctly in compiler 10.1.0-rc.1 https://github.com/rescript-lang/syntax/issues/675 - Fix issue where printing nested pipe discards await https://github.com/rescript-lang/syntax/issues/687 - Fix issue where the JSX key type is not an optional string https://github.com/rescript-lang/syntax/pull/693 +- Fix issue where the JSX fragment without children build error https://github.com/rescript-lang/syntax/pull/704 +- Fix issue where async as an id cannot be used with application and labelled arguments https://github.com/rescript-lang/syntax/issues/707 + #### :eyeglasses: Spec Compliance diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 83836307ac..65064ce4aa 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -47769,6 +47769,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 : @@ -48412,6 +48414,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 = @@ -54273,6 +54294,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 @@ -55061,6 +55085,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 @@ -271777,6 +271858,25 @@ let hasAttr (loc, _) = loc.txt = "react.component" let hasAttrOnBinding {pvb_attributes} = List.find_opt hasAttr pvb_attributes <> None +let coreTypeOfAttrs attributes = + List.find_map + (fun ({txt}, payload) -> + match (txt, payload) with + | "react.component", PTyp coreType -> Some coreType + | _ -> None) + attributes + +let typVarsOfCoreType {ptyp_desc} = + match ptyp_desc with + | Ptyp_constr (_, coreTypes) -> + List.filter + (fun {ptyp_desc} -> + match ptyp_desc with + | Ptyp_var _ -> true + | _ -> false) + coreTypes + | _ -> [] + let raiseError ~loc msg = Location.raise_errorf ~loc msg let raiseErrorMultipleReactComponent ~loc = @@ -273296,13 +273396,30 @@ let makeTypeDecls propsName loc namedTypeList = ~kind:(Ptype_record labelDeclList); ] +let makeTypeDeclsWithCoreType propsName loc coreType typVars = + [ + Type.mk ~loc {txt = propsName; loc} ~kind:Ptype_abstract + ~params:(typVars |> List.map (fun v -> (v, Invariant))) + ~manifest:coreType; + ] + (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *) -let makePropsRecordType propsName loc namedTypeList = - Str.type_ Nonrecursive (makeTypeDecls propsName loc namedTypeList) +let makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType propsName loc + namedTypeList = + Str.type_ Nonrecursive + (match coreTypeOfAttr with + | None -> makeTypeDecls propsName loc namedTypeList + | Some coreType -> + makeTypeDeclsWithCoreType propsName loc coreType typVarsOfCoreType) (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *) -let makePropsRecordTypeSig propsName loc namedTypeList = - Sig.type_ Nonrecursive (makeTypeDecls propsName loc namedTypeList) +let makePropsRecordTypeSig ~coreTypeOfAttr ~typVarsOfCoreType propsName loc + namedTypeList = + Sig.type_ Nonrecursive + (match coreTypeOfAttr with + | None -> makeTypeDecls propsName loc namedTypeList + | Some coreType -> + makeTypeDeclsWithCoreType propsName loc coreType typVarsOfCoreType) let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc attrs callArguments = @@ -273396,7 +273513,7 @@ let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc (Exp.ident { loc = Location.none; - txt = Ldot (Lident "React", "createElementWithKey"); + txt = Ldot (Lident "JsxPPXReactSupport", "createElementWithKey"); }) [key; (nolabel, makeID); (nolabel, props)] | None, [] -> @@ -273409,7 +273526,8 @@ let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc (Exp.ident { loc = Location.none; - txt = Ldot (Lident "React", "createElementVariadicWithKey"); + txt = + Ldot (Lident "JsxPPXReactSupport", "createElementVariadicWithKey"); }) [key; (nolabel, makeID); (nolabel, props); (nolabel, children)] | Some children, [] -> @@ -273718,6 +273836,12 @@ let transformStructureItem ~config mapper item = config.hasReactComponent <- true; check_string_int_attribute_iter.structure_item check_string_int_attribute_iter item; + let coreTypeOfAttr = React_jsx_common.coreTypeOfAttrs pval_attributes in + let typVarsOfCoreType = + coreTypeOfAttr + |> Option.map React_jsx_common.typVarsOfCoreType + |> Option.value ~default:[] + in let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = match ptyp_desc with | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) @@ -273734,11 +273858,17 @@ let transformStructureItem ~config mapper item = let retPropsType = Typ.constr ~loc:pstr_loc (Location.mkloc (Lident "props") pstr_loc) - (makePropsTypeParams namedTypeList) + (match coreTypeOfAttr with + | None -> makePropsTypeParams namedTypeList + | Some _ -> ( + match typVarsOfCoreType with + | [] -> [] + | _ -> [Typ.any ()])) in (* type props<'x, 'y> = { x: 'x, y?: 'y, ... } *) let propsRecordType = - makePropsRecordType "props" pstr_loc namedTypeList + makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType "props" + pstr_loc namedTypeList in (* can't be an arrow because it will defensively uncurry *) let newExternalType = @@ -273772,6 +273902,14 @@ let transformStructureItem ~config mapper item = React_jsx_common.raiseErrorMultipleReactComponent ~loc:pstr_loc else ( config.hasReactComponent <- true; + let coreTypeOfAttr = + React_jsx_common.coreTypeOfAttrs binding.pvb_attributes + in + let typVarsOfCoreType = + coreTypeOfAttr + |> Option.map React_jsx_common.typVarsOfCoreType + |> Option.value ~default:[] + in let bindingLoc = binding.pvb_loc in let bindingPatLoc = binding.pvb_pat.ppat_loc in let binding = @@ -273962,7 +274100,8 @@ let transformStructureItem ~config mapper item = let vbMatchList = List.map vbMatch namedArgWithDefaultValueList in (* type props = { ... } *) let propsRecordType = - makePropsRecordType "props" pstr_loc namedTypeList + makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType "props" + pstr_loc namedTypeList in let innerExpression = Exp.apply @@ -273974,6 +274113,13 @@ let transformStructureItem ~config mapper item = [(Nolabel, Exp.ident (Location.mknoloc @@ Lident "ref"))] | false -> []) in + let makePropsPattern = function + | [] -> Pat.var @@ Location.mknoloc "props" + | _ -> + Pat.constraint_ + (Pat.var @@ Location.mknoloc "props") + (Typ.constr (Location.mknoloc @@ Lident "props") [Typ.any ()]) + in let fullExpression = (* React component name should start with uppercase letter *) (* let make = { let \"App" = props => make(props); \"App" } *) @@ -273981,12 +274127,9 @@ let transformStructureItem ~config mapper item = let \"App" = (props, ref) => make({...props, ref: @optional (Js.Nullabel.toOption(ref))}) })*) Exp.fun_ nolabel None - (match namedTypeList with - | [] -> Pat.var @@ Location.mknoloc "props" - | _ -> - Pat.constraint_ - (Pat.var @@ Location.mknoloc "props") - (Typ.constr (Location.mknoloc @@ Lident "props") [Typ.any ()])) + (match coreTypeOfAttr with + | None -> makePropsPattern namedTypeList + | Some _ -> makePropsPattern typVarsOfCoreType) (if hasForwardRef then Exp.fun_ nolabel None (Pat.var @@ Location.mknoloc "ref") @@ -274090,8 +274233,15 @@ let transformStructureItem ~config mapper item = (Pat.constraint_ recordPattern (Typ.constr ~loc:emptyLoc {txt = Lident "props"; loc = emptyLoc} - (makePropsTypeParams ~stripExplicitOption:true - ~stripExplicitJsNullableOfRef:hasForwardRef namedTypeList))) + (match coreTypeOfAttr with + | None -> + makePropsTypeParams ~stripExplicitOption:true + ~stripExplicitJsNullableOfRef:hasForwardRef + namedTypeList + | Some _ -> ( + match typVarsOfCoreType with + | [] -> [] + | _ -> [Typ.any ()])))) expression in (* let make = ({id, name, ...}: props<'id, 'name, ...>) => { ... } *) @@ -274167,6 +274317,12 @@ let transformSignatureItem ~config _mapper item = check_string_int_attribute_iter.signature_item check_string_int_attribute_iter item; let hasForwardRef = ref false in + let coreTypeOfAttr = React_jsx_common.coreTypeOfAttrs pval_attributes in + let typVarsOfCoreType = + coreTypeOfAttr + |> Option.map React_jsx_common.typVarsOfCoreType + |> Option.value ~default:[] + in let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = match ptyp_desc with | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) @@ -274189,10 +274345,16 @@ let transformSignatureItem ~config _mapper item = let retPropsType = Typ.constr (Location.mkloc (Lident "props") psig_loc) - (makePropsTypeParams namedTypeList) + (match coreTypeOfAttr with + | None -> makePropsTypeParams namedTypeList + | Some _ -> ( + match typVarsOfCoreType with + | [] -> [] + | _ -> [Typ.any ()])) in let propsRecordType = - makePropsRecordTypeSig "props" psig_loc + makePropsRecordTypeSig ~coreTypeOfAttr ~typVarsOfCoreType "props" + psig_loc ((* If there is Nolabel arg, regard the type as ref in forwardRef *) (if !hasForwardRef then [(true, "ref", [], refType Location.none)] else []) @@ -274301,24 +274463,22 @@ let expr ~config mapper expression = Exp.ident ~loc {loc; txt = Ldot (Lident "React", "fragment")} in let childrenExpr = transformChildrenIfList ~mapper listItems in + let recordOfChildren children = + Exp.record [(Location.mknoloc (Lident "children"), children)] None + in let args = [ (nolabel, fragment); (match config.mode with - | "automatic" -> + | "automatic" -> ( ( nolabel, - Exp.record - [ - ( Location.mknoloc @@ Lident "children", - match childrenExpr with - | {pexp_desc = Pexp_array children} -> ( - match children with - | [] -> emptyRecord ~loc:Location.none - | [child] -> child - | _ -> childrenExpr) - | _ -> childrenExpr ); - ] - None ) + match childrenExpr with + | {pexp_desc = Pexp_array children} -> ( + match children with + | [] -> emptyRecord ~loc:Location.none + | [child] -> recordOfChildren child + | _ -> recordOfChildren childrenExpr) + | _ -> recordOfChildren childrenExpr )) | "classic" | _ -> (nolabel, childrenExpr)); ] in diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 18ec93bd30..c1f57abc76 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -47769,6 +47769,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 : @@ -48412,6 +48414,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 = @@ -54273,6 +54294,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 @@ -55061,6 +55085,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 @@ -273240,6 +273321,25 @@ let hasAttr (loc, _) = loc.txt = "react.component" let hasAttrOnBinding {pvb_attributes} = List.find_opt hasAttr pvb_attributes <> None +let coreTypeOfAttrs attributes = + List.find_map + (fun ({txt}, payload) -> + match (txt, payload) with + | "react.component", PTyp coreType -> Some coreType + | _ -> None) + attributes + +let typVarsOfCoreType {ptyp_desc} = + match ptyp_desc with + | Ptyp_constr (_, coreTypes) -> + List.filter + (fun {ptyp_desc} -> + match ptyp_desc with + | Ptyp_var _ -> true + | _ -> false) + coreTypes + | _ -> [] + let raiseError ~loc msg = Location.raise_errorf ~loc msg let raiseErrorMultipleReactComponent ~loc = @@ -274759,13 +274859,30 @@ let makeTypeDecls propsName loc namedTypeList = ~kind:(Ptype_record labelDeclList); ] +let makeTypeDeclsWithCoreType propsName loc coreType typVars = + [ + Type.mk ~loc {txt = propsName; loc} ~kind:Ptype_abstract + ~params:(typVars |> List.map (fun v -> (v, Invariant))) + ~manifest:coreType; + ] + (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *) -let makePropsRecordType propsName loc namedTypeList = - Str.type_ Nonrecursive (makeTypeDecls propsName loc namedTypeList) +let makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType propsName loc + namedTypeList = + Str.type_ Nonrecursive + (match coreTypeOfAttr with + | None -> makeTypeDecls propsName loc namedTypeList + | Some coreType -> + makeTypeDeclsWithCoreType propsName loc coreType typVarsOfCoreType) (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *) -let makePropsRecordTypeSig propsName loc namedTypeList = - Sig.type_ Nonrecursive (makeTypeDecls propsName loc namedTypeList) +let makePropsRecordTypeSig ~coreTypeOfAttr ~typVarsOfCoreType propsName loc + namedTypeList = + Sig.type_ Nonrecursive + (match coreTypeOfAttr with + | None -> makeTypeDecls propsName loc namedTypeList + | Some coreType -> + makeTypeDeclsWithCoreType propsName loc coreType typVarsOfCoreType) let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc attrs callArguments = @@ -274859,7 +274976,7 @@ let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc (Exp.ident { loc = Location.none; - txt = Ldot (Lident "React", "createElementWithKey"); + txt = Ldot (Lident "JsxPPXReactSupport", "createElementWithKey"); }) [key; (nolabel, makeID); (nolabel, props)] | None, [] -> @@ -274872,7 +274989,8 @@ let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc (Exp.ident { loc = Location.none; - txt = Ldot (Lident "React", "createElementVariadicWithKey"); + txt = + Ldot (Lident "JsxPPXReactSupport", "createElementVariadicWithKey"); }) [key; (nolabel, makeID); (nolabel, props); (nolabel, children)] | Some children, [] -> @@ -275181,6 +275299,12 @@ let transformStructureItem ~config mapper item = config.hasReactComponent <- true; check_string_int_attribute_iter.structure_item check_string_int_attribute_iter item; + let coreTypeOfAttr = React_jsx_common.coreTypeOfAttrs pval_attributes in + let typVarsOfCoreType = + coreTypeOfAttr + |> Option.map React_jsx_common.typVarsOfCoreType + |> Option.value ~default:[] + in let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = match ptyp_desc with | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) @@ -275197,11 +275321,17 @@ let transformStructureItem ~config mapper item = let retPropsType = Typ.constr ~loc:pstr_loc (Location.mkloc (Lident "props") pstr_loc) - (makePropsTypeParams namedTypeList) + (match coreTypeOfAttr with + | None -> makePropsTypeParams namedTypeList + | Some _ -> ( + match typVarsOfCoreType with + | [] -> [] + | _ -> [Typ.any ()])) in (* type props<'x, 'y> = { x: 'x, y?: 'y, ... } *) let propsRecordType = - makePropsRecordType "props" pstr_loc namedTypeList + makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType "props" + pstr_loc namedTypeList in (* can't be an arrow because it will defensively uncurry *) let newExternalType = @@ -275235,6 +275365,14 @@ let transformStructureItem ~config mapper item = React_jsx_common.raiseErrorMultipleReactComponent ~loc:pstr_loc else ( config.hasReactComponent <- true; + let coreTypeOfAttr = + React_jsx_common.coreTypeOfAttrs binding.pvb_attributes + in + let typVarsOfCoreType = + coreTypeOfAttr + |> Option.map React_jsx_common.typVarsOfCoreType + |> Option.value ~default:[] + in let bindingLoc = binding.pvb_loc in let bindingPatLoc = binding.pvb_pat.ppat_loc in let binding = @@ -275425,7 +275563,8 @@ let transformStructureItem ~config mapper item = let vbMatchList = List.map vbMatch namedArgWithDefaultValueList in (* type props = { ... } *) let propsRecordType = - makePropsRecordType "props" pstr_loc namedTypeList + makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType "props" + pstr_loc namedTypeList in let innerExpression = Exp.apply @@ -275437,6 +275576,13 @@ let transformStructureItem ~config mapper item = [(Nolabel, Exp.ident (Location.mknoloc @@ Lident "ref"))] | false -> []) in + let makePropsPattern = function + | [] -> Pat.var @@ Location.mknoloc "props" + | _ -> + Pat.constraint_ + (Pat.var @@ Location.mknoloc "props") + (Typ.constr (Location.mknoloc @@ Lident "props") [Typ.any ()]) + in let fullExpression = (* React component name should start with uppercase letter *) (* let make = { let \"App" = props => make(props); \"App" } *) @@ -275444,12 +275590,9 @@ let transformStructureItem ~config mapper item = let \"App" = (props, ref) => make({...props, ref: @optional (Js.Nullabel.toOption(ref))}) })*) Exp.fun_ nolabel None - (match namedTypeList with - | [] -> Pat.var @@ Location.mknoloc "props" - | _ -> - Pat.constraint_ - (Pat.var @@ Location.mknoloc "props") - (Typ.constr (Location.mknoloc @@ Lident "props") [Typ.any ()])) + (match coreTypeOfAttr with + | None -> makePropsPattern namedTypeList + | Some _ -> makePropsPattern typVarsOfCoreType) (if hasForwardRef then Exp.fun_ nolabel None (Pat.var @@ Location.mknoloc "ref") @@ -275553,8 +275696,15 @@ let transformStructureItem ~config mapper item = (Pat.constraint_ recordPattern (Typ.constr ~loc:emptyLoc {txt = Lident "props"; loc = emptyLoc} - (makePropsTypeParams ~stripExplicitOption:true - ~stripExplicitJsNullableOfRef:hasForwardRef namedTypeList))) + (match coreTypeOfAttr with + | None -> + makePropsTypeParams ~stripExplicitOption:true + ~stripExplicitJsNullableOfRef:hasForwardRef + namedTypeList + | Some _ -> ( + match typVarsOfCoreType with + | [] -> [] + | _ -> [Typ.any ()])))) expression in (* let make = ({id, name, ...}: props<'id, 'name, ...>) => { ... } *) @@ -275630,6 +275780,12 @@ let transformSignatureItem ~config _mapper item = check_string_int_attribute_iter.signature_item check_string_int_attribute_iter item; let hasForwardRef = ref false in + let coreTypeOfAttr = React_jsx_common.coreTypeOfAttrs pval_attributes in + let typVarsOfCoreType = + coreTypeOfAttr + |> Option.map React_jsx_common.typVarsOfCoreType + |> Option.value ~default:[] + in let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = match ptyp_desc with | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) @@ -275652,10 +275808,16 @@ let transformSignatureItem ~config _mapper item = let retPropsType = Typ.constr (Location.mkloc (Lident "props") psig_loc) - (makePropsTypeParams namedTypeList) + (match coreTypeOfAttr with + | None -> makePropsTypeParams namedTypeList + | Some _ -> ( + match typVarsOfCoreType with + | [] -> [] + | _ -> [Typ.any ()])) in let propsRecordType = - makePropsRecordTypeSig "props" psig_loc + makePropsRecordTypeSig ~coreTypeOfAttr ~typVarsOfCoreType "props" + psig_loc ((* If there is Nolabel arg, regard the type as ref in forwardRef *) (if !hasForwardRef then [(true, "ref", [], refType Location.none)] else []) @@ -275764,24 +275926,22 @@ let expr ~config mapper expression = Exp.ident ~loc {loc; txt = Ldot (Lident "React", "fragment")} in let childrenExpr = transformChildrenIfList ~mapper listItems in + let recordOfChildren children = + Exp.record [(Location.mknoloc (Lident "children"), children)] None + in let args = [ (nolabel, fragment); (match config.mode with - | "automatic" -> + | "automatic" -> ( ( nolabel, - Exp.record - [ - ( Location.mknoloc @@ Lident "children", - match childrenExpr with - | {pexp_desc = Pexp_array children} -> ( - match children with - | [] -> emptyRecord ~loc:Location.none - | [child] -> child - | _ -> childrenExpr) - | _ -> childrenExpr ); - ] - None ) + match childrenExpr with + | {pexp_desc = Pexp_array children} -> ( + match children with + | [] -> emptyRecord ~loc:Location.none + | [child] -> recordOfChildren child + | _ -> recordOfChildren childrenExpr) + | _ -> recordOfChildren childrenExpr )) | "classic" | _ -> (nolabel, childrenExpr)); ] in @@ -283075,15 +283235,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)" @@ -283175,6 +283326,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; @@ -283233,9 +283386,13 @@ let rec goToClosing closingToken state = (* Madness *) let isEs6ArrowExpression ~inTernary p = Parser.lookahead p (fun state -> - (match state.Parser.token with - | Lident "async" -> Parser.next state - | _ -> ()); + let async = + match state.Parser.token with + | Lident "async" -> + Parser.next state; + true + | _ -> false + in match state.Parser.token with | Lident _ | Underscore -> ( Parser.next state; @@ -283276,7 +283433,7 @@ let isEs6ArrowExpression ~inTernary p = | EqualGreater -> true | _ -> false) | Dot (* uncurried *) -> true - | Tilde -> true + | Tilde when not async -> true | Backtick -> false (* (` always indicates the start of an expr, can't be es6 parameter *) @@ -286699,38 +286856,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/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 15886bb145..5290656cd4 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -223956,6 +223956,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 : @@ -224599,6 +224601,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 = @@ -230460,6 +230481,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 @@ -231248,6 +231272,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 @@ -283624,6 +283705,25 @@ let hasAttr (loc, _) = loc.txt = "react.component" let hasAttrOnBinding {pvb_attributes} = List.find_opt hasAttr pvb_attributes <> None +let coreTypeOfAttrs attributes = + List.find_map + (fun ({txt}, payload) -> + match (txt, payload) with + | "react.component", PTyp coreType -> Some coreType + | _ -> None) + attributes + +let typVarsOfCoreType {ptyp_desc} = + match ptyp_desc with + | Ptyp_constr (_, coreTypes) -> + List.filter + (fun {ptyp_desc} -> + match ptyp_desc with + | Ptyp_var _ -> true + | _ -> false) + coreTypes + | _ -> [] + let raiseError ~loc msg = Location.raise_errorf ~loc msg let raiseErrorMultipleReactComponent ~loc = @@ -285143,13 +285243,30 @@ let makeTypeDecls propsName loc namedTypeList = ~kind:(Ptype_record labelDeclList); ] +let makeTypeDeclsWithCoreType propsName loc coreType typVars = + [ + Type.mk ~loc {txt = propsName; loc} ~kind:Ptype_abstract + ~params:(typVars |> List.map (fun v -> (v, Invariant))) + ~manifest:coreType; + ] + (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *) -let makePropsRecordType propsName loc namedTypeList = - Str.type_ Nonrecursive (makeTypeDecls propsName loc namedTypeList) +let makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType propsName loc + namedTypeList = + Str.type_ Nonrecursive + (match coreTypeOfAttr with + | None -> makeTypeDecls propsName loc namedTypeList + | Some coreType -> + makeTypeDeclsWithCoreType propsName loc coreType typVarsOfCoreType) (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *) -let makePropsRecordTypeSig propsName loc namedTypeList = - Sig.type_ Nonrecursive (makeTypeDecls propsName loc namedTypeList) +let makePropsRecordTypeSig ~coreTypeOfAttr ~typVarsOfCoreType propsName loc + namedTypeList = + Sig.type_ Nonrecursive + (match coreTypeOfAttr with + | None -> makeTypeDecls propsName loc namedTypeList + | Some coreType -> + makeTypeDeclsWithCoreType propsName loc coreType typVarsOfCoreType) let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc attrs callArguments = @@ -285243,7 +285360,7 @@ let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc (Exp.ident { loc = Location.none; - txt = Ldot (Lident "React", "createElementWithKey"); + txt = Ldot (Lident "JsxPPXReactSupport", "createElementWithKey"); }) [key; (nolabel, makeID); (nolabel, props)] | None, [] -> @@ -285256,7 +285373,8 @@ let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc (Exp.ident { loc = Location.none; - txt = Ldot (Lident "React", "createElementVariadicWithKey"); + txt = + Ldot (Lident "JsxPPXReactSupport", "createElementVariadicWithKey"); }) [key; (nolabel, makeID); (nolabel, props); (nolabel, children)] | Some children, [] -> @@ -285565,6 +285683,12 @@ let transformStructureItem ~config mapper item = config.hasReactComponent <- true; check_string_int_attribute_iter.structure_item check_string_int_attribute_iter item; + let coreTypeOfAttr = React_jsx_common.coreTypeOfAttrs pval_attributes in + let typVarsOfCoreType = + coreTypeOfAttr + |> Option.map React_jsx_common.typVarsOfCoreType + |> Option.value ~default:[] + in let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = match ptyp_desc with | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) @@ -285581,11 +285705,17 @@ let transformStructureItem ~config mapper item = let retPropsType = Typ.constr ~loc:pstr_loc (Location.mkloc (Lident "props") pstr_loc) - (makePropsTypeParams namedTypeList) + (match coreTypeOfAttr with + | None -> makePropsTypeParams namedTypeList + | Some _ -> ( + match typVarsOfCoreType with + | [] -> [] + | _ -> [Typ.any ()])) in (* type props<'x, 'y> = { x: 'x, y?: 'y, ... } *) let propsRecordType = - makePropsRecordType "props" pstr_loc namedTypeList + makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType "props" + pstr_loc namedTypeList in (* can't be an arrow because it will defensively uncurry *) let newExternalType = @@ -285619,6 +285749,14 @@ let transformStructureItem ~config mapper item = React_jsx_common.raiseErrorMultipleReactComponent ~loc:pstr_loc else ( config.hasReactComponent <- true; + let coreTypeOfAttr = + React_jsx_common.coreTypeOfAttrs binding.pvb_attributes + in + let typVarsOfCoreType = + coreTypeOfAttr + |> Option.map React_jsx_common.typVarsOfCoreType + |> Option.value ~default:[] + in let bindingLoc = binding.pvb_loc in let bindingPatLoc = binding.pvb_pat.ppat_loc in let binding = @@ -285809,7 +285947,8 @@ let transformStructureItem ~config mapper item = let vbMatchList = List.map vbMatch namedArgWithDefaultValueList in (* type props = { ... } *) let propsRecordType = - makePropsRecordType "props" pstr_loc namedTypeList + makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType "props" + pstr_loc namedTypeList in let innerExpression = Exp.apply @@ -285821,6 +285960,13 @@ let transformStructureItem ~config mapper item = [(Nolabel, Exp.ident (Location.mknoloc @@ Lident "ref"))] | false -> []) in + let makePropsPattern = function + | [] -> Pat.var @@ Location.mknoloc "props" + | _ -> + Pat.constraint_ + (Pat.var @@ Location.mknoloc "props") + (Typ.constr (Location.mknoloc @@ Lident "props") [Typ.any ()]) + in let fullExpression = (* React component name should start with uppercase letter *) (* let make = { let \"App" = props => make(props); \"App" } *) @@ -285828,12 +285974,9 @@ let transformStructureItem ~config mapper item = let \"App" = (props, ref) => make({...props, ref: @optional (Js.Nullabel.toOption(ref))}) })*) Exp.fun_ nolabel None - (match namedTypeList with - | [] -> Pat.var @@ Location.mknoloc "props" - | _ -> - Pat.constraint_ - (Pat.var @@ Location.mknoloc "props") - (Typ.constr (Location.mknoloc @@ Lident "props") [Typ.any ()])) + (match coreTypeOfAttr with + | None -> makePropsPattern namedTypeList + | Some _ -> makePropsPattern typVarsOfCoreType) (if hasForwardRef then Exp.fun_ nolabel None (Pat.var @@ Location.mknoloc "ref") @@ -285937,8 +286080,15 @@ let transformStructureItem ~config mapper item = (Pat.constraint_ recordPattern (Typ.constr ~loc:emptyLoc {txt = Lident "props"; loc = emptyLoc} - (makePropsTypeParams ~stripExplicitOption:true - ~stripExplicitJsNullableOfRef:hasForwardRef namedTypeList))) + (match coreTypeOfAttr with + | None -> + makePropsTypeParams ~stripExplicitOption:true + ~stripExplicitJsNullableOfRef:hasForwardRef + namedTypeList + | Some _ -> ( + match typVarsOfCoreType with + | [] -> [] + | _ -> [Typ.any ()])))) expression in (* let make = ({id, name, ...}: props<'id, 'name, ...>) => { ... } *) @@ -286014,6 +286164,12 @@ let transformSignatureItem ~config _mapper item = check_string_int_attribute_iter.signature_item check_string_int_attribute_iter item; let hasForwardRef = ref false in + let coreTypeOfAttr = React_jsx_common.coreTypeOfAttrs pval_attributes in + let typVarsOfCoreType = + coreTypeOfAttr + |> Option.map React_jsx_common.typVarsOfCoreType + |> Option.value ~default:[] + in let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = match ptyp_desc with | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) @@ -286036,10 +286192,16 @@ let transformSignatureItem ~config _mapper item = let retPropsType = Typ.constr (Location.mkloc (Lident "props") psig_loc) - (makePropsTypeParams namedTypeList) + (match coreTypeOfAttr with + | None -> makePropsTypeParams namedTypeList + | Some _ -> ( + match typVarsOfCoreType with + | [] -> [] + | _ -> [Typ.any ()])) in let propsRecordType = - makePropsRecordTypeSig "props" psig_loc + makePropsRecordTypeSig ~coreTypeOfAttr ~typVarsOfCoreType "props" + psig_loc ((* If there is Nolabel arg, regard the type as ref in forwardRef *) (if !hasForwardRef then [(true, "ref", [], refType Location.none)] else []) @@ -286148,24 +286310,22 @@ let expr ~config mapper expression = Exp.ident ~loc {loc; txt = Ldot (Lident "React", "fragment")} in let childrenExpr = transformChildrenIfList ~mapper listItems in + let recordOfChildren children = + Exp.record [(Location.mknoloc (Lident "children"), children)] None + in let args = [ (nolabel, fragment); (match config.mode with - | "automatic" -> + | "automatic" -> ( ( nolabel, - Exp.record - [ - ( Location.mknoloc @@ Lident "children", - match childrenExpr with - | {pexp_desc = Pexp_array children} -> ( - match children with - | [] -> emptyRecord ~loc:Location.none - | [child] -> child - | _ -> childrenExpr) - | _ -> childrenExpr ); - ] - None ) + match childrenExpr with + | {pexp_desc = Pexp_array children} -> ( + match children with + | [] -> emptyRecord ~loc:Location.none + | [child] -> recordOfChildren child + | _ -> recordOfChildren childrenExpr) + | _ -> recordOfChildren childrenExpr )) | "classic" | _ -> (nolabel, childrenExpr)); ] in @@ -296607,15 +296767,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)" @@ -296707,6 +296858,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; @@ -296765,9 +296918,13 @@ let rec goToClosing closingToken state = (* Madness *) let isEs6ArrowExpression ~inTernary p = Parser.lookahead p (fun state -> - (match state.Parser.token with - | Lident "async" -> Parser.next state - | _ -> ()); + let async = + match state.Parser.token with + | Lident "async" -> + Parser.next state; + true + | _ -> false + in match state.Parser.token with | Lident _ | Underscore -> ( Parser.next state; @@ -296808,7 +296965,7 @@ let isEs6ArrowExpression ~inTernary p = | EqualGreater -> true | _ -> false) | Dot (* uncurried *) -> true - | Tilde -> true + | Tilde when not async -> true | Backtick -> false (* (` always indicates the start of an expr, can't be es6 parameter *) @@ -300231,38 +300388,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/syntax b/syntax index e3aaffd5fc..180e25256f 160000 --- a/syntax +++ b/syntax @@ -1 +1 @@ -Subproject commit e3aaffd5fcf30abf0a7e9b5a856881950b845b70 +Subproject commit 180e25256fb28c00f8542ade5b0e4609593c1b31