Parser: parse primary ctor params as normal patterns

docs/release-notes/.FSharp.Compiler.Service/8.0.200.md

@@ -13,3 +13,8 @@
 * Parser recovers on unfinished enum case declarations. ([PR #16401](https://github.com/dotnet/fsharp/pull/16401))
 * Parser recovers on unfinished record declarations. ([PR #16357](https://github.com/dotnet/fsharp/pull/16357))
 * `MutableKeyword` to [SynFieldTrivia](../reference/fsharp-compiler-syntaxtrivia-synfieldtrivia.html) ([PR #16357](https://github.com/dotnet/fsharp/pull/16357))
+* Parser recovers on complex primary constructor patterns, better tree representation for primary constructor patterns. ([PR #16425](https://github.com/dotnet/fsharp/pull/16425))
+
+### Changed
+* `implicitCtorSynPats` in `SynTypeDefnSimpleRepr.General` is now `SynPat option` instead of `SynSimplePats option`. ([PR #16425](https://github.com/dotnet/fsharp/pull/16425))
+* `SyntaxVisitorBase<'T>.VisitSimplePats` now takes `SynPat` instead of `SynSimplePat list`. ([PR #16425](https://github.com/dotnet/fsharp/pull/16425))

src/Compiler/Checking/CheckDeclarations.fs

@@ -1039,7 +1039,7 @@ module MutRecBindingChecking =
                             let innerState = (None, envForTycon, tpenv, recBindIdx, uncheckedBindsRev)
                             [Phase2AIncrClassCtor (staticCtorInfo, None)], innerState
 
-                        | Some (SynMemberDefn.ImplicitCtor (vis, Attributes attrs, SynSimplePats.SimplePats(pats=spats), thisIdOpt, xmlDoc, m,_)), ContainerInfo(_, Some memberContainerInfo) ->
+                        | Some (SynMemberDefn.ImplicitCtor (vis, Attributes attrs, pat, thisIdOpt, xmlDoc, m,_)), ContainerInfo(_, Some memberContainerInfo) ->
 
                             let (MemberOrValContainerInfo(tcref, _, baseValOpt, safeInitInfo, _)) = memberContainerInfo
 
@@ -1050,7 +1050,7 @@ module MutRecBindingChecking =
                             let staticCtorInfo = TcStaticImplicitCtorInfo_Phase2A(cenv, envForTycon, tcref, m, copyOfTyconTypars)
 
                             // Phase2A: make incrCtorInfo - ctorv, thisVal etc, type depends on argty(s) 
-                            let incrCtorInfo = TcImplicitCtorInfo_Phase2A(cenv, envForTycon, tpenv, tcref, vis, attrs, spats, thisIdOpt, baseValOpt, safeInitInfo, m, copyOfTyconTypars, objTy, thisTy, xmlDoc)
+                            let incrCtorInfo = TcImplicitCtorInfo_Phase2A(cenv, envForTycon, tpenv, tcref, vis, attrs, pat, thisIdOpt, baseValOpt, safeInitInfo, m, copyOfTyconTypars, objTy, thisTy, xmlDoc)
 
                             // Phase2A: Add copyOfTyconTypars from incrCtorInfo - or from tcref 
                             let envForTycon = AddDeclaredTypars CheckForDuplicateTypars staticCtorInfo.IncrCtorDeclaredTypars envForTycon
@@ -1926,9 +1926,10 @@ module MutRecBindingChecking =
 let private ReportErrorOnStaticClass (synMembers: SynMemberDefn list) =
     for mem in synMembers do
         match mem with
-        | SynMemberDefn.ImplicitCtor(ctorArgs = SynSimplePats.SimplePats(pats = pats)) when (not pats.IsEmpty) ->
-            for pat in pats do
-                warning(Error(FSComp.SR.chkConstructorWithArgumentsOnStaticClasses(), pat.Range))
+        | SynMemberDefn.ImplicitCtor(ctorArgs = pat) ->
+            match pat with
+            | SynPat.Paren(innerPat, _) -> warning(Error(FSComp.SR.chkConstructorWithArgumentsOnStaticClasses(), innerPat.Range))
+            | _ -> ()
         | SynMemberDefn.Member(SynBinding(valData = SynValData(memberFlags = Some memberFlags)), m) when memberFlags.MemberKind = SynMemberKind.Constructor ->
             warning(Error(FSComp.SR.chkAdditionalConstructorOnStaticClasses(), m))
         | SynMemberDefn.Member(SynBinding(valData = SynValData(memberFlags = Some memberFlags)), m) when memberFlags.IsInstance ->
@@ -2623,8 +2624,8 @@ module EstablishTypeDefinitionCores =
 
               match implicitCtorSynPats with
               | None -> ()
-              | Some spats -> 
-                  let ctorArgNames, patEnv = TcSimplePatsOfUnknownType cenv true NoCheckCxs env tpenv spats
+              | Some pat ->
+                  let ctorArgNames, patEnv, _ = TcSimplePatsOfUnknownType cenv true NoCheckCxs env tpenv pat
 
                   let (TcPatLinearEnv(_, names, _)) = patEnv
 
@@ -2790,19 +2791,24 @@ module EstablishTypeDefinitionCores =
             match synTyconRepr with 
             | SynTypeDefnSimpleRepr.General (SynTypeDefnKind.Delegate (_ty, arity), _, _, _, _, _, _, _) -> arity.ArgNames
             | SynTypeDefnSimpleRepr.General (SynTypeDefnKind.Unspecified, _, _, _, _, _, Some synPats, _) ->
-                let rec patName (p: SynSimplePat) =
+                let rec patName (p: SynPat) =
                     match p with
-                    | SynSimplePat.Id (id, _, _, _, _, _) -> id.idText
-                    | SynSimplePat.Typed(pat, _, _) -> patName pat
-                    | SynSimplePat.Attrib(pat, _, _) -> patName pat
+                    | SynPat.Named(ident = (SynIdent(id, _))) -> Some id.idText
+                    | SynPat.Typed(pat = pat)
+                    | SynPat.Attrib(pat = pat) -> patName pat
+                    | _ -> None
 
-                let rec pats (p: SynSimplePats) =
-                    match p with
-                    | SynSimplePats.SimplePats (pats = ps) -> ps
+                let getSimplePats (pat: SynPat) =
+                    match pat with
+                    | SynPat.Paren(pat, _) ->
+                        match pat with
+                        | SynPat.Tuple(false, pats, _, _) -> pats
+                        | pat -> [pat]
+                    | _ -> []
 
                 let patNames =
-                    pats synPats
-                    |> List.map patName
+                    getSimplePats synPats
+                    |> List.choose patName
 
                 patNames
             | _ -> []
@@ -3378,14 +3384,13 @@ module EstablishTypeDefinitionCores =
                 | rf :: _ -> errorR (Error(FSComp.SR.tcInterfaceTypesAndDelegatesCannotContainFields(), rf.Range))
                 | _ -> ()
 
-            let primaryConstructorInDelegateCheck(implicitCtorSynPats : SynSimplePats option) =
+            let primaryConstructorInDelegateCheck(implicitCtorSynPats : SynPat option) =
                 match implicitCtorSynPats with 
                 | None -> ()
-                | Some spats ->
-                    let ctorArgNames, _ = TcSimplePatsOfUnknownType cenv true CheckCxs envinner tpenv spats
+                | Some pat ->
+                    let ctorArgNames, _, _ = TcSimplePatsOfUnknownType cenv true CheckCxs envinner tpenv pat
                     if not ctorArgNames.IsEmpty then
-                        match spats with
-                        | SynSimplePats.SimplePats(range = m) -> errorR (Error(FSComp.SR.parsOnlyClassCanTakeValueArguments(), m))
+                        errorR (Error(FSComp.SR.parsOnlyClassCanTakeValueArguments(), pat.Range))
 
             let envinner = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars m) envinner
             let envinner = MakeInnerEnvForTyconRef envinner thisTyconRef false
@@ -3539,9 +3544,9 @@ module EstablishTypeDefinitionCores =
                           match implicitCtorSynPats with 
                           | None -> 
                               ()
-                          | Some spats -> 
-                              if tycon.IsFSharpStructOrEnumTycon then 
-                                  let ctorArgNames, patEnv = TcSimplePatsOfUnknownType cenv true CheckCxs envinner tpenv spats
+                          | Some pat -> 
+                              if tycon.IsFSharpStructOrEnumTycon then
+                                  let ctorArgNames, patEnv, _ = TcSimplePatsOfUnknownType cenv true CheckCxs envinner tpenv pat
 
                                   let (TcPatLinearEnv(_, names, _)) = patEnv
 
@@ -4441,7 +4446,7 @@ module TcDeclarations =
 
             let implicitCtorSynPats = 
                 members |> List.tryPick (function 
-                    | SynMemberDefn.ImplicitCtor (ctorArgs = SynSimplePats.SimplePats _ as spats) -> Some spats
+                    | SynMemberDefn.ImplicitCtor (ctorArgs = pat) -> Some pat
                     | _ -> None)
 
             // An ugly bit of code to pre-determine if a type has a nullary constructor, prior to establishing the 
@@ -4450,7 +4455,7 @@ module TcDeclarations =
                 members |> List.exists (function 
                     | SynMemberDefn.Member(memberDefn=SynBinding(valData=SynValData(memberFlags=Some memberFlags); headPat = SynPatForConstructorDecl SynPatForNullaryArgs)) -> 
                         memberFlags.MemberKind=SynMemberKind.Constructor 
-                    | SynMemberDefn.ImplicitCtor (ctorArgs = SynSimplePats.SimplePats(pats = spats)) -> isNil spats
+                    | SynMemberDefn.ImplicitCtor (ctorArgs = SynPat.Const(SynConst.Unit, _)) -> true
                     | _ -> false)
             let repr = SynTypeDefnSimpleRepr.General(kind, inherits, slotsigs, fields, isConcrete, isIncrClass, implicitCtorSynPats, m)
             let isAtOriginalTyconDefn = not (isAugmentationTyconDefnRepr repr)

src/Compiler/Checking/CheckIncrementalClasses.fs

@@ -123,7 +123,7 @@ let TcStaticImplicitCtorInfo_Phase2A(cenv: cenv, env, tcref: TyconRef, m, copyOf
 
 /// Check and elaborate the "left hand side" of the implicit class construction 
 /// syntax.
-let TcImplicitCtorInfo_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, attrs, spats, thisIdOpt, baseValOpt: Val option, safeInitInfo, m, copyOfTyconTypars, objTy, thisTy, xmlDoc: PreXmlDoc) =
+let TcImplicitCtorInfo_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, attrs, pat: SynPat, thisIdOpt, baseValOpt: Val option, safeInitInfo, m, copyOfTyconTypars, objTy, thisTy, xmlDoc: PreXmlDoc) =
 
     let g = cenv.g
     let baseValOpt = 
@@ -135,16 +135,30 @@ let TcImplicitCtorInfo_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, att
     let env = AddDeclaredTypars CheckForDuplicateTypars copyOfTyconTypars env
 
     // Type check arguments by processing them as 'simple' patterns 
-    //     NOTE: if we allow richer patterns here this is where we'd process those patterns 
-    let ctorArgNames, patEnv = TcSimplePatsOfUnknownType cenv true CheckCxs env tpenv (SynSimplePats.SimplePats (spats, [], m))
+    let ctorArgNames, patEnv, SynSimplePats.SimplePats(spats, _, _) = TcSimplePatsOfUnknownType cenv true CheckCxs env tpenv pat
+
+    let rec reportGeneratedPattern spat =
+        match spat with
+        | SynSimplePat.Id(_, _, isCompilerGenerated, _, _, m) ->
+            if isCompilerGenerated then
+                errorR (Error(FSComp.SR.parsOnlySimplePatternsAreAllowedInConstructors(), m))
+
+        | SynSimplePat.Typed(pat, _, _)
+        | SynSimplePat.Attrib(pat, _, _) ->
+            reportGeneratedPattern pat
+
+    for spat in spats do
+      reportGeneratedPattern spat
 
     let (TcPatLinearEnv(_, names, _)) = patEnv
 
     // Create the values with the given names 
     let _, vspecs = MakeAndPublishSimpleVals cenv env names
 
-    if tcref.IsStructOrEnumTycon && isNil spats then 
+    match tcref.IsStructOrEnumTycon, pat with
+    | true, SynPat.Const(SynConst.Unit, _) ->
         errorR (ParameterlessStructCtor(tcref.Range))
+    | _ -> ()
 
     // Put them in order 
     let ctorArgs = List.map (fun v -> NameMap.find v vspecs) ctorArgNames

src/Compiler/Checking/CheckIncrementalClasses.fsi

@@ -130,7 +130,7 @@ val TcImplicitCtorInfo_Phase2A:
     tcref: TyconRef *
     vis: SynAccess option *
     attrs: SynAttribute list *
-    spats: SynSimplePat list *
+    pat: SynPat *
     thisIdOpt: Ident option *
     baseValOpt: Val option *
     safeInitInfo: SafeInitData *

src/Compiler/Checking/CheckPatterns.fs

@@ -171,11 +171,13 @@ and TcSimplePats (cenv: cenv) optionalArgsOK checkConstraints ty env patEnv synS
         let ps', patEnvR = (patEnv, List.zip ptys ps) ||> List.mapFold (fun patEnv (ty, pat) -> TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv pat)
         ps', patEnvR
 
-and TcSimplePatsOfUnknownType (cenv: cenv) optionalArgsOK checkConstraints env tpenv synSimplePats =
+and TcSimplePatsOfUnknownType (cenv: cenv) optionalArgsOK checkConstraints env tpenv (pat: SynPat) =
     let g = cenv.g
     let argTy = NewInferenceType g
     let patEnv = TcPatLinearEnv (tpenv, NameMap.empty, Set.empty)
-    TcSimplePats cenv optionalArgsOK checkConstraints argTy env patEnv synSimplePats
+    let spats, _ = SimplePatsOfPat cenv.synArgNameGenerator pat
+    let names, patEnv = TcSimplePats cenv optionalArgsOK checkConstraints argTy env patEnv spats
+    names, patEnv, spats
 
 and TcPatBindingName cenv env id ty isMemberThis vis1 valReprInfo (vFlags: TcPatValFlags) (names, takenNames: Set<string>) =
     let (TcPatValFlags(inlineFlag, declaredTypars, argAttribs, isMutable, vis2, isCompGen)) = vFlags

src/Compiler/Checking/CheckPatterns.fsi

@@ -15,8 +15,8 @@ val TcSimplePatsOfUnknownType:
     checkConstraints: CheckConstraints ->
     env: TcEnv ->
     tpenv: UnscopedTyparEnv ->
-    synSimplePats: SynSimplePats ->
-        string list * TcPatLinearEnv
+    pat: SynPat ->
+        string list * TcPatLinearEnv * SynSimplePats
 
 // Check a pattern, e.g. for a binding or a match clause
 val TcPat:

src/Compiler/Driver/GraphChecking/FileContentMapping.fs

@@ -200,7 +200,7 @@ let visitSynMemberDefn (md: SynMemberDefn) : FileContentEntry list =
         | SynMemberDefn.GetSetMember(memberDefnForGet, memberDefnForSet, _, _) ->
             yield! collectFromOption visitBinding memberDefnForGet
             yield! collectFromOption visitBinding memberDefnForSet
-        | SynMemberDefn.ImplicitCtor(ctorArgs = ctorArgs) -> yield! visitSynSimplePats ctorArgs
+        | SynMemberDefn.ImplicitCtor(ctorArgs = pat) -> yield! visitPat pat
         | SynMemberDefn.ImplicitInherit(inheritType, inheritArgs, _, _) ->
             yield! visitSynType inheritType
             yield! visitSynExpr inheritArgs

src/Compiler/FSComp.txt

@@ -1740,4 +1740,5 @@ featureReuseSameFieldsInStructUnions,"Share underlying fields in a [<Struct>] di
 3861,chkTailCallAttrOnNonRec,"The TailCall attribute should only be applied to recursive functions."
 3862,parsStaticMemberImcompleteSyntax,"Incomplete declaration of a static construct. Use 'static let','static do','static member' or 'static val' for declaration."
 3863,parsExpectingField,"Expecting record field"
-3864,tooManyMethodsInDotNetTypeWritingAssembly,"The type '%s' has too many methods. Found: '%d', maximum: '%d'"
+3864,tooManyMethodsInDotNetTypeWritingAssembly,"The type '%s' has too many methods. Found: '%d', maximum: '%d'"
+3865,parsOnlySimplePatternsAreAllowedInConstructors,"Only simple patterns are allowed in primary constructors"

src/Compiler/Service/FSharpParseFileResults.fs

@@ -476,17 +476,23 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput,
                     | SynExpr.Typed(_expr, _typeExpr, range) when Position.posEq range.Start pos -> Some range
                     | _ -> defaultTraverse expr
 
-                override _.VisitSimplePats(_path, pats) =
-                    match pats with
-                    | [] -> None
-                    | _ ->
-                        let exprFunc pat =
+                override _.VisitSimplePats(_path, pat) =
+                    let rec loop (pat: SynPat) =
+                        if not (rangeContainsPos pat.Range pos) then
+                            None
+                        else
+
                             match pat with
-                            // (s: string)
-                            | SynSimplePat.Typed(_pat, _targetExpr, range) when Position.posEq range.Start pos -> Some range
+                            | SynPat.Attrib(pat = pat)
+                            | SynPat.Paren(pat = pat) -> loop pat
+
+                            | SynPat.Tuple(elementPats = pats) -> List.tryPick loop pats
+
+                            | SynPat.Typed(range = range) when Position.posEq range.Start pos -> Some pat.Range
+
                             | _ -> None
 
-                        pats |> List.tryPick exprFunc
+                    loop pat
 
                 override _.VisitPat(_path, defaultTraverse, pat) =
                     // (s: string)

src/Compiler/Service/ServiceParseTreeWalk.fs

@@ -163,10 +163,10 @@ type SyntaxVisitorBase<'T>() =
         None
 
     /// VisitSimplePats allows overriding behavior when visiting simple pats
-    abstract VisitSimplePats: path: SyntaxVisitorPath * synPats: SynSimplePat list -> 'T option
+    abstract VisitSimplePats: path: SyntaxVisitorPath * pat: SynPat -> 'T option
 
-    default _.VisitSimplePats(path, synPats) =
-        ignore (path, synPats)
+    default _.VisitSimplePats(path, pat) =
+        ignore (path, pat)
         None
 
     /// VisitPat allows overriding behavior when visiting patterns
@@ -749,15 +749,18 @@ module SyntaxTraversal =
 
             visitor.VisitPat(origPath, defaultTraverse, pat)
 
-        and traverseSynSimplePats origPath (pats: SynSimplePat list) =
-            match visitor.VisitSimplePats(origPath, pats) with
+        and traverseSynSimplePats origPath (pat: SynPat) =
+            match visitor.VisitSimplePats(origPath, pat) with
             | None ->
-                pats
-                |> List.tryPick (fun pat ->
+                let rec loop (pat: SynPat) =
                     match pat with
-                    | SynSimplePat.Attrib(attributes = attributes; range = m) ->
-                        attributeApplicationDives origPath attributes |> pick m attributes
-                    | _ -> None)
+                    | SynPat.Paren(pat = pat)
+                    | SynPat.Typed(pat = pat) -> loop pat
+                    | SynPat.Tuple(elementPats = pats) -> List.tryPick loop pats
+                    | SynPat.Attrib(_, attributes, m) -> attributeApplicationDives origPath attributes |> pick m attributes
+                    | _ -> None
+
+                loop pat
             | x -> x
 
         and traverseSynType origPath (StripParenTypes ty) =
@@ -886,9 +889,8 @@ module SyntaxTraversal =
                     traverseSynBinding path getBinding
                     |> Option.orElseWith (fun () -> traverseSynBinding path setBinding)
 
-            | SynMemberDefn.ImplicitCtor(ctorArgs = simplePats) ->
-                match simplePats with
-                | SynSimplePats.SimplePats(pats = simplePats) -> traverseSynSimplePats path simplePats
+            | SynMemberDefn.ImplicitCtor(ctorArgs = pat) -> traverseSynSimplePats path pat
+
             | SynMemberDefn.ImplicitInherit(synType, synExpr, _identOption, range) ->
                 [
                     dive () synType.Range (fun () ->

src/Compiler/Service/ServiceParseTreeWalk.fsi

@@ -152,8 +152,8 @@ type SyntaxVisitorBase<'T> =
     default VisitRecordField:
         path: SyntaxVisitorPath * copyOpt: SynExpr option * recordField: SynLongIdent option -> 'T option
 
-    abstract VisitSimplePats: path: SyntaxVisitorPath * synPats: SynSimplePat list -> 'T option
-    default VisitSimplePats: path: SyntaxVisitorPath * synPats: SynSimplePat list -> 'T option
+    abstract VisitSimplePats: path: SyntaxVisitorPath * pat: SynPat -> 'T option
+    default VisitSimplePats: path: SyntaxVisitorPath * pat: SynPat -> 'T option
 
     abstract VisitType:
         path: SyntaxVisitorPath * defaultTraverse: (SynType -> 'T option) * synType: SynType -> 'T option