Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
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
324 changes: 306 additions & 18 deletions src/Compiler/Checking/CheckDeclarations.fs

Large diffs are not rendered by default.

18 changes: 14 additions & 4 deletions src/Compiler/Checking/CheckPatterns.fs
Original file line number Diff line number Diff line change
Expand Up @@ -457,13 +457,22 @@ and TcPatArrayOrList warnOnUpper cenv env vFlags patEnv ty isArray args m =
phase2, acc

and TcRecordPat warnOnUpper (cenv: cenv) env vFlags patEnv ty fieldPats m =
let fieldPats =
let idents =
fieldPats
|> List.map (fun fieldPat ->
let (|Last|) = List.last
match fieldPat with
| NamePatPairField (fieldName = SynLongIdent (id = [fieldId]))
| NamePatPairField (fieldName = SynLongIdent (id = Last fieldId)) -> fieldId)

let fieldPats =
fieldPats
|> List.map (fun (NamePatPairField(fieldName = fieldLid; pat = pat)) ->
match fieldLid.LongIdent with
| [id] -> ([], id), pat
| lid -> List.frontAndBack lid, pat)
| [id] -> ExplicitOrSpread.Explicit (([], id), pat)
| lid -> ExplicitOrSpread.Explicit (List.frontAndBack lid, pat))

CheckRecdExprDuplicateFields idents
match BuildFieldMap cenv env false ty fieldPats m with
| None -> (fun _ -> TPat_error m), patEnv
| Some(tinst, tcref, fldsmap, _fldsList) ->
Expand All @@ -479,13 +488,14 @@ and TcRecordPat warnOnUpper (cenv: cenv) env vFlags patEnv ty fieldPats m =
let fieldPats, patEnvR =
(patEnv, ftys) ||> List.mapFold (fun s (ty, fsp) ->
match fldsmap.TryGetValue fsp.rfield_id.idText with
| true, v ->
| true, ExplicitOrSpread.Explicit v ->
let warnOnUpper =
if cenv.g.langVersion.SupportsFeature(LanguageFeature.DontWarnOnUppercaseIdentifiersInBindingPatterns) then
AllIdsOK
else
warnOnUpper
TcPat warnOnUpper cenv env None vFlags s ty v
| true, ExplicitOrSpread.Spread _ -> (* Unreachable. *) error (InternalError ("Spreads in patterns are not supported.", m))
| _ -> (fun _ -> TPat_wild m), s)

let phase2 values =
Expand Down
41 changes: 26 additions & 15 deletions src/Compiler/Checking/CheckRecordSyntaxHelpers.fs
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,6 @@ open FSharp.Compiler.Text.Range
open FSharp.Compiler.TypedTree
open FSharp.Compiler.Xml
open FSharp.Compiler.SyntaxTrivia
open TypedTreeOps

/// Merges updates to nested record fields on the same level in record copy-and-update.
///
Expand All @@ -29,27 +28,29 @@ open TypedTreeOps
/// which we here convert to
///
/// { x with A = { x.A with B = 10; C = "" } }
let GroupUpdatesToNestedFields (fields: ((Ident list * Ident) * SynExpr option) list) =
let GroupUpdatesToNestedFields (fields: (ExplicitOrSpread<(Ident list * Ident) * SynExpr option, (Ident list * Ident) * 'Spread>) list) =
let rec groupIfNested res xs =
match xs with
| [] -> res
| [ x ] -> x :: res
| x :: y :: ys ->
match x, y with
| (lidwid, Some(SynExpr.Record(baseInfo, copyInfo, fields1, m))), (_, Some(SynExpr.Record(recordFields = fields2))) ->
| ExplicitOrSpread.Explicit(lidwid, Some(SynExpr.Record(baseInfo, copyInfo, fields1, m))),
ExplicitOrSpread.Explicit(_, Some(SynExpr.Record(recordFields = fields2))) ->
let reducedRecd =
(lidwid, Some(SynExpr.Record(baseInfo, copyInfo, fields1 @ fields2, m)))
ExplicitOrSpread.Explicit(lidwid, Some(SynExpr.Record(baseInfo, copyInfo, fields1 @ fields2, m)))

groupIfNested res (reducedRecd :: ys)
| (lidwid, Some(SynExpr.AnonRecd(isStruct, copyInfo, fields1, m, trivia))), (_, Some(SynExpr.AnonRecd(recordFields = fields2))) ->
| ExplicitOrSpread.Explicit(lidwid, Some(SynExpr.AnonRecd(isStruct, copyInfo, fields1, m, trivia))),
ExplicitOrSpread.Explicit(_, Some(SynExpr.AnonRecd(recordFields = fields2))) ->
let reducedRecd =
(lidwid, Some(SynExpr.AnonRecd(isStruct, copyInfo, fields1 @ fields2, m, trivia)))
ExplicitOrSpread.Explicit(lidwid, Some(SynExpr.AnonRecd(isStruct, copyInfo, fields1 @ fields2, m, trivia)))

groupIfNested res (reducedRecd :: ys)
| _ -> groupIfNested (x :: res) (y :: ys)

fields
|> List.groupBy (fun ((_, field), _) -> field.idText)
|> List.groupBy (fun (ExplicitOrSpread.Explicit((_, field), _) | ExplicitOrSpread.Spread((_, field), _)) -> field.idText)
|> List.collect (fun (_, fields) ->
if fields.Length < 2 then
fields
Expand Down Expand Up @@ -123,18 +124,28 @@ let TransformAstForNestedUpdates (cenv: TcFileState) (env: TcEnv) overallTy (lid
| Item.AnonRecdField(
anonInfo = {
AnonRecdTypeInfo.TupInfo = TupInfo.Const isStruct
}) ->
let fields = [ LongIdentWithDots([ fieldId ], []), None, nestedField ]
}
range = m) ->
let fields =
[
SynExprAnonRecordFieldOrSpread.Field(
SynExprAnonRecordField(LongIdentWithDots([ fieldId ], []), None, nestedField, m),
None
)
]

SynExpr.AnonRecd(isStruct, copyInfo outerFieldId, fields, outerFieldId.idRange, { OpeningBraceRange = range0 })
| _ ->
let fields =
[
SynExprRecordField(
(LongIdentWithDots([ fieldId ], []), true),
None,
Some nestedField,
unionRanges fieldId.idRange nestedField.Range,
None
SynExprRecordFieldOrSpread.Field(
SynExprRecordField(
(LongIdentWithDots([ fieldId ], []), true),
None,
Some nestedField,
unionRanges fieldId.idRange nestedField.Range,
None
)
)
]

Expand Down
4 changes: 3 additions & 1 deletion src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -3,12 +3,14 @@
module internal FSharp.Compiler.CheckRecordSyntaxHelpers

open FSharp.Compiler.CheckBasics
open FSharp.Compiler.NameResolution
open FSharp.Compiler.Syntax
open FSharp.Compiler.Text
open FSharp.Compiler.TypedTree

val GroupUpdatesToNestedFields:
fields: ((Ident list * Ident) * SynExpr option) list -> ((Ident list * Ident) * SynExpr option) list
fields: (ExplicitOrSpread<(Ident list * Ident) * SynExpr option, (Ident list * Ident) * 'Spread>) list ->
(ExplicitOrSpread<(Ident list * Ident) * SynExpr option, (Ident list * Ident) * 'Spread>) list

val TransformAstForNestedUpdates<'a> :
cenv: TcFileState ->
Expand Down
Loading
Loading