Add SynType.Paren (dotnet#9241)

auduchinok · KevinRansom · nosami · commit eda79fb5ca8c · 2021-02-22T14:31:07.000Z
* Add SynType.Paren

* Review fixes: Skip -&gt; Strip, remove `rec`

* Add test for paren types ranges

* Cleanup tests

* Update neg04 test baseline

* Cleanup

Co-authored-by: Kevin Ransom &lt;codecutter@hotmail.com&gt;
diff --git a/src/fsharp/SyntaxTree.fs b/src/fsharp/SyntaxTree.fs
@@ -515,7 +515,11 @@ type SynType =
        value: SynType *
        range: range
 
-    /// Gets the syntax range of this constuct
+    | Paren of
+      innerType: SynType *
+      range: range
+
+    /// Gets the syntax range of this construct
     member x.Range =
         match x with
         | SynType.App (range=m)
@@ -532,7 +536,8 @@ type SynType =
         | SynType.StaticConstantNamed (range=m)
         | SynType.HashConstraint (range=m)
         | SynType.MeasureDivide (range=m)
-        | SynType.MeasurePower (range=m) -> m
+        | SynType.MeasurePower (range=m)
+        | SynType.Paren (range=m) -> m
         | SynType.LongIdent lidwd -> lidwd.Range
 
 /// Represents a syntax tree for F# expressions
diff --git a/src/fsharp/SyntaxTreeOps.fs b/src/fsharp/SyntaxTreeOps.fs
@@ -8,8 +8,8 @@ open FSharp.Compiler
 open FSharp.Compiler.AbstractIL
 open FSharp.Compiler.AbstractIL.Internal.Library
 open FSharp.Compiler.ErrorLogger
-open FSharp.Compiler.Features
 open FSharp.Compiler.PrettyNaming
+open FSharp.Compiler.Range
 open FSharp.Compiler.SyntaxTree
 open FSharp.Compiler.Range
 open FSharp.Compiler.XmlDoc
@@ -397,6 +397,14 @@ let (|Attributes|) synAttributes =
 let rangeOfNonNilAttrs (attrs: SynAttributes) =
     (attrs.Head.Range, attrs.Tail) ||> unionRangeWithListBy (fun a -> a.Range)
 
+let rec stripParenTypes synType =
+    match synType with
+    | SynType.Paren (innerType, _) -> stripParenTypes innerType
+    | _ -> synType
+
+let (|StripParenTypes|) synType =
+    stripParenTypes synType
+
 /// Operations related to the syntactic analysis of arguments of value, function and member definitions and signatures.
 module SynInfo =
 
diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs
@@ -4657,7 +4657,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope
         | _, TyparKind.Type ->
             TcTypeApp cenv newOk checkCxs occ env tpenv m tcref [] []
 
-    | SynType.App (SynType.LongIdent(LongIdentWithDots(tc, _)), _, args, _commas, _, postfix, m) -> 
+    | SynType.App (StripParenTypes (SynType.LongIdent(LongIdentWithDots(tc, _))), _, args, _commas, _, postfix, m) -> 
         let ad = env.eAccessRights
 
         let tcref = 
@@ -4793,7 +4793,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope
             let ms2, tpenv = TcMeasure cenv newOk checkCxs occ env tpenv typ2 m
             TType_measure (Measure.Prod(ms1, Measure.Inv ms2)), tpenv
 
-    | SynType.App((SynType.Var(_, m1) | SynType.MeasurePower(_, _, m1)) as arg1, _, args, _commas, _, postfix, m) ->
+    | SynType.App(StripParenTypes (SynType.Var(_, m1) | (SynType.MeasurePower(_, _, m1))) as arg1, _, args, _commas, _, postfix, m) ->
         match optKind, args, postfix with
         | (None | Some TyparKind.Measure), [arg2], true ->
             let ms1, tpenv = TcMeasure cenv newOk checkCxs occ env tpenv arg1 m1
@@ -4808,10 +4808,13 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope
         errorR(Error(FSComp.SR.tcIllegalSyntaxInTypeExpression(), m))
         NewErrorType (), tpenv
 
+    | SynType.Paren(innerType, _) ->
+        TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscopedTyparEnv) innerType
+
 and TcType cenv newOk checkCxs occ env (tpenv: SyntacticUnscopedTyparEnv) ty = 
     TcTypeOrMeasure (Some TyparKind.Type) cenv newOk checkCxs occ env tpenv ty
 
