Skip to content

WIP: with- keyword support for anonymous records #11911

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 2 commits into from
Closed

WIP: with- keyword support for anonymous records #11911

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
4153f75
WIP: 'with-' keyword support for anonymous records
vzarytovskii Aug 4, 2021
bc05605
Merge branch 'dotnet:main' into without-anonrecd
vzarytovskii Aug 4, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 7 additions & 7 deletions src/fsharp/CheckExpressions.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4242,10 +4242,10 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: UnscopedTyparEnv
let args',tpenv = TcTypesAsTuple cenv newOk checkCxs occ env tpenv args m
TType_tuple(tupInfo,args'),tpenv

| SynType.AnonRecd(_, [],m) ->
| SynType.AnonRecd(_, [], m) ->
error(Error((FSComp.SR.tcAnonymousTypeInvalidInDeclaration()), m))

| SynType.AnonRecd(isStruct, args,m) ->
| SynType.AnonRecd(isStruct, args, m) ->
let tupInfo = mkTupInfo isStruct
let args',tpenv = TcTypesAsTuple cenv newOk checkCxs occ env tpenv (args |> List.map snd |> List.map (fun x -> (false,x))) m
let unsortedFieldIds = args |> List.map fst |> List.toArray
Expand Down Expand Up @@ -5583,8 +5583,8 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) =
let expr = mkAnyTupled cenv.g m tupInfo args' argTys
expr, tpenv

| SynExpr.AnonRecd (isStruct, optOrigExpr, unsortedFieldExprs, mWholeExpr) ->
TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigExpr, unsortedFieldExprs, mWholeExpr)
| SynExpr.AnonRecd (isStruct, optOrigExpr, withoutFields, unsortedFieldExprs, mWholeExpr) ->
TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigExpr, withoutFields, unsortedFieldExprs, mWholeExpr)

| SynExpr.ArrayOrList (isArray, args, m) ->
CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.AccessRights)
Expand Down Expand Up @@ -6989,7 +6989,7 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr


// Check '{| .... |}'
and TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigSynExpr, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) =
and TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigSynExpr, _withoutFields, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) =
let unsortedFieldSynExprsGiven = List.map snd unsortedFieldIdsAndSynExprsGiven

match optOrigSynExpr with
Expand Down Expand Up @@ -7024,10 +7024,10 @@ and TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigSynExpr, unsortedF
mkAnonRecd cenv.g mWholeExpr anonInfo unsortedFieldIds unsortedCheckedArgs unsortedFieldTys, tpenv

| Some (origExpr, _) ->
// The fairly complex case '{| origExpr with X = 1; Y = 2 |}'
// The fairly complex case '{| origExpr with X = 1; Y = 2 with- Z|}'
// The origExpr may be either a record or anonymous record.
// The origExpr may be either a struct or not.
// All the properties of origExpr are copied across except where they are overridden.
// All the properties of origExpr are copied across except where they are overridden or are in `withoutFields` list.
// The result is a field-sorted anonymous record.
//
// Unlike in the case of record type copy-and-update we do _not_ assume that the origExpr has the same type as the overall expression.
Expand Down
7 changes: 4 additions & 3 deletions src/fsharp/SyntaxTree.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -369,7 +369,7 @@ type SynType =

| AnonRecd of
isStruct: bool *
fields:(Ident * SynType) list *
fields: (Ident * SynType) list *
range: range

| Array of
Expand Down Expand Up @@ -477,8 +477,9 @@ type SynExpr =

| AnonRecd of
isStruct: bool *
copyInfo:(SynExpr * BlockSeparator) option *
recordFields:(Ident * SynExpr) list *
copyInfo: (SynExpr * BlockSeparator) option *
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Could we have the range of the with- keyword in the tree as well?
This would be useful for Fantomas if the code has a comment after the with- for example.

type A = { X: int; Y: int }
let a = { X = 1; Y = 2 }
let b = {| a with- // foo 
                                  Y |}

