Further enhancements to nameof

src/fsharp/TypeChecker.fs

@@ -5386,12 +5386,52 @@ 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
 
+        // 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 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
+                | 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
 
@@ -5425,30 +5465,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
@@ -9281,6 +9297,17 @@ and TcNameOfExpr cenv env tpenv (synArg: SynExpr) =
         | LongOrSingleIdent (false, (LongIdentWithDots(longId, _) as lidd), _, _) ->
             let ad = env.eAccessRights
             let result = defaultArg resultOpt (List.last longId)
+
+            // Demangle back to source operator name if the lengths in the ranges indicate the
+            // original source range matches exactly
+            let result =
+                if IsMangledOpName result.idText then
+                    let demangled = DecompileOpName result.idText
+                    if demangled.Length = result.idRange.EndColumn - result.idRange.StartColumn then
+                        ident(demangled, result.idRange) 
+                    else result
+                else result
+
             let resolvedToModuleOrNamespaceName =
                 if delayed.IsEmpty then 
                     let id,rest = List.headAndTail longId
@@ -12129,7 +12156,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 = 

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<[<Measure>] '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 [<Literal>] two = 2
+    and twoName = nameof(two)
+    let ``can get name of recursive literal`` () =
+        Assert.AreEqual("two", twoName)
+
+module rec RecTest2 = 
+    let [<Literal>] 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<int>.``can get name of class type parameter`` ())
+do test "can get name of class type parameter"(GenericClassNameOfTests2<FSharp.Data.UnitSystems.SI.UnitSymbols.kg>.``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