Skip to content

Commit

Permalink
Merge branch 'nameof-pattern' of https://github.com/Tarmil/visualfsharp…
Browse files Browse the repository at this point in the history 
… into nameof-pattern
  • Loading branch information
@dsyme
dsyme committed Jul 14, 2020
2 parents 6b84cb5 + e7e31f9 commit 919042c
Show file tree
Hide file tree
Showing 2 changed files with 99 additions and 32 deletions.
92 changes: 62 additions & 30 deletions src/fsharp/TypeChecker.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5386,14 +5386,59 @@ 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)
match args with
| SynArgPats.Pats []
| SynArgPats.NamePatPairs ([], _) ->
let _, acc = tcArgPatterns ()
match getArgPatterns () with
| [] ->
TcPat warnOnUpperForId cenv env topValInfo vFlags (tpenv, names, takenNames) ty (mkSynPatVar vis id)
| _ ->
errorR (UndefinedName (0, FSComp.SR.undefinedNamePatternDiscriminator, id, NoSuggestions))
(fun _ -> TPat_error m), acc

| SynArgPats.Pats [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"

| _ ->
errorR (UndefinedName (0, FSComp.SR.undefinedNamePatternDiscriminator, id, NoSuggestions))
(fun _ -> TPat_error m), acc
error (UndefinedName(0, FSComp.SR.undefinedNamePatternDiscriminator, id, NoSuggestions))

| Item.ActivePatternCase (APElemRef (apinfo, vref, idx)) as item ->
// Report information about the 'active recognizer' occurrence to IDE
Expand Down Expand Up @@ -5425,30 +5470,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
Expand Down Expand Up @@ -9281,6 +9302,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
Expand Down Expand Up @@ -12129,7 +12161,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 =
Expand Down
39 changes: 37 additions & 2 deletions tests/fsharp/core/nameof/preview/test.fsx
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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`` ())
Expand Down Expand Up @@ -343,6 +373,11 @@ 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`` ())

#if TESTS_AS_APP
let RUN() =
match !failures with
Expand Down

0 comments on commit 919042c

Please sign in to comment.