withoutFields: Ident list *
recordFields: (Ident * SynExpr) list *
range: range

| ArrayOrList of
Expand Down
3 changes: 2 additions & 1 deletion src/fsharp/SyntaxTree.fsi
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -462,7 +462,7 @@ type SynType =
/// F# syntax: struct {| id: type; ...; id: type |}
| AnonRecd of
isStruct: bool *
fields:(Ident * SynType) list *
fields: (Ident * SynType) list *
range: range

/// F# syntax: type[]
Expand Down Expand Up @@ -579,6 +579,7 @@ type SynExpr =
| AnonRecd of
isStruct: bool *
copyInfo:(SynExpr * BlockSeparator) option *
withoutFields: Ident list *
recordFields:(Ident * SynExpr) list *
range: range

Expand Down
4 changes: 2 additions & 2 deletions src/fsharp/SyntaxTreeOps.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -685,9 +685,9 @@ let rec synExprContainsError inpExpr =
| SynExpr.Tuple (_, es, _, _) ->
walkExprs es

| SynExpr.AnonRecd (_, origExpr, flds, _) ->
| SynExpr.AnonRecd (_, origExpr, _withouts, flds, _) ->
(match origExpr with Some (e, _) -> walkExpr e | None -> false) ||
walkExprs (List.map snd flds)
walkExprs (List.map snd flds) // || walkExprs withouts

| SynExpr.Record (_, origExpr, fs, _) ->
(match origExpr with Some (e, _) -> walkExpr e | None -> false) ||
Expand Down
2 changes: 2 additions & 0 deletions src/fsharp/lex.fsl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -886,6 +886,8 @@ rule token args skip = parse

| "-" { MINUS }

| "with-" { WITH_MINUS }

| "~" { RESERVED }

| "`" { RESERVED }
Expand Down
62 changes: 47 additions & 15 deletions src/fsharp/pars.fsy
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -247,6 +247,7 @@ let rangeOfLongIdent(lid:LongIdent) =
%token LAZY OLAZY MATCH MATCH_BANG MUTABLE NEW OF
%token OPEN OR REC THEN TO TRUE TRY TYPE VAL INLINE INTERFACE INSTANCE CONST
%token WHEN WHILE WITH HASH AMP AMP_AMP QUOTE LPAREN RPAREN RPAREN_COMING_SOON RPAREN_IS_HERE STAR COMMA RARROW GREATER_BAR_RBRACK LPAREN_STAR_RPAREN
%token WITH_MINUS
%token QMARK QMARK_QMARK DOT COLON COLON_COLON COLON_GREATER COLON_QMARK_GREATER COLON_QMARK COLON_EQUALS SEMICOLON
%token SEMICOLON_SEMICOLON LARROW EQUALS LBRACK LBRACK_BAR LBRACE_BAR LBRACK_LESS
%token BAR_RBRACK BAR_RBRACE UNDERSCORE
Expand Down Expand Up @@ -4607,7 +4608,9 @@ recdExpr:
(Some ($2, arg, rhs2 parseState 2 4, inheritsSep, rhs parseState 1), None, bindings) }

| recdExprCore
{ let a, b = $1 in (None, a, b) }
{ let prevExpr, withouts, withs = $1
// TODO: Error if withouts is not None.
(None, prevExpr, withs) }

recdExprCore:
| appExpr EQUALS declExprBlock recdExprBindings opt_seps_recd
Expand All @@ -4616,7 +4619,7 @@ recdExprCore:
let f = mkRecdField f
let l = List.rev $4
let l = rebindRanges (f, Some $3) l $5
(None, l)
(None, [], l)
| _ -> raiseParseErrorAt (rhs parseState 2) (FSComp.SR.parsFieldBinding()) }

