Skip to content
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.

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

[WIP] Nested Record Field Copy and Update Expression #4511

Closed
Closed
Changes from 4 commits
Commits
Show all changes
51 commits
Select commit Hold shift + click to select a range
f2f23a0
no message
williamtetlow Mar 8, 2018
0f1a8fa
convert nested record fields to correct ast in TcRecdExpr - copyInfo …
williamtetlow Mar 10, 2018
e7520f9
WIP - TypeName.PropertyName now works for { person with Person.A = { …
williamtetlow Mar 13, 2018
a004c5a
got nested record field TypeName.PropertyName.PropertyName working
williamtetlow Mar 13, 2018
6980070
fix ambiguities between TypeName.PropertyName and PropertyName.Proper…
williamtetlow Mar 14, 2018
a974cd7
wip
williamtetlow Mar 16, 2018
9e54406
added Module/Namespace.TypeName.FieldName resolution. [WIP] need to a…
williamtetlow Mar 19, 2018
dc792d3
remove comments
williamtetlow Mar 19, 2018
3eb2b23
Merge pull request #1 from williamtetlow/nested-recd-module-res
williamtetlow Mar 19, 2018
a05aa22
fix error
AviAvni Mar 22, 2018
8ae92d2
Merge branch 'master' into nested-recd-update-recdexpr
AviAvni Mar 22, 2018
413672d
resolve nested module and namespace access
williamtetlow Mar 22, 2018
c160937
search whole list of module or namespace refs returned
williamtetlow Mar 27, 2018
ba2492a
Updated ModuleOrNamespace search to handle Namespace.Module.FieldName…
williamtetlow Mar 28, 2018
59975e0
search abbreviated type fields
williamtetlow Mar 28, 2018
85b43bb
[WIP] Add copy info so nested fields not referenced in nested express…
williamtetlow Apr 8, 2018
e4b3cc1
added basic conformance test for single update with varying levels of…
williamtetlow Apr 8, 2018
b8fc206
Merge branch 'master' of https://github.com/williamtetlow/visualfshar…
williamtetlow Apr 8, 2018
dc0bf4d
fix long ident range to be the total range of longident
williamtetlow Apr 9, 2018
79d141b
fix TypeName.Fieldname & NamespaceOrModule.FieldName copyInfo to only…
williamtetlow Apr 10, 2018
8597c01
first pass of multi updates
williamtetlow Apr 14, 2018
8911432
refactor module or namespace search
williamtetlow Apr 15, 2018
4edaee3
WIP refactoring code to fix ModuleName.TypeName.FieldName.FieldName
williamtetlow Apr 16, 2018
8fa2ec3
fix ModuleOrNamespace.TypeName.FieldName.FieldName
williamtetlow Apr 21, 2018
1ec29b6
simplify expanding AST
williamtetlow Apr 21, 2018
5f4bc72
refactoring
williamtetlow Apr 21, 2018
5b287f8
use active pattern throughout
williamtetlow Apr 21, 2018
5a17d31
more tidying up
williamtetlow Apr 21, 2018
9d45340
module and namespace test
williamtetlow Apr 21, 2018
295df45
Merge branch 'master' of https://github.com/williamtetlow/visualfshar…
williamtetlow Apr 21, 2018
0141e9e
Merge branch 'nested-recd-update-recdexpr' of https://github.com/will…
williamtetlow Apr 21, 2018
685ac8d
adding conformance tests
williamtetlow Jun 18, 2018
08416a4
Merge branch 'master' into nested-recd-update-recdexpr
williamtetlow Jun 18, 2018
990792c
Merge branch 'nested-recd-update-recdexpr' into nestd-recd-refactoring
williamtetlow Jun 18, 2018
efc1e19
fixing conformance tests
williamtetlow Jun 18, 2018
98d610f
Merge pull request #2 from williamtetlow/nestd-recd-refactoring
williamtetlow Jun 18, 2018
0d6c454
moving lid res to NameResolution module
williamtetlow Jun 19, 2018
45780fd
added conformance test for Type vs Field ambiguities
williamtetlow Jun 19, 2018
fdb0b01
moved resolution of lid representing nested field access to NameResol…
williamtetlow Jun 26, 2018
8498ba8
fixing issues from moving resolution code to NameResolution module
williamtetlow Jun 30, 2018
ab70071
Merge pull request #3 from williamtetlow/nestd-recd-refactoring
williamtetlow Jun 30, 2018
03f5b22
add missing exit to conformance tests
williamtetlow Jun 30, 2018
b5cb6af
Merge branch 'master' into nested-recd-update-recdexpr
williamtetlow Jun 30, 2018
33d7990
fixes to conformance tests
williamtetlow Jun 30, 2018
3a366af
make id used not the recd field reference
williamtetlow Jul 1, 2018
1207879
Check the same field is not declared twice in a nested field update
brokenprogrammer Sep 19, 2018
9f79a3b
Merge branch 'master' of https://github.com/williamtetlow/visualfshar…
williamtetlow Sep 19, 2018
35568d8
Merge branch 'master' into nested-recd-update-recdexpr
williamtetlow Jan 29, 2019
9dfc288
resolve issues from feedback
williamtetlow Jan 29, 2019
5af5fae
Merge branch 'nested-recd-update-recdexpr' of https://github.com/will…
williamtetlow Jan 29, 2019
a5c0b09
missed update to solution file
williamtetlow Jan 29, 2019
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
100 changes: 100 additions & 0 deletions src/fsharp/NameResolution.fs
Original file line number Diff line number Diff line change
@@ -3136,6 +3136,106 @@ let ResolveFieldPrim sink (ncenv:NameResolver) nenv ad ty (mp,id:Ident) allField

[(resInfo,item)]

/// Resolve a long identifier representing a nested record field
let ResolveNestedField sink (ncenv:NameResolver) nenv ad ty (lid : Ident list) =
let typeNameResInfo = TypeNameResolutionInfo.Default
let g = ncenv.g

let lookupFld ty (id : Ident) =
let m = id.idRange
let otherRecdFlds ty =
let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty
[
for KeyValue(_, v) in nenv.eFieldLabels do
let fldOpt = v |> List.tryFind (fun r -> r.TyconRef.DisplayName = typeName)
match fldOpt with
| Some rfref -> yield rfref.RecdField.Id
| None -> ()
]

let lookup() =
let frefs =
try Map.find id.idText nenv.eFieldLabels |> success
Copy link
Contributor

Choose a reason for hiding this comment

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

Why not Map.tryFind with match?

with :? KeyNotFoundException ->
// record label is unknown -> suggest related labels and give a hint to the user
raze (SuggestLabelsOfRelatedRecords g nenv id (otherRecdFlds ty))

// Eliminate duplicates arising from multiple 'open'
frefs
|?> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef)
|?> List.map (fun x -> FieldResolution(x,false))

if isAppTy g ty then
match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText,m,ty) with
| Some (RecdFieldInfo(_,rfref)) -> success [FieldResolution(rfref,false)]
| None ->
if isRecdTy g ty then
// record label doesn't belong to record type -> suggest other labels of same record
let suggestLabels() = SuggestOtherLabelsOfSameRecordType g nenv ty id (otherRecdFlds ty)
let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty
let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName,id.idText)
raze (ErrorWithSuggestions(errorText, m, id.idText, suggestLabels))
else
lookup()
else
lookup()