-and TcMeasure cenv newOk checkCxs occ env (tpenv: SyntacticUnscopedTyparEnv) ty m = 
+and TcMeasure cenv newOk checkCxs occ env (tpenv: SyntacticUnscopedTyparEnv) (StripParenTypes ty) m = 
     match ty with
     | SynType.Anon m ->
         error(Error(FSComp.SR.tcAnonymousUnitsOfMeasureCannotBeNested(), m))
@@ -4869,7 +4872,7 @@ and TcTyparConstraints cenv newOk checkCxs occ env tpenv wcs =
     tpenv
 
 #if !NO_EXTENSIONTYPING
-and TcStaticConstantParameter cenv (env: TcEnv) tpenv kind (v: SynType) idOpt container =
+and TcStaticConstantParameter cenv (env: TcEnv) tpenv kind (StripParenTypes v) idOpt container =
     let g = cenv.g
     let fail() = error(Error(FSComp.SR.etInvalidStaticArgument(NicePrint.minimalStringOfType env.DisplayEnv kind), v.Range)) 
     let record ttype =
@@ -4938,7 +4941,7 @@ and TcStaticConstantParameter cenv (env: TcEnv) tpenv kind (v: SynType) idOpt co
 and CrackStaticConstantArgs cenv env tpenv (staticParameters: Tainted<ProvidedParameterInfo>[], args: SynType list, container, containerName, m) =
     let args = 
         args |> List.map (function 
-            | SynType.StaticConstantNamed(SynType.LongIdent(LongIdentWithDots([id], _)), v, _) -> Some id, v
+            | StripParenTypes (SynType.StaticConstantNamed(StripParenTypes (SynType.LongIdent(LongIdentWithDots([id], _))), v, _)) -> Some id, v
             | v -> None, v)
 
     let unnamedArgs = args |> Seq.takeWhile (fst >> Option.isNone) |> Seq.toArray |> Array.map snd
@@ -15343,9 +15346,9 @@ module EstablishTypeDefinitionCores =
             k
 
 
-    let private (|TyconCoreAbbrevThatIsReallyAUnion|_|) (hasMeasureAttr, envinner, id: Ident) synTyconRepr =
+    let private (|TyconCoreAbbrevThatIsReallyAUnion|_|) (hasMeasureAttr, envinner, id: Ident) (synTyconRepr) =
         match synTyconRepr with 
-        | SynTypeDefnSimpleRepr.TypeAbbrev(_, SynType.LongIdent(LongIdentWithDots([unionCaseName], _)), m) 
+        | SynTypeDefnSimpleRepr.TypeAbbrev(_, StripParenTypes (SynType.LongIdent(LongIdentWithDots([unionCaseName], _))), m) 
                               when 
                                 (not hasMeasureAttr && 
                                  (isNil (LookupTypeNameInEnvNoArity OpenQualified unionCaseName.idText envinner.eNameResEnv) || 
@@ -15628,11 +15631,11 @@ module EstablishTypeDefinitionCores =
 
 #if !NO_EXTENSIONTYPING
     /// Get the items on the r.h.s. of a 'type X = ABC<...>' definition
-    let private TcTyconDefnCore_GetGenerateDeclaration_Rhs rhsType =
+    let private TcTyconDefnCore_GetGenerateDeclaration_Rhs (StripParenTypes rhsType) =
         match rhsType with 
-        | SynType.App (SynType.LongIdent(LongIdentWithDots(tc, _)), _, args, _commas, _, _postfix, m) -> Some(tc, args, m)
+        | SynType.App (StripParenTypes (SynType.LongIdent(LongIdentWithDots(tc, _))), _, args, _commas, _, _postfix, m) -> Some(tc, args, m)
         | SynType.LongIdent (LongIdentWithDots(tc, _) as lidwd) -> Some(tc, [], lidwd.Range)
-        | SynType.LongIdentApp (SynType.LongIdent (LongIdentWithDots(tc, _)), LongIdentWithDots(longId, _), _, args, _commas, _, m) -> Some(tc@longId, args, m)
+        | SynType.LongIdentApp (StripParenTypes (SynType.LongIdent (LongIdentWithDots(tc, _))), LongIdentWithDots(longId, _), _, args, _commas, _, m) -> Some(tc@longId, args, m)
         | _ -> None
 
     /// Check whether 'type X = ABC<...>' is a generative provided type definition
@@ -17147,7 +17150,7 @@ module TcDeclarations =
                         memberFlags.MemberKind=MemberKind.Constructor && 
                         // REVIEW: This is a syntactic approximation
                         (match valSpfn.SynType, valSpfn.SynInfo.ArgInfos with 
-                         | SynType.Fun (SynType.LongIdent (LongIdentWithDots([id], _)), _, _), [[_]] when id.idText = "unit" -> true
+                         | StripParenTypes (SynType.Fun (StripParenTypes (SynType.LongIdent (LongIdentWithDots([id], _))), _, _)), [[_]] when id.idText = "unit" -> true
                          | _ -> false) 
                     | _ -> false) 
 
diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy
@@ -4956,12 +4956,12 @@ atomType:
   | UNDERSCORE 
      { SynType.Anon (lhs parseState) }
 
-  | LPAREN typ rparen 
-     {  $2 }
+  | LPAREN typ rparen
+     { SynType.Paren ($2, lhs parseState) }
 
-  | LPAREN typ recover      
-     { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen()) 
-       $2 }  
+  | LPAREN typ recover
+     { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedParen ())
+       SynType.Paren ($2, lhs parseState) }
 
   | STRUCT LPAREN appType STAR tupleOrQuotTypeElements  rparen 
     { SynType.Tuple(true, (false, $3) :: $5, lhs parseState) }
