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.

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

Refactoring Long Ident Resolution into NameResolution module #3

Merged
merged 3 commits into from
Jun 30, 2018
Merged

Refactoring Long Ident Resolution into NameResolution module #3

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
0d6c454
moving lid res to NameResolution module
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
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
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
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
Expand Down
3 changes: 3 additions & 0 deletions src/fsharp/NameResolution.fsi
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
172 changes: 31 additions & 141 deletions src/fsharp/TypeChecker.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
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
Expand All @@ -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)
Expand All @@ -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
Expand Down
3 changes: 3 additions & 0 deletions src/fsharp/tast.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down