match lid with
| [] -> [], []
| [id] -> [], lookupFld ty id |> ForceRaise
| id :: _ ->
let fldSearch () =
match lid with
| id :: rest ->
let fldSearch = lookupFld ty id
let fldSearch = fldSearch |?> List.map (fun (FieldResolution(rfref, dep)) -> FieldResolution(rfref, dep), rfref.FieldName, rfref.FormalType, rest)
fldSearch
| _ -> NoResultsOrUsefulErrors

let tyconSearch ad () =
match lid with
| tn :: id :: rest ->
let m = tn.idRange
let tcrefs = LookupTypeNameInEnvNoArity OpenQualified tn.idText nenv
if isNil tcrefs then NoResultsOrUsefulErrors else
let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty,tcref))
let tyconSearch = ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 m ad id rest typeNameResInfo tn.idRange tcrefs
let tyconSearch = tyconSearch |?> List.choose (function (_, Item.RecdField(RecdFieldInfo(_,rfref)), rest) -> Some(FieldResolution(rfref,false), rfref.FieldName, rfref.FormalType, rest) | _ -> None)
tyconSearch
| _ -> NoResultsOrUsefulErrors

let moduleOrNsSearch ad () =
match lid with
| [] -> NoResultsOrUsefulErrors
| id :: rest ->
let m = id.idRange
let t = ResolveLongIndentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m OpenQualified nenv ad id rest false
(ResolveFieldInModuleOrNamespace ncenv nenv ad)
t |?> List.map (fun (_, FieldResolution(rfref, dep), rest) -> (FieldResolution(rfref, dep), rfref.FieldName, rfref.FormalType, rest))