diff --git a/src/fsharp/service/ServiceAssemblyContent.fs b/src/fsharp/service/ServiceAssemblyContent.fs
@@ -603,7 +603,8 @@ module ParsedInput =
         and walkType = function
             | SynType.Array (_, t, _)
             | SynType.HashConstraint (t, _)
-            | SynType.MeasurePower (t, _, _) -> walkType t
+            | SynType.MeasurePower (t, _, _)
+            | SynType.Paren (t, _) -> walkType t
             | SynType.Fun (t1, t2, _)
             | SynType.MeasureDivide (t1, t2, _) -> walkType t1; walkType t2
             | SynType.LongIdent ident -> addLongIdentWithDots ident
diff --git a/src/fsharp/service/ServiceInterfaceStubGenerator.fs b/src/fsharp/service/ServiceInterfaceStubGenerator.fs
@@ -10,6 +10,7 @@ open FSharp.Compiler.AbstractIL.Internal.Library
 open FSharp.Compiler.Range
 open FSharp.Compiler.SourceCodeServices
 open FSharp.Compiler.SyntaxTree
+open FSharp.Compiler.SyntaxTreeOps
         
 #if !FX_NO_INDENTED_TEXT_WRITER
 [<AutoOpen>]
@@ -112,8 +113,8 @@ type InterfaceData =
             ty.Range
     member x.TypeParameters = 
         match x with
-        | InterfaceData.Interface(ty, _)
-        | InterfaceData.ObjExpr(ty, _) ->
+        | InterfaceData.Interface(StripParenTypes ty, _)
+        | InterfaceData.ObjExpr(StripParenTypes ty, _) ->
             let rec (|RationalConst|) = function
                 | SynRationalConst.Integer i ->
                     string i
@@ -158,6 +159,8 @@ type InterfaceData =
                     Some (sprintf "%s^%s" typeName power)
                 | SynType.MeasureDivide(TypeIdent numerator, TypeIdent denominator, _) ->
                     Some (sprintf "%s/%s" numerator denominator)
+                | SynType.Paren(TypeIdent typeName, _) ->
+                    Some typeName
                 | _ -> 
                     None
             match ty with
