From 3bfada42ecbd05ab06eaa3bb3137354429494d67 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lo=C3=AFc=20Denuzi=C3=A8re?= Date: Tue, 4 Aug 2020 06:33:49 +0200 Subject: [PATCH] Further enhancements to nameof (#8754) * Implement `nameof x` as a constant pattern * Resolve ident to find `nameof` in patterns * fix build * fix build * re-enable tests * fix test * fix operators * align code * test and fix pattern matching * fix 8661, 7416 * fix tests and error messages * 'fix test' * 'fix test' * add message for C# and old compilers * fix build * suppress error 3501 when a compiler supports nameof Co-authored-by: Don Syme --- src/fsharp/AttributeChecking.fs | 6 +- src/fsharp/FSComp.txt | 3 +- src/fsharp/FSharp.Core/prim-types.fs | 5 +- src/fsharp/FSharp.Core/prim-types.fsi | 7 +- src/fsharp/NameResolution.fs | 122 ++++++++------- src/fsharp/NameResolution.fsi | 4 +- src/fsharp/TypeChecker.fs | 144 ++++++++++++------ tests/fsharp/core/nameof/preview/test.fsx | 69 ++++++++- .../NameOf/E_NameOfAdditionExpr.fs | 7 - .../DataExpressions/NameOf/env.lst | 1 - 10 files changed, 245 insertions(+), 123 deletions(-) delete mode 100644 tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/NameOf/E_NameOfAdditionExpr.fs diff --git a/src/fsharp/AttributeChecking.fs b/src/fsharp/AttributeChecking.fs index 075f70669ace..f7554e44c39f 100644 --- a/src/fsharp/AttributeChecking.fs +++ b/src/fsharp/AttributeChecking.fs @@ -299,7 +299,11 @@ let CheckFSharpAttributes (g:TcGlobals) attribs m = match namedArgs with | ExtractAttribNamedArg "IsError" (AttribBoolArg v) -> v | _ -> false - if isError && (not g.compilingFslib || n <> 1204) then ErrorD msg else WarnD msg + // If we are using a compiler that supports nameof then error 3501 is always suppressed. + // See attribute on FSharp.Core 'nameof' + if n = 3501 then CompleteD + elif isError && (not g.compilingFslib || n <> 1204) then ErrorD msg + else WarnD msg | _ -> CompleteD ) ++ (fun () -> diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index 9878ab603cf8..e1fb144f1162 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1515,4 +1515,5 @@ featureWitnessPassing,"witness passing for trait constraints in F# quotations" 3361,typrelInterfaceWithConcreteAndVariableObjectExpression,"You cannot implement the interface '%s' with the two instantiations '%s' and '%s' because they may unify." featureInterfacesWithMultipleGenericInstantiation,"interfaces with multiple generic instantiation" 3362,tcLiteralFieldAssignmentWithArg,"Cannot assign '%s' to a value marked literal" -3363,tcLiteralFieldAssignmentNoArg,"Cannot assign a value to another value marked literal" \ No newline at end of file +3363,tcLiteralFieldAssignmentNoArg,"Cannot assign a value to another value marked literal" +#3501 "This construct is not supported by your version of the F# compiler" CompilerMessage(ExperimentalAttributeMessages.NotSupportedYet, 3501, IsError=true) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 36567214f149..d912b8f97577 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -251,6 +251,9 @@ namespace Microsoft.FSharp.Core [] let RequiresPreview : string = "Experimental library feature, requires '--langversion:preview'" + [] + let NotSupportedYet : string = "This construct is not supported by your version of the F# compiler" + [] [] type ExperimentalAttribute(message:string) = @@ -4718,7 +4721,7 @@ namespace Microsoft.FSharp.Core [] let inline typeof<'T> = BasicInlinedOperations.typeof<'T> - [] + [] let inline nameof (_: 'T) : string = raise (Exception "may not call directly, should always be optimized away") [] diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index 449ac73f3cfb..3370b699150c 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -653,10 +653,11 @@ namespace Microsoft.FSharp.Core /// Indicates one or more adjustments to the compiled representation of an F# type or member member Flags : CompilationRepresentationFlags - module internal ExperimentalAttributeMessages = begin + module internal ExperimentalAttributeMessages = [] val RequiresPreview : string = "Experimental library feature, requires '--langversion:preview'" - end + [] + val NotSupportedYet : string = "This construct is not supported by your version of the F# compiler" /// This attribute is used to tag values that are part of an experimental library /// feature. @@ -2846,7 +2847,7 @@ namespace Microsoft.FSharp.Core val inline typeof<'T> : System.Type /// Returns the name of the given symbol. - [] + [] val inline nameof : 'T -> string /// An internal, library-only compiler intrinsic for compile-time diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 43d7d1e6f198..aeea75561726 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2579,7 +2579,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified if first && id.idText = MangledGlobalName then match rest with | [] -> - error (Error(FSComp.SR.nrGlobalUsedOnlyAsFirstName(), id.idRange)) + raze (Error(FSComp.SR.nrGlobalUsedOnlyAsFirstName(), id.idRange)) | [next] -> ResolveExprLongIdentPrim sink ncenv false fullyQualified m ad nenv typeNameResInfo next [] isOpenDecl | id2 :: rest2 -> @@ -2603,11 +2603,12 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified let search = ChooseTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, resInfo, tcrefs) match AtMostOneResult m search with - | Result _ as res -> - let resInfo, item, rest = ForceRaise res + | Result (resInfo, item, rest) -> ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) Some(item, rest) - | Exception e -> typeError <- Some e; None + | Exception e -> + typeError <- Some e + None | true, res -> let fresh = FreshenUnqualifiedItem ncenv m res @@ -2624,7 +2625,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified None match envSearch with - | Some res -> res + | Some res -> success res | None -> let innerSearch = // Check if it's a type name, e.g. a constructor call or a type instantiation @@ -2640,9 +2641,9 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified ctorSearch +++ implicitOpSearch - let resInfo, item, rest = + let res = match AtMostOneResult m innerSearch with - | Result _ as res -> ForceRaise res + | Result _ as res -> res | _ -> let failingCase = match typeError with @@ -2671,11 +2672,12 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified addToBuffer (e.Value.DisplayName + "." + id.idText) raze (UndefinedName(0, FSComp.SR.undefinedNameValueOfConstructor, id, suggestNamesAndTypes)) - ForceRaise failingCase - + failingCase + match res with + | Exception e -> raze e + | Result (resInfo, item, rest) -> ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - item, rest - + success (item, rest) // A compound identifier. // It still might be a value in the environment, or something in an F# module, namespace, type, or nested type @@ -2693,13 +2695,13 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | _ -> false if ValIsInEnv id.idText then - nenv.eUnqualifiedItems.[id.idText], rest + success (nenv.eUnqualifiedItems.[id.idText], rest) else // Otherwise modules are searched first. REVIEW: modules and types should be searched together. // For each module referenced by 'id', search the module as if it were an F# module and/or a .NET namespace. let moduleSearch ad () = - ResolveLongIndentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m fullyQualified nenv ad id rest isOpenDecl - (ResolveExprLongIdentInModuleOrNamespace ncenv nenv typeNameResInfo ad) + ResolveLongIndentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m fullyQualified nenv ad id rest isOpenDecl + (ResolveExprLongIdentInModuleOrNamespace ncenv nenv typeNameResInfo ad) // REVIEW: somewhat surprisingly, this shows up on performance traces, with tcrefs non-nil. // This seems strange since we would expect in the vast majority of cases tcrefs is empty here. @@ -2717,59 +2719,59 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified NoResultsOrUsefulErrors let search = - let envSearch () = - match fullyQualified with - | FullyQualified -> - NoResultsOrUsefulErrors - | OpenQualified -> - match nenv.eUnqualifiedItems.TryGetValue id.idText with - | true, Item.UnqualifiedType _ - | false, _ -> NoResultsOrUsefulErrors - | true, res -> OneSuccess (resInfo, FreshenUnqualifiedItem ncenv m res, rest) - - moduleSearch ad () +++ tyconSearch ad +++ envSearch - - let resInfo, item, rest = + let envSearch () = + match fullyQualified with + | FullyQualified -> + NoResultsOrUsefulErrors + | OpenQualified -> + match nenv.eUnqualifiedItems.TryGetValue id.idText with + | true, Item.UnqualifiedType _ + | false, _ -> NoResultsOrUsefulErrors + | true, res -> OneSuccess (resInfo, FreshenUnqualifiedItem ncenv m res, rest) + + moduleSearch ad () +++ tyconSearch ad +++ envSearch + + let res = match AtMostOneResult m search with - | Result _ as res -> ForceRaise res + | Result _ as res -> res | _ -> let innerSearch = search +++ (moduleSearch AccessibleFromSomeFSharpCode) +++ (tyconSearch AccessibleFromSomeFSharpCode) let suggestEverythingInScope (addToBuffer: string -> unit) = - for kv in nenv.ModulesAndNamespaces fullyQualified do - for modref in kv.Value do - if IsEntityAccessible ncenv.amap m ad modref then - addToBuffer modref.DisplayName - addToBuffer modref.DemangledModuleOrNamespaceName + for kv in nenv.ModulesAndNamespaces fullyQualified do + for modref in kv.Value do + if IsEntityAccessible ncenv.amap m ad modref then + addToBuffer modref.DisplayName + addToBuffer modref.DemangledModuleOrNamespaceName - for e in nenv.TyconsByDemangledNameAndArity fullyQualified do - if IsEntityAccessible ncenv.amap m ad e.Value then - addToBuffer e.Value.DisplayName + for e in nenv.TyconsByDemangledNameAndArity fullyQualified do + if IsEntityAccessible ncenv.amap m ad e.Value then + addToBuffer e.Value.DisplayName - for e in nenv.eUnqualifiedItems do - if canSuggestThisItem e.Value then - addToBuffer e.Value.DisplayName + for e in nenv.eUnqualifiedItems do + if canSuggestThisItem e.Value then + addToBuffer e.Value.DisplayName match innerSearch with | Exception (UndefinedName(0, _, id1, suggestionsF)) when Range.equals id.idRange id1.idRange -> - let mergeSuggestions addToBuffer = - suggestionsF addToBuffer - suggestEverythingInScope addToBuffer - - let failingCase = raze (UndefinedName(0, FSComp.SR.undefinedNameValueNamespaceTypeOrModule, id, mergeSuggestions)) - ForceRaise failingCase - | Exception err -> ForceRaise(Exception err) - | Result (res :: _) -> ForceRaise(Result res) + let mergeSuggestions addToBuffer = + suggestionsF addToBuffer + suggestEverythingInScope addToBuffer + raze (UndefinedName(0, FSComp.SR.undefinedNameValueNamespaceTypeOrModule, id, mergeSuggestions)) + | Exception err -> raze err + | Result (res :: _) -> success res | Result [] -> - let failingCase = raze (UndefinedName(0, FSComp.SR.undefinedNameValueNamespaceTypeOrModule, id, suggestEverythingInScope)) - ForceRaise failingCase + raze (UndefinedName(0, FSComp.SR.undefinedNameValueNamespaceTypeOrModule, id, suggestEverythingInScope)) - ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - item, rest + match res with + | Exception e -> raze e + | Result (resInfo, item, rest) -> + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) + success (item, rest) let ResolveExprLongIdent sink (ncenv: NameResolver) m ad nenv typeNameResInfo lid = match lid with - | [] -> error (Error(FSComp.SR.nrInvalidExpression(textOfLid lid), m)) + | [] -> raze (Error(FSComp.SR.nrInvalidExpression(textOfLid lid), m)) | id :: rest -> ResolveExprLongIdentPrim sink ncenv true OpenQualified m ad nenv typeNameResInfo id rest false //------------------------------------------------------------------------- @@ -3414,15 +3416,17 @@ type AfterResolution = /// /// Called for 'TypeName.Bar' - for VS IntelliSense, we can filter out instance members from method groups let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameResolver) wholem ad nenv typeNameResInfo lid = - let item1, rest = ResolveExprLongIdent sink ncenv wholem ad nenv typeNameResInfo lid + match ResolveExprLongIdent sink ncenv wholem ad nenv typeNameResInfo lid with + | Exception e -> Exception e + | Result (item1, rest) -> let itemRange = ComputeItemRange wholem lid rest let item = FilterMethodGroups ncenv itemRange item1 true match item1, item with | Item.MethodGroup(name, minfos1, _), Item.MethodGroup(_, [], _) when not (isNil minfos1) -> - error(Error(FSComp.SR.methodIsNotStatic name, wholem)) - | _ -> () + raze(Error(FSComp.SR.methodIsNotStatic name, wholem)) + | _ -> // Fake idents e.g. 'Microsoft.FSharp.Core.None' have identical ranges for each part let isFakeIdents = @@ -3462,7 +3466,7 @@ let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameReso callSink (item, emptyTyparInst) AfterResolution.DoNothing - item, itemRange, rest, afterResolution + success (item, itemRange, rest, afterResolution) let (|NonOverridable|_|) namedItem = match namedItem with @@ -3470,8 +3474,6 @@ let (|NonOverridable|_|) namedItem = | Item.Property(_, pinfos) when pinfos |> List.exists(fun pinfo -> pinfo.IsVirtualProperty) -> None | _ -> Some () - - /// Called for 'expression.Bar' - for VS IntelliSense, we can filter out static members from method groups /// Also called for 'GenericType.Bar' - for VS IntelliSense, we can filter out non-static members from method groups let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameResolver) wholem ad nenv ty lid findFlag thisIsActuallyATyAppNotAnExpr = @@ -3571,7 +3573,9 @@ let IsUnionCaseUnseen ad g amap m (ucref: UnionCaseRef) = let ItemIsUnseen ad g amap m item = match item with - | Item.Value x -> IsValUnseen ad g m x + | Item.Value x -> + let isUnseenNameOfOperator = valRefEq g g.nameof_vref x && not (g.langVersion.SupportsFeature LanguageFeature.NameOf) + isUnseenNameOfOperator || IsValUnseen ad g m x | Item.UnionCase(x, _) -> IsUnionCaseUnseen ad g amap m x.UnionCaseRef | Item.ExnCase x -> IsTyconUnseen ad g amap m x | _ -> false diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 685871c056a8..7caa8321a026 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -545,7 +545,7 @@ val internal ResolveTypeLongIdent : TcResultsSink -> NameResol val internal ResolveField : TcResultsSink -> NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list * Ident -> Ident list -> FieldResolution list /// Resolve a long identifier occurring in an expression position -val internal ResolveExprLongIdent : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item * Ident list +val internal ResolveExprLongIdent : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> ResultOrException /// Resolve a (possibly incomplete) long identifier to a loist of possible class or record fields val internal ResolvePartialLongIdentToClassOrRecdFields : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> bool -> Item list @@ -571,7 +571,7 @@ type AfterResolution = | RecordResolution of Item option * (TyparInst -> unit) * (MethInfo * PropInfo option * TyparInst -> unit) * (unit -> unit) /// Resolve a long identifier occurring in an expression position. -val internal ResolveLongIdentAsExprAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item * range * Ident list * AfterResolution +val internal ResolveLongIdentAsExprAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> ResultOrException /// Resolve a long identifier occurring in an expression position, qualified by a type. val internal ResolveExprDotLongIdentAndComputeRange : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TType -> Ident list -> FindMemberFlag -> bool -> Item * range * Ident list * AfterResolution diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 919c5b0ab7ad..34ba5ba884b7 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -3204,7 +3204,7 @@ let (|JoinRelation|_|) cenv env (e: SynExpr) = let isOpName opName vref s = (s = opName) && match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.eNameResEnv TypeNameResolutionInfo.Default [ident(opName, m)] with - | Item.Value vref2, [] -> valRefEq cenv.g vref vref2 + | Result (Item.Value vref2, []) -> valRefEq cenv.g vref vref2 | _ -> false match e with @@ -5398,12 +5398,50 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p let args = getArgPatterns () TcPatterns warnOnUpper cenv env vFlags (tpenv, names, takenNames) (NewInferenceTypes args) args + // Note we parse arguments to parameterized pattern labels as patterns, not expressions. + // This means the range of syntactic expression forms that can be used here is limited. + let rec convSynPatToSynExpr x = + match x with + | SynPat.FromParseError(p, _) -> convSynPatToSynExpr p + | SynPat.Const (c, m) -> SynExpr.Const (c, m) + | SynPat.Named (SynPat.Wild _, id, _, None, _) -> SynExpr.Ident id + | SynPat.Typed (p, cty, m) -> SynExpr.Typed (convSynPatToSynExpr p, cty, m) + | SynPat.LongIdent (LongIdentWithDots(longId, dotms) as lidwd, _, _tyargs, args, None, m) -> + let args = match args with SynArgPats.Pats args -> args | _ -> failwith "impossible: active patterns can be used only with SynConstructorArgs.Pats" + let e = + if dotms.Length = longId.Length then + let e = SynExpr.LongIdent (false, LongIdentWithDots(longId, List.truncate (dotms.Length - 1) dotms), None, m) + SynExpr.DiscardAfterMissingQualificationAfterDot (e, unionRanges e.Range (List.last dotms)) + else SynExpr.LongIdent (false, lidwd, None, m) + List.fold (fun f x -> mkSynApp1 f (convSynPatToSynExpr x) m) e args + | SynPat.Tuple (isStruct, args, m) -> SynExpr.Tuple (isStruct, List.map convSynPatToSynExpr args, [], m) + | SynPat.Paren (p, _) -> convSynPatToSynExpr p + | SynPat.ArrayOrList (isArray, args, m) -> SynExpr.ArrayOrList (isArray,List.map convSynPatToSynExpr args, m) + | SynPat.QuoteExpr (e,_) -> e + | SynPat.Null m -> SynExpr.Null m + | _ -> error(Error(FSComp.SR.tcInvalidArgForParameterizedPattern(), x.Range)) + + let isNameof (id: Ident) = + id.idText = "nameof" && + try + match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.NameEnv TypeNameResolutionInfo.Default [id] with + | Result (Item.Value vref, _) -> valRefEq cenv.g vref cenv.g.nameof_vref + | _ -> false + with _ -> false + match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver warnOnUpperForId false m ad env.NameEnv TypeNameResolutionInfo.Default longId with | Item.NewDef id -> - let _, acc = tcArgPatterns () match getArgPatterns () with - | [] -> TcPat warnOnUpperForId cenv env topValInfo vFlags acc ty (mkSynPatVar vis id) + | [] -> + TcPat warnOnUpperForId cenv env topValInfo vFlags (tpenv, names, takenNames) ty (mkSynPatVar vis id) + + | [arg] + when cenv.g.langVersion.SupportsFeature LanguageFeature.NameOf && isNameof id -> + match TcNameOfExpr cenv env tpenv (convSynPatToSynExpr arg) with + | Expr.Const(c, m, _) -> (fun _ -> TPat_const (c, m)), (tpenv, names, takenNames) + | _ -> failwith "Impossible: TcNameOfExpr must return an Expr.Const" | _ -> + let _, acc = tcArgPatterns () errorR (UndefinedName (0, FSComp.SR.undefinedNamePatternDiscriminator, id, NoSuggestions)) (fun _ -> TPat_error m), acc @@ -5438,29 +5476,6 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p if not (isNil activePatArgsAsSynPats) && apinfo.ActiveTags.Length <> 1 then errorR (Error (FSComp.SR.tcRequireActivePatternWithOneResult (), m)) - // Parse the arguments to an active pattern - // Note we parse arguments to parameterized pattern labels as patterns, not expressions. - // This means the range of syntactic expression forms that can be used here is limited. - let rec convSynPatToSynExpr x = - match x with - | SynPat.FromParseError (p, _) -> convSynPatToSynExpr p - | SynPat.Const (c, m) -> SynExpr.Const (c, m) - | SynPat.Named (SynPat.Wild _, id, _, None, _) -> SynExpr.Ident id - | SynPat.Typed (p, cty, m) -> SynExpr.Typed (convSynPatToSynExpr p, cty, m) - | SynPat.LongIdent (LongIdentWithDots (longId, dotms) as lidwd, _, _tyargs, args, None, m) -> - let args = match args with SynArgPats.Pats args -> args | _ -> failwith "impossible: active patterns can be used only with SynArgPats.Pats" - let e = - if dotms.Length = longId.Length then - let e = SynExpr.LongIdent (false, LongIdentWithDots(longId, List.truncate (dotms.Length - 1) dotms), None, m) - SynExpr.DiscardAfterMissingQualificationAfterDot (e, unionRanges e.Range (List.last dotms)) - else SynExpr.LongIdent (false, lidwd, None, m) - List.fold (fun f x -> mkSynApp1 f (convSynPatToSynExpr x) m) e args - | SynPat.Tuple (isStruct, args, m) -> SynExpr.Tuple (isStruct, List.map convSynPatToSynExpr args, [], m) - | SynPat.Paren (p, _) -> convSynPatToSynExpr p - | SynPat.ArrayOrList (isArray, args, m) -> SynExpr.ArrayOrList (isArray,List.map convSynPatToSynExpr args, m) - | SynPat.QuoteExpr (e,_) -> e - | SynPat.Null m -> SynExpr.Null m - | _ -> error(Error(FSComp.SR.tcInvalidArgForParameterizedPattern(), x.Range)) let activePatArgsAsSynExprs = List.map convSynPatToSynExpr activePatArgsAsSynPats let activePatResTys = NewInferenceTypes apinfo.Names @@ -9290,26 +9305,47 @@ and TcNameOfExpr cenv env tpenv (synArg: SynExpr) = let m = cleanSynArg.Range let rec check overallTyOpt resultOpt expr (delayed: DelayedItem list) = match expr with - | LongOrSingleIdent (false, (LongIdentWithDots(longId, _) as lidd), _, _) -> + | LongOrSingleIdent (false, (LongIdentWithDots(longId, _)), _, _) -> + let ad = env.eAccessRights let result = defaultArg resultOpt (List.last longId) - let resolvedToModuleOrNamespaceName = - if delayed.IsEmpty then - let id,rest = List.headAndTail longId - match ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest true with - | Result modref when delayed.IsEmpty && modref |> List.exists (p23 >> IsEntityAccessible cenv.amap m ad) -> - true // resolved to a module or namespace, done with checks - | _ -> - false - else + + // Nameof resolution resolves to a symbol and in general we make that the same symbol as + // would resolve if the long ident was used as an expression at the given location. + // + // So we first check if the first identifier resolves as an expression, if so commit and and resolve. + // + // However we don't commit for a type names - nameof allows 'naked' type names and thus all type name + // resolutions are checked separately in the next step. + let typeNameResInfo = GetLongIdentTypeNameInfo delayed + let nameResolutionResult = ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.eNameResEnv typeNameResInfo longId + let resolvesAsExpr = + match nameResolutionResult with + | Result ((item, _, _, _) as res) + when + (match item with + | Item.Types _ + | Item.DelegateCtor _ + | Item.CtorGroup _ + | Item.FakeInterfaceCtor _ -> false + | _ -> true) -> + let overallTy = match overallTyOpt with None -> NewInferenceType() | Some t -> t + let _, _ = TcItemThen cenv overallTy env tpenv res delayed + true + | _ -> false - if resolvedToModuleOrNamespaceName then result else + if resolvesAsExpr then result else + // If it's not an expression then try to resolve it as a type name let resolvedToTypeName = if (match delayed with [DelayedTypeApp _] | [] -> true | _ -> false) then let (TypeNameResolutionInfo(_, staticArgsInfo)) = GetLongIdentTypeNameInfo delayed match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad longId staticArgsInfo PermitDirectReferenceToGeneratedType.No with - | Result tcref when (match delayed with [DelayedTypeApp _] | [] -> true | _ -> false) && IsEntityAccessible cenv.amap m ad tcref -> + | Result tcref when IsEntityAccessible cenv.amap m ad tcref -> + match delayed with + | [DelayedTypeApp (tyargs, _, mExprAndTypeArgs)] -> + TcTypeApp cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs tcref [] tyargs |> ignore + | _ -> () true // resolved to a type name, done with checks | _ -> false @@ -9317,11 +9353,22 @@ and TcNameOfExpr cenv env tpenv (synArg: SynExpr) = false if resolvedToTypeName then result else - let overallTy = match overallTyOpt with None -> NewInferenceType() | Some t -> t - - // This will raise an error if resolution doesn't succeed - let _, _ = TcLongIdentThen cenv overallTy env tpenv lidd delayed - result // checked as an expression, done with checks + // If it's not an expression or type name then resolve it as a module + let resolvedToModuleOrNamespaceName = + if delayed.IsEmpty then + let id,rest = List.headAndTail longId + match ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest true with + | Result modref when delayed.IsEmpty && modref |> List.exists (p23 >> IsEntityAccessible cenv.amap m ad) -> + true // resolved to a module or namespace, done with checks + | _ -> + false + else + false + if resolvedToModuleOrNamespaceName then result else + + ForceRaise nameResolutionResult |> ignore + // If that didn't give aan exception then raise a generic error + error (Error(FSComp.SR.expressionHasNoName(), m)) // expr allowed, even with qualifications | SynExpr.TypeApp (hd, _, types, _, _, _, m) -> @@ -9418,7 +9465,9 @@ and TcLongIdentThen cenv overallTy env tpenv (LongIdentWithDots(longId, _)) dela let ad = env.eAccessRights let typeNameResInfo = GetLongIdentTypeNameInfo delayed - let nameResolutionResult = ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.eNameResEnv typeNameResInfo longId + let nameResolutionResult = + ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.eNameResEnv typeNameResInfo longId + |> ForceRaise TcItemThen cenv overallTy env tpenv nameResolutionResult delayed //------------------------------------------------------------------------- @@ -12141,7 +12190,7 @@ and AnalyzeAndMakeAndPublishRecursiveValue overridesOK isGeneratedEventVal cenv let prelimValScheme = ValScheme(bindingId, prelimTyscheme, topValInfo, memberInfoOpt, false, inlineFlag, NormalVal, vis, false, false, false, hasDeclaredTypars) // Check the literal r.h.s., if any - let _, konst = TcLiteral cenv ty env tpenv (bindingAttribs, bindingExpr) + let _, konst = TcLiteral cenv ty envinner tpenv (bindingAttribs, bindingExpr) let extraBindings, extraValues, tpenv, recBindIdx = let extraBindings = @@ -15269,7 +15318,10 @@ module TcExceptionDeclarations = let repr = match reprIdOpt with | Some longId -> - match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.eNameResEnv TypeNameResolutionInfo.Default longId with + let resolution = + ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.eNameResEnv TypeNameResolutionInfo.Default longId + |> ForceRaise + match resolution with | Item.ExnCase exnc, [] -> CheckTyconAccessible cenv.amap m env.eAccessRights exnc |> ignore if not (isNil args') then diff --git a/tests/fsharp/core/nameof/preview/test.fsx b/tests/fsharp/core/nameof/preview/test.fsx index 6b6da1a17b00..3f69e973cfa6 100644 --- a/tests/fsharp/core/nameof/preview/test.fsx +++ b/tests/fsharp/core/nameof/preview/test.fsx @@ -240,11 +240,17 @@ type OperatorNameOfTests() = member this.``lookup name of + operator`` () = let b = nameof(+) - Assert.AreEqual("op_Addition",b) + Assert.AreEqual("+",b) + let b2 = nameof(op_Addition) + Assert.AreEqual("op_Addition",b2) + let b3 = nameof(FSharp.Core.Operators.(+)) + Assert.AreEqual("+",b3) + let b4 = nameof(FSharp.Core.Operators.op_Addition) + Assert.AreEqual("op_Addition",b4) member this.``lookup name of |> operator`` () = let a = nameof(|>) - let result = Assert.AreEqual("op_PipeRight",a) + let result = Assert.AreEqual("|>",a) let b = nameof(op_PipeRight) result || Assert.AreEqual("op_PipeRight",b) @@ -294,6 +300,30 @@ type Person = | x when x = nameof __.Age -> { __ with Age = value :?> int } | _ -> __ +type GenericClassNameOfTests<'TTT>() = + + static member ``can get name of class type parameter`` () = + let b = nameof<'TTT> + Assert.AreEqual("TTT", b) + +type GenericClassNameOfTests2<[] 'TTT>() = + + static member ``can get name of class unit of measure type parameter`` () = + let b = nameof<'TTT> + Assert.AreEqual("TTT", b) + +module RecTest = + let rec [] two = 2 + and twoName = nameof(two) + let ``can get name of recursive literal`` () = + Assert.AreEqual("two", twoName) + +module rec RecTest2 = + let [] two = 2 + let twoName = nameof(two) + let ``can get name of literal in recursive module`` () = + Assert.AreEqual("two", twoName) + do test "local variable name lookup" (BasicNameOfTests.``local variable name lookup`` ()) do test "local int function name" (BasicNameOfTests.``local int function name`` ()) do test "local curried function name" (BasicNameOfTests.``local curried function name`` ()) @@ -343,6 +373,41 @@ do test "lookup name of a generic class" ((NameOfOperatorForGener do test "user defined nameof should shadow the operator"(UserDefinedNameOfTests.``user defined nameof should shadow the operator`` ()) +do test "can get name of class type parameter"(GenericClassNameOfTests.``can get name of class type parameter`` ()) +do test "can get name of class type parameter"(GenericClassNameOfTests2.``can get name of class unit of measure type parameter`` ()) +do test "can get name of recursive literal"(RecTest.``can get name of recursive literal`` ()) +do test "can get name of literal in recursive module"(RecTest2.``can get name of literal in recursive module`` ()) + +module PatternMatchingWithNameof = + /// Simplified version of EventStore's API + type RecordedEvent = { EventType: string; Data: string } + + /// My concrete type: + type MyEvent = + | A of string + | B of string + + let deserialize (e: RecordedEvent) : MyEvent = + match e.EventType with + | nameof A -> A e.Data + | nameof B -> B e.Data + | t -> failwithf "Invalid EventType: %s" t + + let getData event = + match event with + | A amsg -> amsg + | B bmsg -> bmsg + + let re1 = { EventType = nameof A; Data = "hello" } + let re2 = { EventType = nameof B; Data = "world" } + + let a = deserialize re1 + let b = deserialize re2 + + check "fklwveoihwq1" (getData a) re1.Data + check "fklwveoihwq2" (getData b) re2.Data + + #if TESTS_AS_APP let RUN() = match !failures with diff --git a/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/NameOf/E_NameOfAdditionExpr.fs b/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/NameOf/E_NameOfAdditionExpr.fs deleted file mode 100644 index 2fd34fa161ad..000000000000 --- a/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/NameOf/E_NameOfAdditionExpr.fs +++ /dev/null @@ -1,7 +0,0 @@ -// #Regression #Conformance #DataExpressions -// Verify that nameof doesn't work on const string -//Expression does not have a name. - -let x = nameof(1+2) - -exit 0 diff --git a/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/NameOf/env.lst b/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/NameOf/env.lst index 9d473234e60f..2d918a0ca142 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/NameOf/env.lst +++ b/tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/NameOf/env.lst @@ -4,7 +4,6 @@ SOURCE=E_NameOfIntegerAppliedFunction.fs SCFLAGS="--langversion:preview" # E_NameOfIntegerAppliedFunction.fs SOURCE=E_NameOfPartiallyAppliedFunction.fs SCFLAGS="--langversion:preview" # E_NameOfPartiallyAppliedFunction.fs SOURCE=E_NameOfDictLookup.fs SCFLAGS="--langversion:preview" # E_NameOfDictLookup.fs - SOURCE=E_NameOfAdditionExpr.fs SCFLAGS="--langversion:preview" # E_NameOfAdditionExpr.fs SOURCE=E_NameOfParameterAppliedFunction.fs SCFLAGS="--langversion:preview" # E_NameOfParameterAppliedFunction.fs SOURCE=E_NameOfAsAFunction.fs SCFLAGS="--langversion:preview" # E_NameOfAsAFunction.fs SOURCE=E_NameOfWithPipe.fs SCFLAGS="--langversion:preview" # E_NameOfWithPipe.fs