/*
Expand All @@ -4628,7 +4631,7 @@ recdExprCore:
reportParseErrorAt m (FSComp.SR.parsUnderscoreInvalidFieldName())
reportParseErrorAt m (FSComp.SR.parsFieldBinding())
let f = mkUnderscoreRecdField m
(None, [ (f, None, None) ]) }
(None, [], [ (f, None, None) ]) }

| UNDERSCORE EQUALS
{ let m = rhs parseState 1
Expand All @@ -4637,28 +4640,57 @@ recdExprCore:

reportParseErrorAt (rhs2 parseState 1 2) (FSComp.SR.parsFieldBinding())

(None, [ (f, None, None) ]) }
(None, [], [ (f, None, None) ]) }

| UNDERSCORE EQUALS declExprBlock recdExprBindings opt_seps_recd
{ reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnderscoreInvalidFieldName())
let f = mkUnderscoreRecdField (rhs parseState 1)
let l = List.rev $4
let l = rebindRanges (f, Some $3) l $5
(None, l) }
(None, [], l) }

/* handles case like {x with} */
| appExpr WITH recdBinding recdExprBindings opt_seps_recd
{ let l = List.rev $4
let l = rebindRanges $3 l $5
(Some ($1, (rhs parseState 2, None)), l) }
(Some ($1, (rhs parseState 2, None)), [], l) }

| appExpr OWITH opt_seps_recd OEND
{ (Some ($1, (rhs parseState 2, None)), []) }
| appExpr OWITH opt_seps_recd OEND
{ (Some ($1, (rhs parseState 2, None)), [], []) }

| appExpr OWITH recdBinding recdExprBindings opt_seps_recd OEND
{ let l = List.rev $4
let l = rebindRanges $3 l $5
(Some ($1, (rhs parseState 2, None)), l) }
(Some ($1, (rhs parseState 2, None)), [], l) }

| appExpr WITH_MINUS commaSepIdentList WITH recdBinding recdExprBindings opt_seps_recd
{ let l = List.rev $6
let l = rebindRanges $5 l $7
(Some ($1, (rhs parseState 2, None)), $3, l) }

| appExpr WITH_MINUS commaSepIdentList OWITH recdBinding recdExprBindings opt_seps_recd OEND
{ let l = List.rev $6
let l = rebindRanges $5 l $7
(Some ($1, (rhs parseState 2, None)), $3, l) }

/* A list of arguments in a 'with-' expression */
commaSepIdentList:
| commaSepIdentListMore
{ List.rev $1 }

| ident
{ [$1] }
|
{ [] }


/* Part of the list of arguments in a 'with-' expression */
commaSepIdentListMore:
| commaSepIdentListMore COMMA ident
{ $3 :: $1 }

| ident COMMA ident
{ [$3; $1] }

opt_seps_recd:
| seps_recd
Expand Down Expand Up @@ -4802,25 +4834,25 @@ braceBarExpr:

braceBarExprCore:
| LBRACE_BAR recdExprCore bar_rbrace
{ let orig, flds = $2
{ let orig, withouts, flds = $2
let flds =
flds |> List.choose (function
| ((LongIdentWithDots([id], _), _), Some e, _) -> Some (id, e)
| ((LongIdentWithDots([id], _), _), None, _) -> Some (id, arbExpr("anonField", id.idRange))
| _ -> reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidAnonRecdType()); None)
let m = rhs2 parseState 1 3
(fun isStruct -> SynExpr.AnonRecd (isStruct, orig, flds, m)) }
(fun isStruct -> SynExpr.AnonRecd (isStruct, orig, withouts, flds, m)) }

| LBRACE_BAR recdExprCore recover
{ reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBraceBar())
let orig, flds = $2
let orig, withouts, flds = $2
let flds =
flds |> List.choose (function
| ((LongIdentWithDots([id], _), _), Some e, _) -> Some (id, e)
| ((LongIdentWithDots([id], _), _), None, _) -> Some (id, arbExpr("anonField", id.idRange))
| _ -> reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidAnonRecdType()); None)
let m = rhs2 parseState 1 2
(fun isStruct -> SynExpr.AnonRecd (isStruct, orig, flds, m)) }
(fun isStruct -> SynExpr.AnonRecd (isStruct, orig, withouts, flds, m)) }