let item, fldIdText, fldTy, rest =
fldSearch () +++ moduleOrNsSearch ad +++ tyconSearch ad +++ moduleOrNsSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode
|> AtMostOneResult id.idRange
|> ForceRaise

let idsBeforeField = lid |> List.takeWhile (fun id -> id.idText <> fldIdText)

match rest with
| [] -> idsBeforeField, [item]
| _ ->
let rec nestedFieldSearch flds ty =
function
| [] -> flds
| id :: rest ->
let resolved = lookupFld ty id |> ForceRaise
let fldTy =
match resolved with
| [FieldResolution(rfref, _)] -> rfref.FormalType
| _ -> ty
nestedFieldSearch (flds @ resolved) fldTy rest

idsBeforeField, item::(nestedFieldSearch [] fldTy rest)

let ResolveField sink ncenv nenv ad ty (mp,id) allFields =
let res = ResolveFieldPrim sink ncenv nenv ad ty (mp,id) allFields
// Register the results of any field paths "Module.Type" in "Module.Type.field" as a name resolution. (Note, the path resolution
3 changes: 3 additions & 0 deletions src/fsharp/NameResolution.fsi
Original file line number Diff line number Diff line change
@@ -481,6 +481,9 @@ val internal ResolveTypeLongIdentInTyconRef : TcResultsSink -> NameResol
/// Resolve a long identifier to a type definition
val internal ResolveTypeLongIdent : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException<TyconRef>

/// Resolve a long identifier to a nested field
val internal ResolveNestedField : TcResultsSink -> NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list -> Ident list * FieldResolution list

/// Resolve a long identifier to a field
val internal ResolveField : TcResultsSink -> NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list * Ident -> Ident list -> FieldResolution list

172 changes: 31 additions & 141 deletions src/fsharp/TypeChecker.fs
Original file line number Diff line number Diff line change
@@ -6878,101 +6878,7 @@ and TcAssertExpr cenv overallTy env (m:range) tpenv x =

and TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr) =
let buildForNestdFlds (lidwd : LongIdentWithDots) v =
Copy link
Contributor

Choose a reason for hiding this comment

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

I don't think throwing a couple of chars saves a lot of space in this case. Why not buildForNestedFields?

let (|ModuleOrNamespace|RecdTy|RecdFld|Undefined|) =
function
| ((_, _, Some _), id) -> RecdFld id
| ((_,Some _, _), id) -> RecdTy id
| ((Some _, None, None), id) -> ModuleOrNamespace id
| (_, id) -> Undefined id

let resolveIds ids =
let search mapFn mOrNsTyList =
mOrNsTyList
|> Option.bind (fun lst -> lst |> List.map mapFn |> List.tryFind Option.isSome)
|> Option.flatten

let modOrNsSearch (id : Ident) =
search (fun (mOrNsTy : ModuleOrNamespaceType) -> mOrNsTy.ModulesAndNamespacesByDemangledName.TryFind id.idText)

let tyconSearch (id : Ident) =
search (fun (mOrNsTy : ModuleOrNamespaceType) -> mOrNsTy.TypesByAccessNames.TryFind id.idText)

let rec abbrevTyconFieldSearch (abbrvTycon : TyconRef) (id : Ident) =
match abbrvTycon.TypeAbbrev with
| None -> abbrvTycon.GetFieldByName id.idText
| Some (TType_app (abbrv, _)) -> abbrevTyconFieldSearch abbrv id
| _ -> None