diff --git a/src/fsharp/service/ServiceParamInfoLocations.fs b/src/fsharp/service/ServiceParamInfoLocations.fs
@@ -32,8 +32,8 @@ type FSharpNoteworthyParamInfoLocations(longId: string list, longIdRange: range,
 [<AutoOpen>]
 module internal NoteworthyParamInfoLocationsImpl =
 
-    let isStaticArg a =
-        match a with
+    let isStaticArg (StripParenTypes synType) =
+        match synType with
         | SynType.StaticConstant _ | SynType.StaticConstantExpr _ | SynType.StaticConstantNamed _ -> true
         | SynType.LongIdent _ -> true // NOTE: this is not a static constant, but it is a prefix of incomplete code, e.g. "TP<42, Arg3" is a prefix of "TP<42, Arg3=6>" and Arg3 shows up as a LongId
         | _ -> false
@@ -52,7 +52,7 @@ module internal NoteworthyParamInfoLocationsImpl =
         | Found of openParen: pos * commasAndCloseParen: (pos * string option) list * hasClosedParen: bool
         | NotFound
 
-    let digOutIdentFromStaticArg synType =
+    let digOutIdentFromStaticArg (StripParenTypes synType) =
         match synType with 
         | SynType.StaticConstantNamed(SynType.LongIdent(LongIdentWithDots([id], _)), _, _) -> Some id.idText 
         | SynType.LongIdent(LongIdentWithDots([id], _)) -> Some id.idText // NOTE: again, not a static constant, but may be a prefix of a Named in incomplete code
@@ -145,9 +145,9 @@ module internal NoteworthyParamInfoLocationsImpl =
                     NotFound, Some inner
             | _ -> NotFound, Some inner
 
-    let (|StaticParameters|_|) pos synType =
+    let (|StaticParameters|_|) pos (StripParenTypes synType) =
         match synType with
-        | SynType.App(SynType.LongIdent(LongIdentWithDots(lid, _) as lidwd), Some(openm), args, commas, closemOpt, _pf, wholem) ->
+        | SynType.App(StripParenTypes (SynType.LongIdent(LongIdentWithDots(lid, _) as lidwd)), Some(openm), args, commas, closemOpt, _pf, wholem) ->
             let lidm = lidwd.Range
             let betweenTheBrackets = mkRange wholem.FileName openm.Start wholem.End
             if AstTraversal.rangeContainsPosEdgesExclusive betweenTheBrackets pos && args |> List.forall isStaticArg then
diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs
@@ -9,6 +9,7 @@ namespace FSharp.Compiler.SourceCodeServices
 
 open FSharp.Compiler.Range
 open FSharp.Compiler.SyntaxTree
+open FSharp.Compiler.SyntaxTreeOps
 
 /// A range of utility functions to assist with traversing an AST
 module public AstTraversal =
@@ -518,7 +519,7 @@ module public AstTraversal =
                 
             visitor.VisitPat (defaultTraverse, pat)
 
-        and traverseSynType (ty: SynType) =
+        and traverseSynType (StripParenTypes ty) =
             let defaultTraverse ty =
                 match ty with
                 | SynType.App (typeName, _, typeArgs, _, _, _, _)
diff --git a/src/fsharp/service/ServiceUntypedParse.fs b/src/fsharp/service/ServiceUntypedParse.fs
@@ -355,7 +355,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: ParsedInput option
                   | SynMemberDefn.AutoProperty(_attribs, _isStatic, _id, _tyOpt, _propKind, _, _xmlDoc, _access, synExpr, _, _) -> yield! walkExpr true synExpr
                   | SynMemberDefn.ImplicitCtor(_, _, _, _, m) -> yield! checkRange m
                   | SynMemberDefn.Member(bind, _) -> yield! walkBind bind
-                  | SynMemberDefn.Interface(_synty, Some membs, _) -> for m in membs do yield! walkMember m
+                  | SynMemberDefn.Interface(_, Some membs, _) -> for m in membs do yield! walkMember m
                   | SynMemberDefn.Inherit(_, _, m) -> 
                       // can break on the "inherit" clause
                       yield! checkRange m
@@ -810,6 +810,7 @@ module UntypedParseImpl =
             | SynType.HashConstraint(t, _) -> walkType t
             | SynType.MeasureDivide(t1, t2, _) -> walkType t1 |> Option.orElse (walkType t2)
             | SynType.MeasurePower(t, _, _) -> walkType t
+            | SynType.Paren(t, _) -> walkType t
             | _ -> None
 
         and walkClause (Clause(pat, e1, e2, _, _)) =
@@ -1140,7 +1141,7 @@ module UntypedParseImpl =
             | (SynExpr.New (_, SynType.LongIdent typeName, arg, _)) -> 
                 // new A()
                 Some (endOfLastIdent typeName, findSetters arg)
-            | (SynExpr.New (_, SynType.App(SynType.LongIdent typeName, _, _, _, mGreaterThan, _, _), arg, _)) -> 
+            | (SynExpr.New (_, SynType.App(StripParenTypes (SynType.LongIdent typeName), _, _, _, mGreaterThan, _, _), arg, _)) -> 
                 // new A<_>()
                 Some (endOfClosingTokenOrLastIdent mGreaterThan typeName, findSetters arg)
             | (SynExpr.App (_, false, SynExpr.Ident id, arg, _)) -> 
diff --git a/tests/fsharp/typecheck/sigs/neg04.bsl b/tests/fsharp/typecheck/sigs/neg04.bsl
@@ -110,7 +110,7 @@ is not compatible with type
     'IBar'    
 
 
-neg04.fs(144,10,144,25): typecheck error FS0193: Type constraint mismatch. The type 
+neg04.fs(144,10,144,26): typecheck error FS0193: Type constraint mismatch. The type 
     'int * int'    
 is not compatible with type
     'IBar'    
@@ -122,7 +122,7 @@ is not compatible with type
     'IBar'    
 
 
-neg04.fs(150,10,150,26): typecheck error FS0193: Type constraint mismatch. The type 
+neg04.fs(150,10,150,27): typecheck error FS0193: Type constraint mismatch. The type 
     'int -> int'    
 is not compatible with type
     'IBar'    
diff --git a/tests/service/Common.fs b/tests/service/Common.fs
@@ -368,6 +368,9 @@ let assertHasSymbolUsages (names: string list) (results: FSharpCheckFileResults)
     for name in names do
         Assert.That(Set.contains name symbolNames, name)
 
+let getRangeCoords (r: range) =
+    (r.StartLine, r.StartColumn), (r.EndLine, r.EndColumn)
+
 let coreLibAssemblyName =
 #if NETCOREAPP
     "System.Runtime"
diff --git a/tests/service/ServiceUntypedParseTests.fs b/tests/service/ServiceUntypedParseTests.fs
@@ -130,16 +130,11 @@ let foo7 = ()
 [<A;>]
 let foo8 = ()
 """
-    let (SynModuleOrNamespace (_, _, _, decls, _, _, _, _)) = parseSourceCodeAndGetModule source
+    let (SynModuleOrNamespace (decls = decls)) = parseSourceCodeAndGetModule source
     decls |> List.map (fun decl ->
         match decl with
-        | SynModuleDecl.Let (_,[Binding(_,_,_,_,attributeLists,_,_,_,_,_,_,_)],_) ->
-            attributeLists |> List.map (fun list ->
-                let r = list.Range
-
-                list.Attributes.Length,
-                ((r.StartLine, r.StartColumn), (r.EndLine, r.EndColumn)))
-
+        | SynModuleDecl.Let (_, [Binding (attributes = attributeLists)], _) ->
+            attributeLists |> List.map (fun list -> list.Attributes.Length, getRangeCoords list.Range)
         | _ -> failwith "Could not get binding")
     |> shouldEqual
         [ [ (1, ((2,  0),  (2, 5))) ]
@@ -152,16 +147,59 @@ let foo8 = ()
           [ (1, ((24, 0), (24, 6))) ] ]
 
 
+let rec getParenTypes (synType: SynType): SynType list =
+    [ match synType with
+      | SynType.Paren (innerType, _) ->
+          yield synType
+          yield! getParenTypes innerType
+
+      | SynType.Fun (argType, returnType, _) ->
+          yield! getParenTypes argType
+          yield! getParenTypes returnType
+
+      | SynType.Tuple (_, types, _) ->
+          for _, synType in types do
+              yield! getParenTypes synType
+
+      | SynType.AnonRecd (_, fields, _) ->
+          for _, synType in fields do
+              yield! getParenTypes synType
+
+      | SynType.App (typeName = typeName; typeArgs = typeArgs)
+      | SynType.LongIdentApp (typeName = typeName; typeArgs = typeArgs) ->
+          yield! getParenTypes typeName
+          for synType in typeArgs do
+              yield! getParenTypes synType
+
+      | _ -> () ]
+
+[<Test>]
+let ``SynType.Paren ranges`` () =
+    let source = """
+((): int * (int * int))
+((): (int -> int) -> int)
+((): ((int)))
+"""
+    let (SynModuleOrNamespace (decls = decls)) = parseSourceCodeAndGetModule source
+    decls |> List.map (fun decl ->
+        match decl with
+        | SynModuleDecl.DoExpr (expr = SynExpr.Paren (expr = SynExpr.Typed (_, synType ,_))) ->
+            getParenTypes synType
+            |> List.map (fun synType -> getRangeCoords synType.Range)
+        | _ -> failwith "Could not get binding")
+    |> shouldEqual
+        [ [ (2, 11), (2, 22) ]
+          [ (3, 5), (3, 17) ]
+          [ (4, 5), (4, 12); (4, 6), (4, 11) ] ]
+
+
 module TypeMemberRanges =
 
     let getTypeMemberRange source =
-        let (SynModuleOrNamespace (_, _, _, decls, _, _, _, _)) = parseSourceCodeAndGetModule source
+        let (SynModuleOrNamespace (decls = decls)) = parseSourceCodeAndGetModule source
         match decls with
         | [ SynModuleDecl.Types ([ TypeDefn (_, SynTypeDefnRepr.ObjectModel (_, memberDecls, _), _, _) ], _) ] ->
-            memberDecls |> List.map (fun memberDecl ->
-                let range = memberDecl.Range
-                (range.StartLine, range.StartColumn), (range.EndLine, range.EndColumn))
-
+            memberDecls |> List.map (fun memberDecl -> getRangeCoords memberDecl.Range)
         | _ -> failwith "Could not get member"
 
     
