Pattern discard not allowed for union case that takes no data (#14055)

* Pattern discard not allowed for union case that takes no data

* Add test for grouped patterns discard

* Remove unnecesary use of wildcare across the compiler

* Format code

* Remove unnecesary wildcard on tests

* Update the warning logic

* Add warning behing preview flag

* More testing

* Add single-case unions when using them as a deconstruct syntax in functions

* Update FSComp.txt

Co-authored-by: Tomas Grosup <[email protected]>

Author: edgarfgp

src/Compiler/AbstractIL/il.fs

@@ -4629,7 +4629,7 @@ let rec encodeCustomAttrElemTypeForObject x =
     | ILAttribElem.UInt64 _ -> [| et_U8 |]
     | ILAttribElem.Type _ -> [| 0x50uy |]
     | ILAttribElem.TypeRef _ -> [| 0x50uy |]
-    | ILAttribElem.Null _ -> [| et_STRING |] // yes, the 0xe prefix is used when passing a "null" to a property or argument of type "object" here
+    | ILAttribElem.Null -> [| et_STRING |] // yes, the 0xe prefix is used when passing a "null" to a property or argument of type "object" here
     | ILAttribElem.Single _ -> [| et_R4 |]
     | ILAttribElem.Double _ -> [| et_R8 |]
     | ILAttribElem.Array (elemTy, _) -> [| yield et_SZARRAY; yield! encodeCustomAttrElemType elemTy |]

src/Compiler/AbstractIL/ilreflect.fs

@@ -505,7 +505,7 @@ let convTypeRefAux (cenv: cenv) (tref: ILTypeRef) =
     match tref.Scope with
     | ILScopeRef.Assembly asmref -> convResolveAssemblyRef cenv asmref qualifiedName
     | ILScopeRef.Module _
-    | ILScopeRef.Local _ ->
+    | ILScopeRef.Local ->
         let typT = Type.GetType qualifiedName
 
         match typT with

src/Compiler/Checking/CheckExpressions.fs

@@ -9905,7 +9905,7 @@ and TcMethodArg cenv env (lambdaPropagationInfo, tpenv) (lambdaPropagationInfoFo
     let lambdaPropagationInfo =
         [| for info, argInfo in Array.zip lambdaPropagationInfo lambdaPropagationInfoForArg do
               match argInfo with
-              | ArgDoesNotMatch _ -> ()
+              | ArgDoesNotMatch -> ()
               | NoInfo | CallerLambdaHasArgTypes _ ->
                   yield info
               | CalledArgMatchesType (adjustedCalledArgTy, noEagerConstraintApplication) ->

src/Compiler/Checking/CheckPatterns.fs

@@ -604,7 +604,15 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m
 
     let args, extraPatternsFromNames =
         match args with
-        | SynArgPats.Pats args -> args, []
+        | SynArgPats.Pats args ->
+            if g.langVersion.SupportsFeature(LanguageFeature.MatchNotAllowedForUnionCaseWithNoData) then
+                match args with
+                | [ SynPat.Wild _ ] | [ SynPat.Named _ ] when argNames.IsEmpty  ->
+                    warning(Error(FSComp.SR.matchNotAllowedForUnionCaseWithNoData(), m))
+                    args, []
+                | _ -> args, []
+            else
+                args, []
         | SynArgPats.NamePatPairs (pairs, m, _) ->
             // rewrite patterns from the form (name-N = pat-N; ...) to (..._, pat-N, _...)
             // so type T = Case of name: int * value: int
@@ -661,10 +669,12 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m
         // note: we allow both 'C _' and 'C (_)' regardless of number of argument of the pattern
         | [SynPatErrorSkip(SynPat.Wild _ as e) | SynPatErrorSkip(SynPat.Paren(SynPatErrorSkip(SynPat.Wild _ as e), _))] -> List.replicate numArgTys e, []
 
-
         | args when numArgTys = 0 ->
-            errorR (Error (FSComp.SR.tcUnionCaseDoesNotTakeArguments (), m))
-            [], args
+            if g.langVersion.SupportsFeature(LanguageFeature.MatchNotAllowedForUnionCaseWithNoData) then
+                [], args
+            else
+                errorR (Error (FSComp.SR.tcUnionCaseDoesNotTakeArguments (), m))
+                [], args
 
         | arg :: rest when numArgTys = 1 ->
             if numArgTys = 1 && not (List.isEmpty rest) then

src/Compiler/Checking/PatternMatchCompilation.fs

@@ -648,9 +648,9 @@ let isDiscrimSubsumedBy g amap m discrim taken =
     match taken, discrim with
     | DecisionTreeTest.IsInst (_, tgtTy1), DecisionTreeTest.IsInst (_, tgtTy2) ->
         computeWhatFailingTypeTestImpliesAboutTypeTest g amap m tgtTy1 tgtTy2 = Implication.Fails
-    | DecisionTreeTest.IsNull _, DecisionTreeTest.IsInst (_, tgtTy2) ->
+    | DecisionTreeTest.IsNull, DecisionTreeTest.IsInst (_, tgtTy2) ->
         computeWhatFailingNullTestImpliesAboutTypeTest g tgtTy2 = Implication.Fails
-    | DecisionTreeTest.IsInst (_, tgtTy1), DecisionTreeTest.IsNull _ ->
+    | DecisionTreeTest.IsInst (_, tgtTy1), DecisionTreeTest.IsNull ->
         computeWhatFailingTypeTestImpliesAboutNullTest g tgtTy1 = Implication.Fails
     | _ ->
         false
@@ -690,15 +690,15 @@ let discrimWithinSimultaneousClass g amap m discrim prev =
         // Check that each previous test in the set, if successful, gives some information about this test
         prev |> List.forall (fun edge -> 
             match edge with
-            | DecisionTreeTest.IsNull _ -> true
+            | DecisionTreeTest.IsNull -> true
             | DecisionTreeTest.IsInst (_, tgtTy1) -> computeWhatSuccessfulTypeTestImpliesAboutNullTest g tgtTy1 <> Implication.Nothing
             | _ -> false)
 
     | DecisionTreeTest.IsInst (_, tgtTy2), _ ->
         // Check that each previous test in the set, if successful, gives some information about this test
         prev |> List.forall (fun edge -> 
             match edge with
-            | DecisionTreeTest.IsNull _ -> true
+            | DecisionTreeTest.IsNull -> true
             | DecisionTreeTest.IsInst (_, tgtTy1) -> computeWhatSuccessfulTypeTestImpliesAboutTypeTest g amap m tgtTy1 tgtTy2 <> Implication.Nothing
             | _ -> false)
 
@@ -1501,7 +1501,7 @@ let CompilePatternBasic
                         // F# exception definitions are sealed.
                         []
 
-                | DecisionTreeTest.IsNull _ ->
+                | DecisionTreeTest.IsNull ->
                     match computeWhatSuccessfulNullTestImpliesAboutTypeTest g tgtTy1 with
                     | Implication.Succeeds -> [Frontier (i, newActives, valMap)]
                     | Implication.Fails -> []
@@ -1537,7 +1537,7 @@ let CompilePatternBasic
                     | Implication.Nothing ->
                         [frontier]
 
-                | DecisionTreeTest.IsNull _ ->
+                | DecisionTreeTest.IsNull ->
                     match computeWhatSuccessfulNullTestImpliesAboutTypeTest g tgtTy1 with
                     | Implication.Succeeds -> [Frontier (i, newActives, valMap)]
                     | Implication.Fails -> []

src/Compiler/Checking/PostInferenceChecks.fs

@@ -685,7 +685,7 @@ let CheckTypeInstNoInnerByrefs cenv env m tyargs =
 /// Applied functions get wrapped in coerce nodes for subsumption coercions
 let (|OptionalCoerce|) expr =  
     match stripDebugPoints expr with
-    | Expr.Op (TOp.Coerce _, _, [DebugPoints(Expr.App (f, _, _, [], _), _)], _) -> f 
+    | Expr.Op (TOp.Coerce, _, [DebugPoints(Expr.App (f, _, _, [], _), _)], _) -> f 
     | _ -> expr
 
 /// Check an expression doesn't contain a 'reraise'
@@ -1539,7 +1539,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
         else
             { scope = 1; flags = LimitFlags.None }
 
-    | TOp.LValueOp (LSet _, vref), _, [arg] -> 
+    | TOp.LValueOp (LSet, vref), _, [arg] -> 
         let isVrefLimited = not (HasLimitFlag LimitFlags.StackReferringSpanLike (GetLimitVal cenv env m vref.Deref))
         let isArgLimited = HasLimitFlag LimitFlags.StackReferringSpanLike (CheckExprPermitByRefLike cenv env arg)
         if isVrefLimited && isArgLimited then 
@@ -1901,7 +1901,7 @@ and CheckAttribArgExpr cenv env expr =
         | Const.Double _
         | Const.Single _
         | Const.Char _
-        | Const.Zero _
+        | Const.Zero
         | Const.String _  -> ()
         | _ -> 
             if cenv.reportErrors then 

src/Compiler/CodeGen/IlxGen.fs

@@ -4148,7 +4148,7 @@ and GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel =
     | Expr.Val (v, _, m), _, [ arg ] when valRefEq g v g.methodhandleof_vref ->
         let (|OptionalCoerce|) x =
             match stripDebugPoints x with
-            | Expr.Op (TOp.Coerce _, _, [ arg ], _) -> arg
+            | Expr.Op (TOp.Coerce, _, [ arg ], _) -> arg
             | x -> x
 
         let (|OptionalTyapp|) x =
@@ -4693,7 +4693,7 @@ and eligibleForFilter (cenv: cenv) expr =
         | Expr.Op (TOp.UnionCaseFieldGet _, _, _, _) -> true
         | Expr.Op (TOp.ValFieldGet _, _, _, _) -> true
         | Expr.Op (TOp.TupleFieldGet _, _, _, _) -> true
-        | Expr.Op (TOp.Coerce _, _, _, _) -> true
+        | Expr.Op (TOp.Coerce, _, _, _) -> true
         | Expr.Val _ -> true
         | _ -> false
 
@@ -7574,7 +7574,7 @@ and GenDecisionTreeSwitch
 
     // Use GenDecisionTreeTest to generate a single test for null (when no box required) where the success
     // is going to the immediate first node in the tree
-    | TCase (DecisionTreeTest.IsNull _, (TDSuccess ([], 0) as successTree)) :: rest when
+    | TCase (DecisionTreeTest.IsNull, (TDSuccess ([], 0) as successTree)) :: rest when
         rest.Length = (match defaultTargetOpt with
                        | None -> 1
                        | Some _ -> 0)

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -240,6 +240,7 @@ type Exception with
         // 24 cannot be reused
         | PatternMatchCompilation.MatchIncomplete _ -> 25
         | PatternMatchCompilation.RuleNeverMatched _ -> 26
+
         | ValNotMutable _ -> 27
         | ValNotLocal _ -> 28
         | MissingFields _ -> 29
@@ -1083,7 +1084,7 @@ type Exception with
                 | Parser.TOKEN_BAR_RBRACK -> SR.GetString("Parser.TOKEN.BAR.RBRACK")
                 | Parser.TOKEN_BAR_RBRACE -> SR.GetString("Parser.TOKEN.BAR.RBRACE")
                 | Parser.TOKEN_GREATER_RBRACK -> SR.GetString("Parser.TOKEN.GREATER.RBRACK")
-                | Parser.TOKEN_RQUOTE_DOT _
+                | Parser.TOKEN_RQUOTE_DOT
                 | Parser.TOKEN_RQUOTE -> SR.GetString("Parser.TOKEN.RQUOTE")
                 | Parser.TOKEN_RBRACK -> SR.GetString("Parser.TOKEN.RBRACK")
                 | Parser.TOKEN_RBRACE
@@ -1110,8 +1111,8 @@ type Exception with
                 | Parser.TOKEN_OTHEN -> SR.GetString("Parser.TOKEN.OTHEN")
                 | Parser.TOKEN_ELSE
                 | Parser.TOKEN_OELSE -> SR.GetString("Parser.TOKEN.OELSE")
-                | Parser.TOKEN_LET _
-                | Parser.TOKEN_OLET _ -> SR.GetString("Parser.TOKEN.OLET")
+                | Parser.TOKEN_LET
+                | Parser.TOKEN_OLET -> SR.GetString("Parser.TOKEN.OLET")
                 | Parser.TOKEN_OBINDER
                 | Parser.TOKEN_BINDER -> SR.GetString("Parser.TOKEN.BINDER")
                 | Parser.TOKEN_OAND_BANG

src/Compiler/FSComp.txt

@@ -1554,6 +1554,7 @@ featureSelfTypeConstraints,"self type constraints"
 featureRequiredProperties,"support for required properties"
 featureInitProperties,"support for consuming init properties"
 featureLowercaseDUWhenRequireQualifiedAccess,"Allow lowercase DU when RequireQualifiedAccess attribute"
+featureMatchNotAllowedForUnionCaseWithNoData,"Pattern match discard is not allowed for union case that takes no data."
 3353,fsiInvalidDirective,"Invalid directive '#%s %s'"
 3354,tcNotAFunctionButIndexerNamedIndexingNotYetEnabled,"This value supports indexing, e.g. '%s.[index]'. The syntax '%s[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."
 3354,tcNotAFunctionButIndexerIndexingNotYetEnabled,"This expression supports indexing, e.g. 'expr.[index]'. The syntax 'expr[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."
@@ -1654,3 +1655,4 @@ reprStateMachineInvalidForm,"The state machine has an unexpected form"
 3545,tcMissingRequiredMembers,"The following required properties have to be initalized:%s"
 3546,parsExpectingPatternInTuple,"Expecting pattern"
 3547,parsExpectedPatternAfterToken,"Expected a pattern after this point"
+3548,matchNotAllowedForUnionCaseWithNoData,"Pattern discard is not allowed for union case that takes no data."

src/Compiler/Facilities/LanguageFeatures.fs

@@ -54,6 +54,7 @@ type LanguageFeature =
     | LowercaseDUWhenRequireQualifiedAccess
     | InterfacesWithAbstractStaticMembers
     | SelfTypeConstraints
+    | MatchNotAllowedForUnionCaseWithNoData
 
 /// LanguageVersion management
 type LanguageVersion(versionText) =
@@ -124,6 +125,7 @@ type LanguageVersion(versionText) =
 
                 // F# preview
                 LanguageFeature.FromEndSlicing, previewVersion
+                LanguageFeature.MatchNotAllowedForUnionCaseWithNoData, previewVersion
             ]
 
     static let defaultLanguageVersion = LanguageVersion("default")
@@ -230,6 +232,7 @@ type LanguageVersion(versionText) =
         | LanguageFeature.LowercaseDUWhenRequireQualifiedAccess -> FSComp.SR.featureLowercaseDUWhenRequireQualifiedAccess ()
         | LanguageFeature.InterfacesWithAbstractStaticMembers -> FSComp.SR.featureInterfacesWithAbstractStaticMembers ()
         | LanguageFeature.SelfTypeConstraints -> FSComp.SR.featureSelfTypeConstraints ()
+        | LanguageFeature.MatchNotAllowedForUnionCaseWithNoData -> FSComp.SR.featureMatchNotAllowedForUnionCaseWithNoData ()
 
     /// Get a version string associated with the given feature.
     static member GetFeatureVersionString feature =