let tyconFieldSearch (id : Ident) =
search (fun (tycon : Tycon) -> match tycon.TypeAbbrev with
| None -> tycon.GetFieldByName id.idText
| Some (TType_app (abbrv, _)) -> abbrevTyconFieldSearch abbrv id
| _ -> None)

let searchFieldsOfAllTycons (id : Ident) =
let searchForFld (lst : ModuleOrNamespaceType list) =
lst
|> List.map (fun mOrNs -> mOrNs.TypeDefinitions |> List.map (fun (t : Tycon) -> t))
|> List.concat
|> Some
|> tyconFieldSearch id

Option.bind searchForFld
let rec loop res mOrNs tycons ids =
match ids with
| [] -> success (res |> List.rev)
| (id : Ident) :: ids ->
match (mOrNs, tycons) with
// If we're not given any namespaces, modules or tycons to restrict search - look in current env
| (None, None) ->
let mOrN =
env.NameEnv.eModulesAndNamespaces.TryFind id.idText
|> Option.bind (fun ml -> Some (ml |> List.map (fun m -> m.ModuleOrNamespaceType)))

let ty : Tycon list option =
env.NameEnv.eTyconsByAccessNames.TryFind id.idText
|> Option.bind (fun tl -> Some (tl |> List.map (fun t -> t.Deref)))

let fld =
env.NameEnv.eFieldLabels.TryFind id.idText
|> Option.bind (fun fl -> Some(fl |> List.map (fun f -> f.RecdField)))

let searchResult = (mOrN, ty, fld)

match searchResult with
| (None, None, None) -> raze (UndefinedName(List.length res, FSComp.SR.undefinedNameRecordLabelOrNamespace, id, NoSuggestions))
| _ -> loop ((searchResult, id) :: res) mOrN None ids
| (_, Some _) ->
// If there is some tycons then search for id in their fields
let search = (tyconFieldSearch id tycons)
match search with
| None -> raze (UndefinedName(List.length res, FSComp.SR.undefinedNameRecordLabelOrNamespace, id, NoSuggestions))
| Some s ->
let tys = match s.FormalType with
| TType_app (tycon, _) -> Some [tycon.Deref]
| _ -> tycons
loop (((None, None, Some [s]), id) :: res) mOrNs tys ids
| _ ->
// If no tycons search for namespace, module or type name
let mOrN, tycon = (modOrNsSearch id mOrNs, tyconSearch id mOrNs)
match (mOrN, tycon) with
| (Some m, _) -> loop (((Some [m.ModuleOrNamespaceType], None, None), id) :: res) (Some [m.ModuleOrNamespaceType]) None ids
| (_, Some _) -> loop (((None, tycons, None), id) :: res) mOrNs tycon ids
| _ ->
// As a last resort - search across fields of module's tycons for case ModuleName.FieldName
let fld = searchFieldsOfAllTycons id mOrNs
match fld with
| Some f -> loop (((None, None, Some [f]), id) :: res) mOrNs tycons ids
| None -> raze (UndefinedName(List.length res, FSComp.SR.undefinedNameRecordLabelOrNamespace, id, NoSuggestions))

loop [] None None ids |> ForceRaise

let recdExprCopyInfo ids (optOrigExpr : (SynExpr * BlockSeparator) option) (id : Ident) =
let lidOfFlds =
ids
|> List.filter (function | RecdFld _ -> true | _ -> false)
|> List.map (fun (_, id) -> id)

let upToId origSepRng id lidwd =
let rec buildLid res (id : Ident) =
function
@@ -6997,52 +6903,38 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr
mkRange origId.idRange.FileName origId.idRange.End id.idRange.Start

match optOrigExpr with
| Some (SynExpr.Ident origId, (sepRange, _)) ->
let lid, rng = upToId sepRange id (origId :: lidOfFlds)
| Some (SynExpr.Ident origId, (sepRange, _)) ->
let flds = ids |> List.map (fun (FieldResolution(rfref, _)) -> rfref.RecdField.Id)
let lid, rng = upToId sepRange id (origId :: flds)
Some (SynExpr.LongIdent (false, LongIdentWithDots(lid, rng), None, totalRange origId id), (id.idRange, None)) // TODO: id.idRange should be the range of the next separator
| _ -> None

