From 8a0d5db79a17f02ee2a79af79abefb98bf045d3d Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 27 Jun 2022 16:19:05 +0200 Subject: [PATCH 01/13] Explore surface syntax for optional attributes. --- src/res_core.ml | 12 +++++++++++- tests/parsing/grammar/expressions/record.res | 2 +- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index 08f9bc77..940d9dff 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -161,6 +161,8 @@ let jsxAttr = (Location.mknoloc "JSX", Parsetree.PStr []) let uncurryAttr = (Location.mknoloc "bs", Parsetree.PStr []) let ternaryAttr = (Location.mknoloc "ns.ternary", Parsetree.PStr []) let ifLetAttr = (Location.mknoloc "ns.iflet", Parsetree.PStr []) +let optionalAttr = (Location.mknoloc "optional", Parsetree.PStr []) + let suppressFragileMatchWarningAttr = ( Location.mknoloc "warning", Parsetree.PStr @@ -2923,6 +2925,14 @@ and parseRecordExprRowWithStringKey p = | _ -> Some (field, Ast_helper.Exp.ident ~loc:field.loc field)) | _ -> None +and parseOptionalExpression p = + match p.Parser.token with + | Token.Question -> + Parser.next p; + let e = parseExpr p in + {e with pexp_attributes = optionalAttr :: e.pexp_attributes} + | _ -> parseExpr p + and parseRecordExprRow p = let attrs = parseAttributes p in let () = @@ -2939,7 +2949,7 @@ and parseRecordExprRow p = match p.Parser.token with | Colon -> Parser.next p; - let fieldExpr = parseExpr p in + let fieldExpr = parseOptionalExpression p in Some (field, fieldExpr) | _ -> let value = Ast_helper.Exp.ident ~loc:field.loc ~attrs field in diff --git a/tests/parsing/grammar/expressions/record.res b/tests/parsing/grammar/expressions/record.res index c8653e04..182b5f7b 100644 --- a/tests/parsing/grammar/expressions/record.res +++ b/tests/parsing/grammar/expressions/record.res @@ -24,7 +24,7 @@ let r = {...expr, pexp_attributes: [],} // trailing comma let r = {...make() : myRecord, foo: bar} let r = {...(make() : myRecord), foo: bar} // parens optional -let r = {x: @optional None, y: @optional None, z: @optional (None:tt)} +let r = {x: @optional None, y: ?None, z: @optional (None:tt)} let z = name => { name : @optional name, x: 3} From f149fd15846d0fdf6eee334dac875d7ad6d9888c Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 27 Jun 2022 16:30:09 +0200 Subject: [PATCH 02/13] Print optional labels with `?`. --- src/res_core.ml | 2 +- src/res_parsetree_viewer.ml | 8 +++++++- src/res_parsetree_viewer.mli | 1 + src/res_printer.ml | 3 +++ tests/parsing/grammar/expressions/expected/record.res.txt | 2 +- tests/printer/expr/expected/record.res.txt | 2 +- tests/printer/expr/record.res | 2 +- 7 files changed, 15 insertions(+), 5 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index 940d9dff..8f1d5066 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -161,7 +161,7 @@ let jsxAttr = (Location.mknoloc "JSX", Parsetree.PStr []) let uncurryAttr = (Location.mknoloc "bs", Parsetree.PStr []) let ternaryAttr = (Location.mknoloc "ns.ternary", Parsetree.PStr []) let ifLetAttr = (Location.mknoloc "ns.iflet", Parsetree.PStr []) -let optionalAttr = (Location.mknoloc "optional", Parsetree.PStr []) +let optionalAttr = (Location.mknoloc "ns.optional", Parsetree.PStr []) let suppressFragileMatchWarningAttr = ( Location.mknoloc "warning", diff --git a/src/res_parsetree_viewer.ml b/src/res_parsetree_viewer.ml index 6c335975..8049d6a9 100644 --- a/src/res_parsetree_viewer.ml +++ b/src/res_parsetree_viewer.ml @@ -169,7 +169,7 @@ let filterParsingAttrs attrs = | ( { Location.txt = ( "ns.ternary" | "ns.braces" | "res.template" | "bs" | "ns.iflet" - | "ns.namedArgLoc" ); + | "ns.namedArgLoc" | "ns.optional" ); }, _ ) -> false @@ -304,6 +304,12 @@ let isIfLetExpr expr = true | _ -> false +let rec hasOptionalAttribute attrs = + match attrs with + | [] -> false + | ({Location.txt = "ns.optional"}, _) :: _ -> true + | _ :: attrs -> hasOptionalAttribute attrs + let hasAttributes attrs = List.exists (fun attr -> diff --git a/src/res_parsetree_viewer.mli b/src/res_parsetree_viewer.mli index 3fe3e1ee..e492010b 100644 --- a/src/res_parsetree_viewer.mli +++ b/src/res_parsetree_viewer.mli @@ -83,6 +83,7 @@ val filterFragileMatchAttributes : Parsetree.attributes -> Parsetree.attributes val isJsxExpression : Parsetree.expression -> bool val hasJsxAttribute : Parsetree.attributes -> bool +val hasOptionalAttribute : Parsetree.attributes -> bool val shouldIndentBinaryExpr : Parsetree.expression -> bool val shouldInlineRhsBinaryExpr : Parsetree.expression -> bool diff --git a/src/res_printer.ml b/src/res_printer.ml index 444ea339..9e76c977 100644 --- a/src/res_printer.ml +++ b/src/res_printer.ml @@ -4658,6 +4658,9 @@ and printExpressionRecordRow (lbl, expr) cmtTbl punningAllowed = [ printLidentPath lbl cmtTbl; Doc.text ": "; + (if Res_parsetree_viewer.hasOptionalAttribute expr.pexp_attributes + then Doc.text "?" + else Doc.nil); (let doc = printExpressionWithComments expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc diff --git a/tests/parsing/grammar/expressions/expected/record.res.txt b/tests/parsing/grammar/expressions/expected/record.res.txt index 2088b88a..641048d0 100644 --- a/tests/parsing/grammar/expressions/expected/record.res.txt +++ b/tests/parsing/grammar/expressions/expected/record.res.txt @@ -15,7 +15,7 @@ let r = { (make () : myRecord) with foo = bar } let r = { x = ((None)[@optional ]); - y = ((None)[@optional ]); + y = ((None)[@ns.optional ]); z = (((None : tt))[@optional ]) } let z name = { name = ((name)[@optional ]); x = 3 } diff --git a/tests/printer/expr/expected/record.res.txt b/tests/printer/expr/expected/record.res.txt index f07c3b18..373a67be 100644 --- a/tests/printer/expr/expected/record.res.txt +++ b/tests/printer/expr/expected/record.res.txt @@ -74,7 +74,7 @@ let r = { } let r = {a /* a */, b /* b */} -let r = {x: @optional None, y: @optional None, z: (@optional None: tt)} +let r = {x: @optional None, y: ?None, z: (@optional None: tt)} let z = name => {@optional name, x: 3} diff --git a/tests/printer/expr/record.res b/tests/printer/expr/record.res index fb6abd40..e5f4d24b 100644 --- a/tests/printer/expr/record.res +++ b/tests/printer/expr/record.res @@ -64,7 +64,7 @@ let r = { } let r = {a /* a */, b /* b */} -let r = {x: @optional None, y: @optional None, z: @optional (None:tt)} +let r = {x: @optional None, y: ?None, z: @optional (None:tt)} let z = name => { name : @optional name, x: 3} From 87a7624c81b661b4e65c517c08b12e1d32f8b2bf Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 27 Jun 2022 16:46:20 +0200 Subject: [PATCH 03/13] ? syntax in punned fields --- src/res_core.ml | 17 +++++++++++++++++ src/res_printer.ml | 3 +++ .../grammar/expressions/expected/record.res.txt | 1 + tests/parsing/grammar/expressions/record.res | 2 ++ tests/printer/expr/expected/record.res.txt | 2 ++ tests/printer/expr/record.res | 2 ++ 6 files changed, 27 insertions(+) diff --git a/src/res_core.ml b/src/res_core.ml index 8f1d5066..c560ab29 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -2959,6 +2959,23 @@ and parseRecordExprRow p = | _ -> value in Some (field, value)) + | Question -> ( + Parser.next p; + match p.Parser.token with + | Lident _ | Uident _ -> + let startToken = p.token in + let field = parseValuePath p in + let value = Ast_helper.Exp.ident ~loc:field.loc ~attrs field in + let value = + match startToken with + | Uident _ -> removeModuleNameFromPunnedFieldValue value + | _ -> value + in + Some + ( field, + {value with pexp_attributes = optionalAttr :: value.pexp_attributes} + ) + | _ -> None) | _ -> None and parseRecordExprWithStringKeys ~startPos firstRow p = diff --git a/src/res_printer.ml b/src/res_printer.ml index 9e76c977..e2008346 100644 --- a/src/res_printer.ml +++ b/src/res_printer.ml @@ -4651,6 +4651,9 @@ and printExpressionRecordRow (lbl, expr) cmtTbl punningAllowed = Doc.concat [ printAttributes expr.pexp_attributes cmtTbl; + (if Res_parsetree_viewer.hasOptionalAttribute expr.pexp_attributes + then Doc.text "?" + else Doc.nil); printLidentPath lbl cmtTbl; ] | _ -> diff --git a/tests/parsing/grammar/expressions/expected/record.res.txt b/tests/parsing/grammar/expressions/expected/record.res.txt index 641048d0..e7d0cafb 100644 --- a/tests/parsing/grammar/expressions/expected/record.res.txt +++ b/tests/parsing/grammar/expressions/expected/record.res.txt @@ -21,6 +21,7 @@ let r = let z name = { name = ((name)[@optional ]); x = 3 } let z name = { name = ((name)[@optional ]); x = 3 } let z name = { name; x = ((x)[@optional ]) } +let zz name = { name; x = ((x)[@ns.optional ]) } let _ = match z with | { x = ((None)[@optional ]); y = ((None)[@optional ]); diff --git a/tests/parsing/grammar/expressions/record.res b/tests/parsing/grammar/expressions/record.res index 182b5f7b..65552af8 100644 --- a/tests/parsing/grammar/expressions/record.res +++ b/tests/parsing/grammar/expressions/record.res @@ -32,6 +32,8 @@ let z = name => { @optional name, x: 3} let z = name => { name, @optional x } +let zz = name => { name, ? x } + let _ = switch z { | {x: @optional None, y: @optional None, z: @optional (None:tt)} => 11 | {name: @optional name, x: 3} => 42 diff --git a/tests/printer/expr/expected/record.res.txt b/tests/printer/expr/expected/record.res.txt index 373a67be..485b6384 100644 --- a/tests/printer/expr/expected/record.res.txt +++ b/tests/printer/expr/expected/record.res.txt @@ -82,6 +82,8 @@ let z = name => {@optional name, x: 3} let z = name => {name, @optional x} +let zz = name => {name, ?x} + let _ = switch z { | {x: @optional None, y: @optional None, z: (@optional None: tt)} => 11 | {@optional name, x: 3} => 42 diff --git a/tests/printer/expr/record.res b/tests/printer/expr/record.res index e5f4d24b..e7588583 100644 --- a/tests/printer/expr/record.res +++ b/tests/printer/expr/record.res @@ -72,6 +72,8 @@ let z = name => { @optional name, x: 3} let z = name => { name, @optional x } +let zz = name => { name, ? x } + let _ = switch z { | {x: @optional None, y: @optional None, z: @optional (None:tt)} => 11 | {name: @optional name, x: 3} => 42 From 6533ebb70980c6502486059080d8b61326af001c Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 27 Jun 2022 16:55:51 +0200 Subject: [PATCH 04/13] Parse ? in patterns. --- src/res_core.ml | 22 ++++++++++++++++++- .../expressions/expected/record.res.txt | 6 ++++- tests/parsing/grammar/expressions/record.res | 3 +++ 3 files changed, 29 insertions(+), 2 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index c560ab29..5adc2476 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -1202,6 +1202,14 @@ and parseConstrainedPatternRegion p = | token when Grammar.isPatternStart token -> Some (parseConstrainedPattern p) | _ -> None +and parseOptionaPattern p = + match p.Parser.token with + | Question -> + Parser.next p; + let pat = parsePattern p in + {pat with ppat_attributes = optionalAttr :: pat.ppat_attributes} + | _ -> parsePattern p + (* field ::= * | longident * | longident : pattern @@ -1218,7 +1226,7 @@ and parseRecordPatternRowField ~attrs p = match p.Parser.token with | Colon -> Parser.next p; - parsePattern p + parseOptionaPattern p | _ -> Ast_helper.Pat.var ~loc:label.loc ~attrs (Location.mkloc (Longident.last label.txt) label.loc) @@ -1234,6 +1242,18 @@ and parseRecordPatternRow p = Some (true, PatField (parseRecordPatternRowField ~attrs p)) | Uident _ | Lident _ -> Some (false, PatField (parseRecordPatternRowField ~attrs p)) + | Question -> ( + Parser.next p; + match p.token with + | Uident _ | Lident _ -> + let lid, pat = parseRecordPatternRowField ~attrs p in + Some + ( false, + PatField + ( lid, + {pat with ppat_attributes = optionalAttr :: pat.ppat_attributes} + ) ) + | _ -> None) | Underscore -> Parser.next p; Some (false, PatUnderscore) diff --git a/tests/parsing/grammar/expressions/expected/record.res.txt b/tests/parsing/grammar/expressions/expected/record.res.txt index e7d0cafb..0a231b7d 100644 --- a/tests/parsing/grammar/expressions/expected/record.res.txt +++ b/tests/parsing/grammar/expressions/expected/record.res.txt @@ -27,4 +27,8 @@ let _ = | { x = ((None)[@optional ]); y = ((None)[@optional ]); z = (((None : tt))[@optional ]) } -> 11 | { name = ((name)[@optional ]); x = 3 } -> 42 - | { name = ((name)[@optional ]); x = 3 } -> 4242 \ No newline at end of file + | { name = ((name)[@optional ]); x = 3 } -> 4242 + | { x = ((None)[@ns.optional ]); y = ((None)[@ns.optional ]); + z = (((None : tt))[@ns.optional ]) } -> 11 + | { name = ((name)[@ns.optional ]); x = 3 } -> 42 + | { name = ((name)[@ns.optional ]); x = 3 } -> 4242 \ No newline at end of file diff --git a/tests/parsing/grammar/expressions/record.res b/tests/parsing/grammar/expressions/record.res index 65552af8..7ec2e1a0 100644 --- a/tests/parsing/grammar/expressions/record.res +++ b/tests/parsing/grammar/expressions/record.res @@ -38,4 +38,7 @@ let _ = switch z { | {x: @optional None, y: @optional None, z: @optional (None:tt)} => 11 | {name: @optional name, x: 3} => 42 | {@optional name, x: 3} => 4242 + | {x: ? None, y: ? None, z: ? (None:tt)} => 11 + | {name: ? name, x: 3} => 42 + | {? name, x: 3} => 4242 } From ad9b360c7a8a95e7f9249543e8915fe7b278f4fe Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 27 Jun 2022 17:02:27 +0200 Subject: [PATCH 05/13] Print patterns with ? --- src/res_printer.ml | 18 ++++++++++++++++-- tests/printer/expr/expected/record.res.txt | 3 +++ tests/printer/expr/record.res | 3 +++ 3 files changed, 22 insertions(+), 2 deletions(-) diff --git a/src/res_printer.ml b/src/res_printer.ml index e2008346..b6f60b95 100644 --- a/src/res_printer.ml +++ b/src/res_printer.ml @@ -2345,14 +2345,28 @@ and printPatternRecordRow row cmtTbl = {Parsetree.ppat_desc = Ppat_var {txt; _}; ppat_attributes} ) when ident = txt -> Doc.concat - [printAttributes ppat_attributes cmtTbl; printLidentPath longident cmtTbl] + [ + (if Res_parsetree_viewer.hasOptionalAttribute ppat_attributes then + Doc.text "?" + else Doc.nil); + printAttributes ppat_attributes cmtTbl; + printLidentPath longident cmtTbl; + ] | longident, pattern -> let locForComments = {longident.loc with loc_end = pattern.Parsetree.ppat_loc.loc_end} in let rhsDoc = let doc = printPattern pattern cmtTbl in - if Parens.patternRecordRowRhs pattern then addParens doc else doc + let doc = + if Parens.patternRecordRowRhs pattern then addParens doc else doc + in + let doc = + if Res_parsetree_viewer.hasOptionalAttribute pattern.ppat_attributes + then Doc.concat [Doc.text "?"; doc] + else doc + in + doc in let doc = Doc.group diff --git a/tests/printer/expr/expected/record.res.txt b/tests/printer/expr/expected/record.res.txt index 485b6384..3b5c1c6a 100644 --- a/tests/printer/expr/expected/record.res.txt +++ b/tests/printer/expr/expected/record.res.txt @@ -88,4 +88,7 @@ let _ = switch z { | {x: @optional None, y: @optional None, z: (@optional None: tt)} => 11 | {@optional name, x: 3} => 42 | {name: @optional dd, x: 3} => 42 +| {x: ?None, y: ?None, z: ?(None: tt)} => 11 +| {?name, x: 3} => 42 +| {?name, x: 3} => 4242 } diff --git a/tests/printer/expr/record.res b/tests/printer/expr/record.res index e7588583..ac7c3333 100644 --- a/tests/printer/expr/record.res +++ b/tests/printer/expr/record.res @@ -78,4 +78,7 @@ let _ = switch z { | {x: @optional None, y: @optional None, z: @optional (None:tt)} => 11 | {name: @optional name, x: 3} => 42 | {name: @optional dd, x: 3} => 42 + | {x: ? None, y: ? None, z: ? (None:tt)} => 11 + | {name: ? name, x: 3} => 42 + | {? name, x: 3} => 4242 } From 7243ecd70dac456eefd66ab7d3729a9faea19ded Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 27 Jun 2022 17:16:39 +0200 Subject: [PATCH 06/13] Print ? in type declarations. --- src/res_core.ml | 26 ++++++++++++++++++- src/res_printer.ml | 12 ++++++++- .../expressions/expected/record.res.txt | 5 +++- tests/parsing/grammar/expressions/record.res | 2 ++ tests/printer/expr/expected/record.res.txt | 2 ++ tests/printer/expr/record.res | 3 +++ 6 files changed, 47 insertions(+), 3 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index 5adc2476..0b0e0db3 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -4292,12 +4292,36 @@ and parseFieldDeclarationRegion p = match p.Parser.token with | Colon -> Parser.next p; - parsePolyTypeExpr p + let isOptional = + match p.token with + | Question -> + Parser.next p; + true + | _ -> false + in + let t = parsePolyTypeExpr p in + if isOptional then + {t with ptyp_attributes = optionalAttr :: t.ptyp_attributes} + else t | _ -> Ast_helper.Typ.constr ~loc:name.loc {name with txt = Lident name.txt} [] in let loc = mkLoc startPos typ.ptyp_loc.loc_end in Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ) + | Question -> ( + Parser.next p; + match p.token with + | Lident _ -> + let lident, loc = parseLident p in + let name = Location.mkloc lident loc in + let typ = + Ast_helper.Typ.constr ~loc:name.loc ~attrs:[optionalAttr] + {name with txt = Lident name.txt} + [] + in + let loc = mkLoc startPos typ.ptyp_loc.loc_end in + Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ) + | _ -> None) | _ -> None (* record-decl ::= diff --git a/src/res_printer.ml b/src/res_printer.ml index b6f60b95..1c1aa3bc 100644 --- a/src/res_printer.ml +++ b/src/res_printer.ml @@ -1426,10 +1426,20 @@ and printLabelDeclaration (ld : Parsetree.label_declaration) cmtTbl = let doc = printIdentLike ld.pld_name.txt in printComments doc cmtTbl ld.pld_name.loc in + let optional = + if Res_parsetree_viewer.hasOptionalAttribute ld.pld_type.ptyp_attributes + then Doc.text "?" + else Doc.nil + in Doc.group (Doc.concat [ - attrs; mutableFlag; name; Doc.text ": "; printTypExpr ld.pld_type cmtTbl; + attrs; + mutableFlag; + name; + Doc.text ": "; + optional; + printTypExpr ld.pld_type cmtTbl; ]) and printTypExpr (typExpr : Parsetree.core_type) cmtTbl = diff --git a/tests/parsing/grammar/expressions/expected/record.res.txt b/tests/parsing/grammar/expressions/expected/record.res.txt index 0a231b7d..38fb136e 100644 --- a/tests/parsing/grammar/expressions/expected/record.res.txt +++ b/tests/parsing/grammar/expressions/expected/record.res.txt @@ -31,4 +31,7 @@ let _ = | { x = ((None)[@ns.optional ]); y = ((None)[@ns.optional ]); z = (((None : tt))[@ns.optional ]) } -> 11 | { name = ((name)[@ns.optional ]); x = 3 } -> 42 - | { name = ((name)[@ns.optional ]); x = 3 } -> 4242 \ No newline at end of file + | { name = ((name)[@ns.optional ]); x = 3 } -> 4242 +type nonrec ttt = { + x: int ; + y: ((string)[@ns.optional ]) } \ No newline at end of file diff --git a/tests/parsing/grammar/expressions/record.res b/tests/parsing/grammar/expressions/record.res index 7ec2e1a0..2cae1518 100644 --- a/tests/parsing/grammar/expressions/record.res +++ b/tests/parsing/grammar/expressions/record.res @@ -42,3 +42,5 @@ let _ = switch z { | {name: ? name, x: 3} => 42 | {? name, x: 3} => 4242 } + +type ttt = {x:int, y: ?string} diff --git a/tests/printer/expr/expected/record.res.txt b/tests/printer/expr/expected/record.res.txt index 3b5c1c6a..3e240c87 100644 --- a/tests/printer/expr/expected/record.res.txt +++ b/tests/printer/expr/expected/record.res.txt @@ -92,3 +92,5 @@ let _ = switch z { | {?name, x: 3} => 42 | {?name, x: 3} => 4242 } + +type ttt = {x: int, y: ?string} diff --git a/tests/printer/expr/record.res b/tests/printer/expr/record.res index ac7c3333..e63a24b5 100644 --- a/tests/printer/expr/record.res +++ b/tests/printer/expr/record.res @@ -82,3 +82,6 @@ let _ = switch z { | {name: ? name, x: 3} => 42 | {? name, x: 3} => 4242 } + +type ttt = {x:int, y: ?string} + From e3584f926ed2c5e63d7eb5011b9a45cc7295a681 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 27 Jun 2022 17:57:25 +0200 Subject: [PATCH 07/13] Clean up parse ?. --- src/res_core.ml | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index 0b0e0db3..affb8c40 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -1202,13 +1202,12 @@ and parseConstrainedPatternRegion p = | token when Grammar.isPatternStart token -> Some (parseConstrainedPattern p) | _ -> None -and parseOptionaPattern p = +and parseOptionalLabel p = match p.Parser.token with | Question -> Parser.next p; - let pat = parsePattern p in - {pat with ppat_attributes = optionalAttr :: pat.ppat_attributes} - | _ -> parsePattern p + true + | _ -> false (* field ::= * | longident @@ -1226,7 +1225,11 @@ and parseRecordPatternRowField ~attrs p = match p.Parser.token with | Colon -> Parser.next p; - parseOptionaPattern p + let optional = parseOptionalLabel p in + let pat = parsePattern p in + if optional then + {pat with ppat_attributes = optionalAttr :: pat.ppat_attributes} + else pat | _ -> Ast_helper.Pat.var ~loc:label.loc ~attrs (Location.mkloc (Longident.last label.txt) label.loc) @@ -2945,14 +2948,6 @@ and parseRecordExprRowWithStringKey p = | _ -> Some (field, Ast_helper.Exp.ident ~loc:field.loc field)) | _ -> None -and parseOptionalExpression p = - match p.Parser.token with - | Token.Question -> - Parser.next p; - let e = parseExpr p in - {e with pexp_attributes = optionalAttr :: e.pexp_attributes} - | _ -> parseExpr p - and parseRecordExprRow p = let attrs = parseAttributes p in let () = @@ -2969,7 +2964,16 @@ and parseRecordExprRow p = match p.Parser.token with | Colon -> Parser.next p; - let fieldExpr = parseOptionalExpression p in + let optional = parseOptionalLabel p in + let fieldExpr = parseExpr p in + let fieldExpr = + if optional then + { + fieldExpr with + pexp_attributes = optionalAttr :: fieldExpr.pexp_attributes; + } + else fieldExpr + in Some (field, fieldExpr) | _ -> let value = Ast_helper.Exp.ident ~loc:field.loc ~attrs field in From ec1ed548dca55969eab185fc09dd3cb3a00921f3 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 27 Jun 2022 18:07:51 +0200 Subject: [PATCH 08/13] Clean up adding ns.optional attribute. --- src/res_core.ml | 48 +++++++++++++++++------------------------------- 1 file changed, 17 insertions(+), 31 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index affb8c40..86defb58 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -163,6 +163,17 @@ let ternaryAttr = (Location.mknoloc "ns.ternary", Parsetree.PStr []) let ifLetAttr = (Location.mknoloc "ns.iflet", Parsetree.PStr []) let optionalAttr = (Location.mknoloc "ns.optional", Parsetree.PStr []) +let makeExpressionOptional ~optional (e : Parsetree.expression) = + if optional then {e with pexp_attributes = optionalAttr :: e.pexp_attributes} + else e +let makePatternOptional ~optional (p : Parsetree.pattern) = + if optional then {p with ppat_attributes = optionalAttr :: p.ppat_attributes} + else p + +let makeTypeOptional ~optional (t : Parsetree.core_type) = + if optional then {t with ptyp_attributes = optionalAttr :: t.ptyp_attributes} + else t + let suppressFragileMatchWarningAttr = ( Location.mknoloc "warning", Parsetree.PStr @@ -1227,9 +1238,7 @@ and parseRecordPatternRowField ~attrs p = Parser.next p; let optional = parseOptionalLabel p in let pat = parsePattern p in - if optional then - {pat with ppat_attributes = optionalAttr :: pat.ppat_attributes} - else pat + makePatternOptional ~optional pat | _ -> Ast_helper.Pat.var ~loc:label.loc ~attrs (Location.mkloc (Longident.last label.txt) label.loc) @@ -1250,12 +1259,7 @@ and parseRecordPatternRow p = match p.token with | Uident _ | Lident _ -> let lid, pat = parseRecordPatternRowField ~attrs p in - Some - ( false, - PatField - ( lid, - {pat with ppat_attributes = optionalAttr :: pat.ppat_attributes} - ) ) + Some (false, PatField (lid, makePatternOptional ~optional:true pat)) | _ -> None) | Underscore -> Parser.next p; @@ -2966,14 +2970,7 @@ and parseRecordExprRow p = Parser.next p; let optional = parseOptionalLabel p in let fieldExpr = parseExpr p in - let fieldExpr = - if optional then - { - fieldExpr with - pexp_attributes = optionalAttr :: fieldExpr.pexp_attributes; - } - else fieldExpr - in + let fieldExpr = makeExpressionOptional ~optional fieldExpr in Some (field, fieldExpr) | _ -> let value = Ast_helper.Exp.ident ~loc:field.loc ~attrs field in @@ -2995,10 +2992,7 @@ and parseRecordExprRow p = | Uident _ -> removeModuleNameFromPunnedFieldValue value | _ -> value in - Some - ( field, - {value with pexp_attributes = optionalAttr :: value.pexp_attributes} - ) + Some (field, makeExpressionOptional ~optional:true value) | _ -> None) | _ -> None @@ -4296,17 +4290,9 @@ and parseFieldDeclarationRegion p = match p.Parser.token with | Colon -> Parser.next p; - let isOptional = - match p.token with - | Question -> - Parser.next p; - true - | _ -> false - in + let optional = parseOptionalLabel p in let t = parsePolyTypeExpr p in - if isOptional then - {t with ptyp_attributes = optionalAttr :: t.ptyp_attributes} - else t + makeTypeOptional ~optional t | _ -> Ast_helper.Typ.constr ~loc:name.loc {name with txt = Lident name.txt} [] in From ef4b9d4140a7a85cbfdd6aecf2956c2cca6a5fc7 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 27 Jun 2022 18:15:36 +0200 Subject: [PATCH 09/13] Clean up printing optional label. --- src/res_printer.ml | 29 +++++++++-------------------- 1 file changed, 9 insertions(+), 20 deletions(-) diff --git a/src/res_printer.ml b/src/res_printer.ml index 1c1aa3bc..5d9c8af7 100644 --- a/src/res_printer.ml +++ b/src/res_printer.ml @@ -523,6 +523,10 @@ let printConstant ?(templateLiteral = false) c = in Doc.text ("'" ^ str ^ "'") +let printOptionalLabel attrs = + if Res_parsetree_viewer.hasOptionalAttribute attrs then Doc.text "?" + else Doc.nil + let rec printStructure (s : Parsetree.structure) t = match s with | [] -> printCommentsInside t Location.none @@ -1426,11 +1430,7 @@ and printLabelDeclaration (ld : Parsetree.label_declaration) cmtTbl = let doc = printIdentLike ld.pld_name.txt in printComments doc cmtTbl ld.pld_name.loc in - let optional = - if Res_parsetree_viewer.hasOptionalAttribute ld.pld_type.ptyp_attributes - then Doc.text "?" - else Doc.nil - in + let optional = printOptionalLabel ld.pld_type.ptyp_attributes in Doc.group (Doc.concat [ @@ -2356,9 +2356,7 @@ and printPatternRecordRow row cmtTbl = when ident = txt -> Doc.concat [ - (if Res_parsetree_viewer.hasOptionalAttribute ppat_attributes then - Doc.text "?" - else Doc.nil); + printOptionalLabel ppat_attributes; printAttributes ppat_attributes cmtTbl; printLidentPath longident cmtTbl; ] @@ -2371,12 +2369,7 @@ and printPatternRecordRow row cmtTbl = let doc = if Parens.patternRecordRowRhs pattern then addParens doc else doc in - let doc = - if Res_parsetree_viewer.hasOptionalAttribute pattern.ppat_attributes - then Doc.concat [Doc.text "?"; doc] - else doc - in - doc + Doc.concat [printOptionalLabel pattern.ppat_attributes; doc] in let doc = Doc.group @@ -4675,9 +4668,7 @@ and printExpressionRecordRow (lbl, expr) cmtTbl punningAllowed = Doc.concat [ printAttributes expr.pexp_attributes cmtTbl; - (if Res_parsetree_viewer.hasOptionalAttribute expr.pexp_attributes - then Doc.text "?" - else Doc.nil); + printOptionalLabel expr.pexp_attributes; printLidentPath lbl cmtTbl; ] | _ -> @@ -4685,9 +4676,7 @@ and printExpressionRecordRow (lbl, expr) cmtTbl punningAllowed = [ printLidentPath lbl cmtTbl; Doc.text ": "; - (if Res_parsetree_viewer.hasOptionalAttribute expr.pexp_attributes - then Doc.text "?" - else Doc.nil); + printOptionalLabel expr.pexp_attributes; (let doc = printExpressionWithComments expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc From f885679774f454490d2513c656f5ed7f09b04f27 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 27 Jun 2022 18:23:32 +0200 Subject: [PATCH 10/13] Adapt outcome printer to print `?`. --- compiler-libs-406/printtyp.ml | 2 +- src/res_outcome_printer.ml | 2 +- tests/oprint/expected/oprint.resi.txt | 3 ++- tests/oprint/oprint.res | 4 +++- 4 files changed, 7 insertions(+), 4 deletions(-) diff --git a/compiler-libs-406/printtyp.ml b/compiler-libs-406/printtyp.ml index 57283b40..65772c7b 100644 --- a/compiler-libs-406/printtyp.ml +++ b/compiler-libs-406/printtyp.ml @@ -926,7 +926,7 @@ and tree_of_constructor cd = (name, args, Some ret) and tree_of_label l = - let opt = l.ld_attributes |> List.exists (fun ({txt}, _) -> txt = "optional") in + let opt = l.ld_attributes |> List.exists (fun ({txt}, _) -> txt = "optional" || txt = "ns.optional") in let typ = match l.ld_type.desc with | Tconstr (p, [t1], _) when opt && Path.same p Predef.path_option -> t1 | _ -> l.ld_type in diff --git a/src/res_outcome_printer.ml b/src/res_outcome_printer.ml index 2e6c4268..2c544cec 100644 --- a/src/res_outcome_printer.ml +++ b/src/res_outcome_printer.ml @@ -526,7 +526,7 @@ and printRecordDeclRowDoc (name, mut, opt, arg) = Doc.group (Doc.concat [ - (if opt then Doc.text "@optional " else Doc.nil); + (if opt then Doc.text "?" else Doc.nil); (if mut then Doc.text "mutable " else Doc.nil); printIdentLike ~allowUident:false name; Doc.text ": "; diff --git a/tests/oprint/expected/oprint.resi.txt b/tests/oprint/expected/oprint.resi.txt index fc46b88c..f53406da 100644 --- a/tests/oprint/expected/oprint.resi.txt +++ b/tests/oprint/expected/oprint.resi.txt @@ -486,4 +486,5 @@ type emptyObject = {.} let f: (~x: 'a=?, ~y: 'b) => option<'a> type call = CleanStart let f: (~a: int=?, unit) => int -type opt = {x: int, @optional y: string} \ No newline at end of file +type opt0 = {x: int, ?y: string} +type opt = {x: int, ?y: string} \ No newline at end of file diff --git a/tests/oprint/oprint.res b/tests/oprint/oprint.res index 856e371c..ee4d4cf2 100644 --- a/tests/oprint/oprint.res +++ b/tests/oprint/oprint.res @@ -360,4 +360,6 @@ type call = CleanStart let f = (~a=1, ()) => 1 -type opt = {x:int, @optional y: option} \ No newline at end of file +type opt0 = {x:int, @optional y: option} + +type opt = {x:int, @ns.optional y: option} \ No newline at end of file From 9e7fa8d3b3f300776798d9907f6f594c7e1eaea7 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 27 Jun 2022 20:29:56 +0200 Subject: [PATCH 11/13] Handle case where `?` is in the first field. --- src/res_core.ml | 2 ++ tests/parsing/grammar/expressions/expected/record.res.txt | 2 +- tests/parsing/grammar/expressions/record.res | 2 +- tests/printer/expr/expected/record.res.txt | 2 +- tests/printer/expr/record.res | 2 +- 5 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index 86defb58..3baaedf2 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -2801,7 +2801,9 @@ and parseBracedOrRecordExpr p = expr | Colon -> ( Parser.next p; + let optional = parseOptionalLabel p in let fieldExpr = parseExpr p in + let fieldExpr = makeExpressionOptional ~optional fieldExpr in match p.token with | Rbrace -> Parser.next p; diff --git a/tests/parsing/grammar/expressions/expected/record.res.txt b/tests/parsing/grammar/expressions/expected/record.res.txt index 38fb136e..3744474d 100644 --- a/tests/parsing/grammar/expressions/expected/record.res.txt +++ b/tests/parsing/grammar/expressions/expected/record.res.txt @@ -14,7 +14,7 @@ let r = { (make () : myRecord) with foo = bar } let r = { (make () : myRecord) with foo = bar } let r = { - x = ((None)[@optional ]); + x = ((None)[@ns.optional ]); y = ((None)[@ns.optional ]); z = (((None : tt))[@optional ]) } diff --git a/tests/parsing/grammar/expressions/record.res b/tests/parsing/grammar/expressions/record.res index 2cae1518..996bade2 100644 --- a/tests/parsing/grammar/expressions/record.res +++ b/tests/parsing/grammar/expressions/record.res @@ -24,7 +24,7 @@ let r = {...expr, pexp_attributes: [],} // trailing comma let r = {...make() : myRecord, foo: bar} let r = {...(make() : myRecord), foo: bar} // parens optional -let r = {x: @optional None, y: ?None, z: @optional (None:tt)} +let r = {x: ? None, y: ?None, z: @optional (None:tt)} let z = name => { name : @optional name, x: 3} diff --git a/tests/printer/expr/expected/record.res.txt b/tests/printer/expr/expected/record.res.txt index 3e240c87..93ff44ba 100644 --- a/tests/printer/expr/expected/record.res.txt +++ b/tests/printer/expr/expected/record.res.txt @@ -74,7 +74,7 @@ let r = { } let r = {a /* a */, b /* b */} -let r = {x: @optional None, y: ?None, z: (@optional None: tt)} +let r = {x: ?None, y: ?None, z: (@optional None: tt)} let z = name => {@optional name, x: 3} diff --git a/tests/printer/expr/record.res b/tests/printer/expr/record.res index e63a24b5..d3fff86b 100644 --- a/tests/printer/expr/record.res +++ b/tests/printer/expr/record.res @@ -64,7 +64,7 @@ let r = { } let r = {a /* a */, b /* b */} -let r = {x: @optional None, y: ?None, z: @optional (None:tt)} +let r = {x: ? None, y: ?None, z: @optional (None:tt)} let z = name => { name : @optional name, x: 3} From f37506a7b13b7b32f95a7467a330c80723e66a99 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 27 Jun 2022 20:32:33 +0200 Subject: [PATCH 12/13] Handle `?` in first punned field. --- src/res_core.ml | 4 ++++ tests/parsing/grammar/expressions/expected/record.res.txt | 2 +- tests/parsing/grammar/expressions/record.res | 2 +- tests/printer/expr/expected/record.res.txt | 2 +- tests/printer/expr/record.res | 2 +- 5 files changed, 8 insertions(+), 4 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index 3baaedf2..19565881 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -2771,6 +2771,10 @@ and parseBracedOrRecordExpr p = let loc = mkLoc startPos p.prevEndPos in let braces = makeBracesAttr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes})) + | Question -> + let expr = parseRecordExpr ~startPos [] p in + Parser.expect Rbrace p; + expr | Uident _ | Lident _ -> ( let startToken = p.token in let valueOrConstructor = parseValueOrConstructor p in diff --git a/tests/parsing/grammar/expressions/expected/record.res.txt b/tests/parsing/grammar/expressions/expected/record.res.txt index 3744474d..3ab0783a 100644 --- a/tests/parsing/grammar/expressions/expected/record.res.txt +++ b/tests/parsing/grammar/expressions/expected/record.res.txt @@ -19,7 +19,7 @@ let r = z = (((None : tt))[@optional ]) } let z name = { name = ((name)[@optional ]); x = 3 } -let z name = { name = ((name)[@optional ]); x = 3 } +let z name = { name = ((name)[@ns.optional ]); x = 3 } let z name = { name; x = ((x)[@optional ]) } let zz name = { name; x = ((x)[@ns.optional ]) } let _ = diff --git a/tests/parsing/grammar/expressions/record.res b/tests/parsing/grammar/expressions/record.res index 996bade2..640e8c89 100644 --- a/tests/parsing/grammar/expressions/record.res +++ b/tests/parsing/grammar/expressions/record.res @@ -28,7 +28,7 @@ let r = {x: ? None, y: ?None, z: @optional (None:tt)} let z = name => { name : @optional name, x: 3} -let z = name => { @optional name, x: 3} +let z = name => { ? name, x: 3} let z = name => { name, @optional x } diff --git a/tests/printer/expr/expected/record.res.txt b/tests/printer/expr/expected/record.res.txt index 93ff44ba..fb084b8a 100644 --- a/tests/printer/expr/expected/record.res.txt +++ b/tests/printer/expr/expected/record.res.txt @@ -78,7 +78,7 @@ let r = {x: ?None, y: ?None, z: (@optional None: tt)} let z = name => {@optional name, x: 3} -let z = name => {@optional name, x: 3} +let z = name => {?name, x: 3} let z = name => {name, @optional x} diff --git a/tests/printer/expr/record.res b/tests/printer/expr/record.res index d3fff86b..525fe9a8 100644 --- a/tests/printer/expr/record.res +++ b/tests/printer/expr/record.res @@ -68,7 +68,7 @@ let r = {x: ? None, y: ?None, z: @optional (None:tt)} let z = name => { name : @optional name, x: 3} -let z = name => { @optional name, x: 3} +let z = name => { ? name, x: 3} let z = name => { name, @optional x } From da3bc928f31d034752d9124c23339618e984f616 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 27 Jun 2022 21:20:13 +0200 Subject: [PATCH 13/13] Use `x?: t` --- compiler-libs-406/oprint.ml | 2 +- src/res_core.ml | 28 ++++--------------- src/res_printer.ml | 4 +-- .../expressions/expected/record.res.txt | 5 +++- tests/parsing/grammar/expressions/record.res | 4 ++- tests/printer/expr/expected/record.res.txt | 4 ++- tests/printer/expr/record.res | 3 +- 7 files changed, 21 insertions(+), 29 deletions(-) diff --git a/compiler-libs-406/oprint.ml b/compiler-libs-406/oprint.ml index 26ff1bcd..1aa71f66 100644 --- a/compiler-libs-406/oprint.ml +++ b/compiler-libs-406/oprint.ml @@ -390,7 +390,7 @@ and print_typargs ppf = pp_close_box ppf (); pp_print_space ppf () and print_out_label ppf (name, mut, opt, arg) = - fprintf ppf "@[<2>%s%s%s :@ %a@];" (if opt then "@optional " else "") (if mut then "mutable " else "") name + fprintf ppf "@[<2>%s%s%s :@ %a@];" (if mut then "mutable " else "") name (if opt then "?" else "") print_out_type arg let out_type = ref print_out_type diff --git a/src/res_core.ml b/src/res_core.ml index 19565881..831fe435 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -170,10 +170,6 @@ let makePatternOptional ~optional (p : Parsetree.pattern) = if optional then {p with ppat_attributes = optionalAttr :: p.ppat_attributes} else p -let makeTypeOptional ~optional (t : Parsetree.core_type) = - if optional then {t with ptyp_attributes = optionalAttr :: t.ptyp_attributes} - else t - let suppressFragileMatchWarningAttr = ( Location.mknoloc "warning", Parsetree.PStr @@ -4292,32 +4288,20 @@ and parseFieldDeclarationRegion p = | Lident _ -> let lident, loc = parseLident p in let name = Location.mkloc lident loc in + let optional = parseOptionalLabel p in let typ = match p.Parser.token with | Colon -> Parser.next p; - let optional = parseOptionalLabel p in - let t = parsePolyTypeExpr p in - makeTypeOptional ~optional t + parsePolyTypeExpr p | _ -> - Ast_helper.Typ.constr ~loc:name.loc {name with txt = Lident name.txt} [] + Ast_helper.Typ.constr ~loc:name.loc ~attrs + {name with txt = Lident name.txt} + [] in let loc = mkLoc startPos typ.ptyp_loc.loc_end in + let attrs = if optional then optionalAttr :: attrs else attrs in Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ) - | Question -> ( - Parser.next p; - match p.token with - | Lident _ -> - let lident, loc = parseLident p in - let name = Location.mkloc lident loc in - let typ = - Ast_helper.Typ.constr ~loc:name.loc ~attrs:[optionalAttr] - {name with txt = Lident name.txt} - [] - in - let loc = mkLoc startPos typ.ptyp_loc.loc_end in - Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ) - | _ -> None) | _ -> None (* record-decl ::= diff --git a/src/res_printer.ml b/src/res_printer.ml index 5d9c8af7..02359977 100644 --- a/src/res_printer.ml +++ b/src/res_printer.ml @@ -1430,15 +1430,15 @@ and printLabelDeclaration (ld : Parsetree.label_declaration) cmtTbl = let doc = printIdentLike ld.pld_name.txt in printComments doc cmtTbl ld.pld_name.loc in - let optional = printOptionalLabel ld.pld_type.ptyp_attributes in + let optional = printOptionalLabel ld.pld_attributes in Doc.group (Doc.concat [ attrs; mutableFlag; name; - Doc.text ": "; optional; + Doc.text ": "; printTypExpr ld.pld_type cmtTbl; ]) diff --git a/tests/parsing/grammar/expressions/expected/record.res.txt b/tests/parsing/grammar/expressions/expected/record.res.txt index 3ab0783a..6e4fc91f 100644 --- a/tests/parsing/grammar/expressions/expected/record.res.txt +++ b/tests/parsing/grammar/expressions/expected/record.res.txt @@ -32,6 +32,9 @@ let _ = z = (((None : tt))[@ns.optional ]) } -> 11 | { name = ((name)[@ns.optional ]); x = 3 } -> 42 | { name = ((name)[@ns.optional ]); x = 3 } -> 4242 +type nonrec tt = { + x: int ; + y: string [@ns.opttinal ]} type nonrec ttt = { x: int ; - y: ((string)[@ns.optional ]) } \ No newline at end of file + y: string [@ns.optional ]} \ No newline at end of file diff --git a/tests/parsing/grammar/expressions/record.res b/tests/parsing/grammar/expressions/record.res index 640e8c89..2f32f489 100644 --- a/tests/parsing/grammar/expressions/record.res +++ b/tests/parsing/grammar/expressions/record.res @@ -43,4 +43,6 @@ let _ = switch z { | {? name, x: 3} => 4242 } -type ttt = {x:int, y: ?string} +type tt = {x:int, @ns.opttinal y : string} + +type ttt = {x:int, y?: string} diff --git a/tests/printer/expr/expected/record.res.txt b/tests/printer/expr/expected/record.res.txt index fb084b8a..b792483a 100644 --- a/tests/printer/expr/expected/record.res.txt +++ b/tests/printer/expr/expected/record.res.txt @@ -93,4 +93,6 @@ let _ = switch z { | {?name, x: 3} => 4242 } -type ttt = {x: int, y: ?string} +type tt = {x: int, y?: string} + +type ttt = {x: int, y?: string} diff --git a/tests/printer/expr/record.res b/tests/printer/expr/record.res index 525fe9a8..460bdd4e 100644 --- a/tests/printer/expr/record.res +++ b/tests/printer/expr/record.res @@ -83,5 +83,6 @@ let _ = switch z { | {? name, x: 3} => 4242 } -type ttt = {x:int, y: ?string} +type tt = {x:int, @ns.optional y: string} +type ttt = {x:int, y?: string}