| LBRACE_BAR error bar_rbrace
{ // silent recovery
Expand All @@ -4830,11 +4862,11 @@ braceBarExprCore:
| LBRACE_BAR recover
{ reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBraceBar())
let m = rhs2 parseState 1 1
(fun isStruct -> SynExpr.AnonRecd (isStruct, None, [], m)) }
(fun isStruct -> SynExpr.AnonRecd (isStruct, None, [], [], m)) }

| LBRACE_BAR bar_rbrace
{ let m = rhs2 parseState 1 2
(fun isStruct -> SynExpr.AnonRecd (isStruct, None, [], m)) }
(fun isStruct -> SynExpr.AnonRecd (isStruct, None, [], [], m)) }

anonLambdaExpr:
| FUN atomicPatterns RARROW typedSeqExprBlock
Expand Down
2 changes: 1 addition & 1 deletion src/fsharp/service/FSharpParseFileResults.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -549,7 +549,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput,
| None -> ()
yield! walkExprs (fs |> List.choose p23)

| SynExpr.AnonRecd (_isStruct, copyExprOpt, fs, _) ->
| SynExpr.AnonRecd (_isStruct, copyExprOpt, _withoutFields, fs, _) ->
match copyExprOpt with
| Some (e, _) -> yield! walkExpr true e
| None -> ()
Expand Down
2 changes: 1 addition & 1 deletion src/fsharp/service/ServiceLexing.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -272,7 +272,7 @@ module internal TokenClassifications =
| UPCAST | DOWNCAST | NULL | RESERVED | MODULE | AND | AS | ASSERT | ASR
| DOWNTO | EXCEPTION | FALSE | FOR | FUN | FUNCTION
| FINALLY | LAZY | MATCH | MATCH_BANG | MUTABLE | NEW | OF | OPEN | OR | VOID | EXTERN
| INTERFACE | REC | TO | TRUE | TRY | TYPE | VAL | INLINE | WHEN | WHILE | WITH
| INTERFACE | REC | TO | TRUE | TRY | TYPE | VAL | INLINE | WHEN | WHILE | WITH | WITH_MINUS
| IF | THEN | ELSE | DO | DONE | LET _ | AND_BANG _ | IN | CONST
| HIGH_PRECEDENCE_PAREN_APP | FIXED
| HIGH_PRECEDENCE_BRACK_APP
Expand Down
2 changes: 1 addition & 1 deletion src/fsharp/service/ServiceParseTreeWalk.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -260,7 +260,7 @@ module SyntaxTraversal =
| SynExpr.ArrayOrList (_, synExprList, _range) ->
synExprList |> List.map (fun x -> dive x x.Range traverseSynExpr) |> pick expr

| SynExpr.AnonRecd (_isStruct, copyOpt, synExprList, _range) ->
| SynExpr.AnonRecd (_isStruct, copyOpt, _withoutFields, synExprList, _range) ->
[ match copyOpt with
| Some(expr, (withRange, _)) ->
yield dive expr expr.Range traverseSynExpr
Expand Down
28 changes: 28 additions & 0 deletions tests/FSharp.Compiler.ComponentTests/Language/AnonymousRecordsTests.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,28 @@
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.

namespace FSharp.Compiler.ComponentTests.Language

open Xunit
open FSharp.Test.Compiler

module ``Anonymous records tests`` =

[<Fact>]
let ``Simple with- should remove one field`` () =
Fsx """
type A = { X: int; Y: int }
let a = { X = 1; Y = 2 }
let b = {| a with- Y |}
"""
|> compile
|> shouldSucceed

[<Fact>]
let ``with- shouldn't remove the only field`` () =
Fsx """
type A = { X: int }
let a = { X = 1 }
let b = {| a with- X |}
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This would be quite a use case for #6941

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I would expect a with- to always remove the field. When the fields already present are controlled elsewhere, I would want this to be a guarantee.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The flow of fields should allow an empty state where more fields can be added later.

"""
|> compile
|> shouldSucceed