let combineIdsUpToNextFld h rst =
let rec loop lid rst =
let lidAndRst l r = (l |> List.rev, r)
match rst with
| [] -> lidAndRst lid rst
| h :: t ->
match h with
| RecdFld fld -> lidAndRst (fld :: lid) t
| (_, id) -> loop (id :: lid) t

loop [h] rst


let rec synExprRecd copyInfo id idRng ids =
Some(SynExpr.Record((None, (copyInfo id), [
match ids with
let rec synExprRecd copyInfo id flds =
Some(SynExpr.Record((None, (copyInfo id), [ match flds with
| [] -> yield ((LongIdentWithDots ([], []), true), v, None)
| [(_, fld)] -> yield ((LongIdentWithDots ([fld],[]), true), v, None)
| (_, h) :: t -> yield ((LongIdentWithDots ([h], []), true), (synExprRecd copyInfo h h.idRange t), None)], idRng)))
| [FieldResolution(rfref, _)] ->
let fldId = rfref.RecdField.Id
yield ((LongIdentWithDots ([fldId],[]), true), v, None)
| FieldResolution(rfref, _) :: t ->
let fldId = rfref.RecdField.Id
let nestedFld = synExprRecd copyInfo fldId
yield ((LongIdentWithDots ([fldId], []), true), nestedFld t, None)], id.idRange)))

let ids = lidwd.Lid |> resolveIds
let access, flds = lidwd.Lid |> ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy

[
match ids with
| [] -> ()
| h :: t ->
let lid, id, rng, rst =
match h with
| RecdFld id -> success (([], id), id, id.idRange, t)
| RecdTy id
| ModuleOrNamespace id ->
let ids, rest = combineIdsUpToNextFld id t
let f, b = List.frontAndBack ids
success ((f, b), b, id.idRange, rest)
| Undefined id -> raze (UndefinedName(0, FSComp.SR.undefinedNameRecordLabelOrNamespace, id, NoSuggestions))
|> ForceRaise

match rst with
| [] -> yield (lid, v)
| _ -> yield (lid, synExprRecd (recdExprCopyInfo ids optOrigExpr) id rng rst)
]
let expanded =
[
match (access, flds) with
| [], [] -> ()
| ids, [] -> yield (ids |> List.frontAndBack), v
| ids, [FieldResolution(rfref, _)] -> yield ((ids@[rfref.RecdField.Id]) |> List.frontAndBack), v
| ids, FieldResolution(rfref, _) :: rest ->
let id = rfref.RecdField.Id
yield (ids, id), synExprRecd (recdExprCopyInfo flds optOrigExpr) id rest
]

expanded

let grpMultipleNstdUpdates flds =
let grpdByFld = flds |> Seq.groupBy (fun ((_, fld : Ident), _) -> fld.idText)
@@ -7051,14 +6943,12 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr
if (flds |> Seq.length < 2) then
yield! flds
else
yield
flds
|> Seq.reduce (
fun a b ->
match a, b with
| (lidwid, Some(SynExpr.Record (aBI, aCI, aFlds, aRng))), (_, Some(SynExpr.Record (_, _, bFlds, _))) -> (lidwid, Some(SynExpr.Record (aBI, aCI, (aFlds @ bFlds), aRng)))
| _ -> a
)
yield flds |> Seq.reduce
(fun a b -> match a, b with
| (lidwid, Some(SynExpr.Record (aBI, aCI, aFlds, aRng))), (_, Some(SynExpr.Record (_, _, bFlds, _))) ->
let combinedFlds = aFlds @ bFlds
(lidwid, Some(SynExpr.Record (aBI, aCI, combinedFlds, aRng)))
| _ -> a)
]

let requiresCtor = (GetCtorShapeCounter env = 1) // Get special expression forms for constructors
3 changes: 3 additions & 0 deletions src/fsharp/tast.fs
Original file line number Diff line number Diff line change
@@ -3865,6 +3865,9 @@ and
/// Get the signature range of the record field
member x.SigRange = x.RecdField.SigRange

/// The type of the record field
member x.FormalType = x.RecdField.FormalType

member x.Index =
let (RFRef(tcref,id)) = x
try