Merge main to release/dev17.5

.config/dotnet-tools.json

@@ -3,7 +3,7 @@
   "isRoot": true,
   "tools": {
     "fantomas": {
-      "version": "5.0.0-beta-005",
+      "version": "5.0.3",
       "commands": [
         "fantomas"
       ]

.fantomasignore

@@ -12,14 +12,79 @@ artifacts/
 
 # Explicitly unformatted implementation files
 
-src/Compiler/Checking/**/*.fs
-src/Compiler/DependencyManager/**/*.fs
-src/Compiler/Facilities/**/*.fs
-src/Compiler/Interactive/**/*.fs
-src/Compiler/Legacy/**/*.fs
-src/Compiler/Optimize/**/*.fs
-src/Compiler/Symbols/**/*.fs
-src/Compiler/TypedTree/**/*.fs
+src/Compiler/Checking/AccessibilityLogic.fs
+src/Compiler/Checking/AttributeChecking.fs
+src/Compiler/Checking/AugmentWithHashCompare.fs
+src/Compiler/Checking/CheckBasics.fs
+src/Compiler/Checking/CheckComputationExpressions.fs
+src/Compiler/Checking/CheckDeclarations.fs
+src/Compiler/Checking/CheckExpressions.fs
+src/Compiler/Checking/CheckFormatStrings.fs
+src/Compiler/Checking/CheckIncrementalClasses.fs
+src/Compiler/Checking/CheckPatterns.fs
+src/Compiler/Checking/ConstraintSolver.fs
+src/Compiler/Checking/FindUnsolved.fs
+src/Compiler/Checking/import.fs
+src/Compiler/Checking/InfoReader.fs
+src/Compiler/Checking/infos.fs
+src/Compiler/Checking/MethodCalls.fs
+src/Compiler/Checking/MethodOverrides.fs
+src/Compiler/Checking/NameResolution.fs
+src/Compiler/Checking/NicePrint.fs
+src/Compiler/Checking/PatternMatchCompilation.fs
+src/Compiler/Checking/PostInferenceChecks.fs
+src/Compiler/Checking/QuotationTranslator.fs
+src/Compiler/Checking/SignatureConformance.fs
+src/Compiler/Checking/TypeHierarchy.fs
+src/Compiler/Checking/TypeRelations.fs
+
+src/Compiler/DependencyManager/AssemblyResolveHandler.fs
+src/Compiler/DependencyManager/DependencyProvider.fs
+src/Compiler/DependencyManager/NativeDllResolveHandler.fs
+
+src/Compiler/Facilities/BuildGraph.fs
+src/Compiler/Facilities/CompilerLocation.fs
+src/Compiler/Facilities/DiagnosticOptions.fs
+src/Compiler/Facilities/DiagnosticResolutionHints.fs
+src/Compiler/Facilities/DiagnosticsLogger.fs
+src/Compiler/Facilities/LanguageFeatures.fs
+src/Compiler/Facilities/Logger.fs
+src/Compiler/Facilities/prim-lexing.fs
+src/Compiler/Facilities/prim-parsing.fs
+src/Compiler/Facilities/ReferenceResolver.fs
+src/Compiler/Facilities/SimulatedMSBuildReferenceResolver.fs
+src/Compiler/Facilities/TextLayoutRender.fs
+
+src/Compiler/Interactive/ControlledExecution.fs
+src/Compiler/Interactive/fsi.fs
+
+src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs
+src/Compiler/Legacy/LegacyMSBuildReferenceResolver.fs
+
+src/Compiler/Optimize/DetupleArgs.fs
+src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fs
+src/Compiler/Optimize/LowerCalls.fs
+src/Compiler/Optimize/LowerComputedCollections.fs
+src/Compiler/Optimize/LowerLocalMutables.fs
+src/Compiler/Optimize/LowerSequences.fs
+src/Compiler/Optimize/LowerStateMachines.fs
+src/Compiler/Optimize/Optimizer.fs
+
+src/Compiler/Symbols/Exprs.fs
+src/Compiler/Symbols/FSharpDiagnostic.fs
+src/Compiler/Symbols/SymbolHelpers.fs
+src/Compiler/Symbols/SymbolPatterns.fs
+src/Compiler/Symbols/Symbols.fs
+
+src/Compiler/TypedTree/CompilerGlobalState.fs
+src/Compiler/TypedTree/QuotationPickler.fs
+src/Compiler/TypedTree/tainted.fs
+src/Compiler/TypedTree/TcGlobals.fs
+src/Compiler/TypedTree/TypedTree.fs
+src/Compiler/TypedTree/TypedTreeBasics.fs
+src/Compiler/TypedTree/TypedTreeOps.fs
+src/Compiler/TypedTree/TypedTreePickle.fs
+src/Compiler/TypedTree/TypeProviders.fs
 
 # Explicitly unformatted file that needs more care to get it to format well
 

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

@@ -2840,9 +2840,7 @@ let ComputeDebugPointForBinding g bind =
         | DebugPointAtBinding.NoneAtDo, _ -> false, None
         | DebugPointAtBinding.NoneAtLet, _ -> false, None
         // Don't emit debug points for lambdas.
-        | _,
-          (Expr.Lambda _
-          | Expr.TyLambda _) -> false, None
+        | _, (Expr.Lambda _ | Expr.TyLambda _) -> false, None
         | DebugPointAtBinding.Yes m, _ -> false, Some m
 
 //-------------------------------------------------------------------------
@@ -4150,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 =
@@ -4695,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
 
@@ -5134,21 +5132,10 @@ and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel =
     // For these we can just generate the argument and change the test (from a brfalse to a brtrue and vice versa)
     | ([ AI_ceq ],
        [ arg1
-         Expr.Const ((Const.Bool false
-                     | Const.SByte 0y
-                     | Const.Int16 0s
-                     | Const.Int32 0
-                     | Const.Int64 0L
-                     | Const.Byte 0uy
-                     | Const.UInt16 0us
-                     | Const.UInt32 0u
-                     | Const.UInt64 0UL),
+         Expr.Const ((Const.Bool false | Const.SByte 0y | Const.Int16 0s | Const.Int32 0 | Const.Int64 0L | Const.Byte 0uy | Const.UInt16 0us | Const.UInt32 0u | Const.UInt64 0UL),
                      _,
                      _) ],
-       CmpThenBrOrContinue (1,
-                            [ I_brcmp ((BI_brfalse
-                                       | BI_brtrue) as bi,
-                                       label1) ]),
+       CmpThenBrOrContinue (1, [ I_brcmp ((BI_brfalse | BI_brtrue) as bi, label1) ]),
        _) ->
 
         let bi =
@@ -7587,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)
@@ -7903,9 +7890,7 @@ and GenDecisionTreeTest
             // If so, emit the failure logic, then came back and do the success target, then
             // do any postponed failure target.
             match successTree, failureTree with
-            | TDSuccess _,
-              (TDBind _
-              | TDSwitch _) ->
+            | TDSuccess _, (TDBind _ | TDSwitch _) ->
 
                 // OK, there is more logic in the decision tree on the failure branch
                 let success = CG.GenerateDelayMark cgbuf "testSuccess"
@@ -10641,10 +10626,9 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) =
                     | None -> None
                     | Some memberInfo ->
                         match name, memberInfo.MemberFlags.MemberKind with
-                        | ("Item"
-                          | "op_IndexedLookup"),
-                          (SynMemberKind.PropertyGet
-                          | SynMemberKind.PropertySet) when not (isNil (ArgInfosOfPropertyVal g vref.Deref)) ->
+                        | ("Item" | "op_IndexedLookup"), (SynMemberKind.PropertyGet | SynMemberKind.PropertySet) when
+                            not (isNil (ArgInfosOfPropertyVal g vref.Deref))
+                            ->
                             Some(
                                 mkILCustomAttribute (
                                     g.FindSysILTypeRef "System.Reflection.DefaultMemberAttribute",

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/Driver/ParseAndCheckInputs.fs

@@ -844,10 +844,7 @@ let ProcessMetaCommandsFromInput
             | ParsedHashDirective ("nowarn", ParsedHashDirectiveArguments numbers, m) ->
                 List.fold (fun state d -> nowarnF state (m, d)) state numbers
 
-            | ParsedHashDirective (("reference"
-                                   | "r"),
-                                   ParsedHashDirectiveArguments args,
-                                   m) ->
+            | ParsedHashDirective (("reference" | "r"), ParsedHashDirectiveArguments args, m) ->
                 matchedm <- m
                 ProcessDependencyManagerDirective Directive.Resolution args m state
 

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 =