Merge branch 'main' into reenable-tests-3

FSharp.Profiles.props

@@ -18,8 +18,8 @@
     <NullCheckingSupportInLibrary>false</NullCheckingSupportInLibrary>
   </PropertyGroup>
 
-  <PropertyGroup Condition="'$(Configuration)' != 'Proto' and '$(BUILDING_USING_DOTNET)' != 'true'"> 
-    <OtherFlags>$(OtherFlags) /langversion:preview</OtherFlags>
+  <PropertyGroup Condition="'$(Configuration)' != 'Proto' and '$(BUILDING_USING_DOTNET)' != 'true' and '$(MSBuildProjectExtension)' == '.fsproj'"> <!-- VB.NET does not understand "preview". It only knows "old","older" and "boomer" :-)) (jk)-->
+    <LangVersion>preview</LangVersion>
   </PropertyGroup>
 
   <PropertyGroup Condition="'$(BUILDING_USING_DOTNET)' == 'true'"> 

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

@@ -15,6 +15,7 @@
 * Deprecate places where `seq` can be omitted. ([Language suggestion #1033](https://github.com/fsharp/fslang-suggestions/issues/1033), [PR #17772](https://github.com/dotnet/fsharp/pull/17772))
 * Support literal attribute on decimals ([PR #17769](https://github.com/dotnet/fsharp/pull/17769))
 * Added type conversions cache, only enabled for compiler runs, guarded by language version preview ([PR#17668](https://github.com/dotnet/fsharp/pull/17668))
+* Added project property ParallelCompilation which turns on graph based type checking, parallel ILXGen and parallel optimization. By default on for users of langversion=preview ([PR#17948](https://github.com/dotnet/fsharp/pull/17948))
 
 ### Changed
 
@@ -27,6 +28,7 @@
 * Better ranges for CE `use` error reporting. ([PR #17811](https://github.com/dotnet/fsharp/pull/17811))
 * Better ranges for `inherit` error reporting. ([PR #17879](https://github.com/dotnet/fsharp/pull/17879))
 * Better ranges for `inherit` `struct` error reporting. ([PR #17886](https://github.com/dotnet/fsharp/pull/17886))
+* Warn on uppercase identifiers in patterns. ([PR #15816](https://github.com/dotnet/fsharp/pull/15816))
 * Better ranges for `inherit` objects error reporting. ([PR #17893](https://github.com/dotnet/fsharp/pull/17893))
 * Better ranges for #nowarn error reporting; bring back #nowarn warnings for --langVersion:80; add warnings under feature flag ([PR #17871](https://github.com/dotnet/fsharp/pull/17871))
 

docs/release-notes/.FSharp.Core/9.0.200.md

@@ -6,4 +6,4 @@
 
 ### Changed
 
-### Breaking Changes
+### Breaking Changes

docs/release-notes/.Language/preview.md

@@ -5,5 +5,6 @@
 * Added type conversions cache, only enabled for compiler runs ([PR#17668](https://github.com/dotnet/fsharp/pull/17668))
 
 ### Fixed
+* Warn on uppercase identifiers in patterns. ([PR #15816](https://github.com/dotnet/fsharp/pull/15816))
 
 ### Changed

src/Compiler/Checking/CheckPatterns.fs

@@ -58,10 +58,12 @@ let UnifyRefTupleType contextInfo (cenv: cenv) denv m ty ps =
     AddCxTypeEqualsType contextInfo denv cenv.css m ty (TType_tuple (tupInfoRef, ptys))
     ptys
 
-let rec TryAdjustHiddenVarNameToCompGenName cenv env (id: Ident) altNameRefCellOpt =
+let rec TryAdjustHiddenVarNameToCompGenName (cenv: cenv) env (id: Ident) altNameRefCellOpt =
     match altNameRefCellOpt with
     | Some ({contents = SynSimplePatAlternativeIdInfo.Undecided altId } as altNameRefCell) ->
-        match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver AllIdsOK false id.idRange env.eAccessRights env.eNameResEnv TypeNameResolutionInfo.Default [id] ExtraDotAfterIdentifier.No with
+        let supportsWarnOnUpperIdentifiersInPatterns = cenv.g.langVersion.SupportsFeature(LanguageFeature.DontWarnOnUppercaseIdentifiersInBindingPatterns)
+        let warnOnUpperFlag = if supportsWarnOnUpperIdentifiersInPatterns then WarnOnUpperVariablePatterns else AllIdsOK
+        match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver warnOnUpperFlag false id.idRange env.eAccessRights env.eNameResEnv TypeNameResolutionInfo.Default [id] ExtraDotAfterIdentifier.No with
         | Item.NewDef _ ->
             // The name is not in scope as a pattern identifier (e.g. union case), so do not use the alternate ID
             None
@@ -356,6 +358,12 @@ and TcPatNamedAs warnOnUpper cenv env valReprInfo vFlags patEnv ty synInnerPat i
 
 and TcPatUnnamedAs warnOnUpper cenv env vFlags patEnv ty pat1 pat2 m =
     let pats = [pat1; pat2]
+    let warnOnUpper =
+        if cenv.g.langVersion.SupportsFeature(LanguageFeature.DontWarnOnUppercaseIdentifiersInBindingPatterns) then
+            AllIdsOK
+        else
+            warnOnUpper
+
     let patsR, patEnvR = TcPatterns warnOnUpper cenv env vFlags patEnv (List.map (fun _ -> ty) pats) pats
     let phase2 values = TPat_conjs(List.map (fun f -> f values) patsR, m)
     phase2, patEnvR
@@ -441,7 +449,7 @@ and TcPatArrayOrList warnOnUpper cenv env vFlags patEnv ty isArray args m =
         else List.foldBack (mkConsListPat g argTy) argsR (mkNilListPat g m argTy)
     phase2, acc
 
-and TcRecordPat warnOnUpper cenv env vFlags patEnv ty fieldPats m =
+and TcRecordPat warnOnUpper (cenv: cenv) env vFlags patEnv ty fieldPats m =
     let fieldPats = fieldPats |> List.map (fun (fieldId, _, fieldPat) -> fieldId, fieldPat)
     match BuildFieldMap cenv env false ty fieldPats m with
     | None -> (fun _ -> TPat_error m), patEnv
@@ -458,7 +466,13 @@ and TcRecordPat warnOnUpper cenv env vFlags patEnv ty fieldPats m =
     let fieldPats, patEnvR =
         (patEnv, ftys) ||> List.mapFold (fun s (ty, fsp) ->
             match fldsmap.TryGetValue fsp.rfield_id.idText with
-            | true, v -> TcPat warnOnUpper cenv env None vFlags s ty v
+            | true, v ->
+                let warnOnUpper =
+                    if cenv.g.langVersion.SupportsFeature(LanguageFeature.DontWarnOnUppercaseIdentifiersInBindingPatterns) then
+                        AllIdsOK
+                    else
+                        warnOnUpper
+                TcPat warnOnUpper cenv env None vFlags s ty v
             | _ -> (fun _ -> TPat_wild m), s)
 
     let phase2 values =

src/Compiler/Checking/Expressions/CheckComputationExpressions.fs

@@ -982,7 +982,7 @@ let rec TryTranslateComputationExpression
                         use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                         let _, _, vspecs, envinner, _ =
-                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv firstSourcePat None
+                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv firstSourcePat None TcTrueMatchClause.No
 
                         vspecs, envinner)
 
@@ -991,7 +991,7 @@ let rec TryTranslateComputationExpression
                         use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                         let _, _, vspecs, envinner, _ =
-                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv secondSourcePat None
+                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv secondSourcePat None TcTrueMatchClause.No
 
                         vspecs, envinner)
 
@@ -1002,7 +1002,7 @@ let rec TryTranslateComputationExpression
                             use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                             let _, _, vspecs, envinner, _ =
-                                TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat3 None
+                                TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat3 None TcTrueMatchClause.No
 
                             vspecs, envinner)
                     | None -> varSpace
@@ -1231,7 +1231,7 @@ let rec TryTranslateComputationExpression
                     use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                     let _, _, vspecs, envinner, _ =
-                        TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None
+                        TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None TcTrueMatchClause.No
 
                     vspecs, envinner)
 
@@ -1789,7 +1789,7 @@ let rec TryTranslateComputationExpression
                         use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                         let _, _, vspecs, envinner, _ =
-                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None
+                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None TcTrueMatchClause.No
 
                         vspecs, envinner
                     | _ ->
@@ -1873,7 +1873,7 @@ let rec TryTranslateComputationExpression
                     use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                     let _, _, vspecs, envinner, _ =
-                        TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None
+                        TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None TcTrueMatchClause.No
 
                     vspecs, envinner)
 
@@ -2066,7 +2066,7 @@ let rec TryTranslateComputationExpression
                         use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                         let _, _, vspecs, envinner, _ =
-                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None
+                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None TcTrueMatchClause.No
 
                         vspecs, envinner)
 
@@ -2111,7 +2111,7 @@ let rec TryTranslateComputationExpression
                             use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                             let _, _, vspecs, envinner, _ =
-                                TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None
+                                TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None TcTrueMatchClause.No
 
                             vspecs, envinner)
 
@@ -2239,7 +2239,7 @@ let rec TryTranslateComputationExpression
                             use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                             let _, _, vspecs, envinner, _ =
-                                TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None
+                                TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None TcTrueMatchClause.No
 
                             vspecs, envinner)
 

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -1017,6 +1017,12 @@ type TcCanFail =
     | IgnoreMemberResoutionError
     | IgnoreAllErrors
     | ReportAllErrors
+
+[<RequireQualifiedAccess>]
+[<Struct>]
+type TcTrueMatchClause =
+    | Yes
+    | No
 
 let TcAddNullnessToType (warn: bool) (cenv: cenv) (env: TcEnv) nullness innerTyC m =
     let g = cenv.g
@@ -2516,8 +2522,12 @@ module BindingNormalization =
                 match memberFlagsOpt with
                 | None ->
                     let extraDot = if synLongId.ThereIsAnExtraDotAtTheEnd then ExtraDotAfterIdentifier.Yes else ExtraDotAfterIdentifier.No
-
-                    match ResolvePatternLongIdent cenv.tcSink nameResolver AllIdsOK true m ad env.NameEnv TypeNameResolutionInfo.Default longId extraDot with
+                    let warnOnUpper =
+                        if not args.IsEmpty then
+                            WarnOnUpperUnionCaseLabel
+                        else AllIdsOK  
+
+                    match ResolvePatternLongIdent cenv.tcSink nameResolver warnOnUpper true m ad env.NameEnv TypeNameResolutionInfo.Default longId extraDot with
                     | Item.NewDef id ->
                         if id.idText = opNameCons then
                             NormalizedBindingPat(pat, rhsExpr, valSynData, typars)
@@ -6423,10 +6433,8 @@ and TcExprILAssembly (cenv: cenv) overallTy env tpenv (ilInstrs, synTyArgs, synA
 and TcIteratedLambdas (cenv: cenv) isFirst (env: TcEnv) overallTy takenNames tpenv e =
     let g = cenv.g
     match e with
-    | SynExpr.Lambda (isMember, isSubsequent, synSimplePats, bodyExpr, _, m, _) when isMember || isFirst || isSubsequent ->
-
+    | SynExpr.Lambda (isMember, isSubsequent, synSimplePats, bodyExpr, _parsedData, m, _trivia) when isMember || isFirst || isSubsequent ->
         let domainTy, resultTy = UnifyFunctionType None cenv env.DisplayEnv m overallTy.Commit
-
         let vs, (TcPatLinearEnv (tpenv, names, takenNames)) =
             cenv.TcSimplePats cenv isMember CheckCxs domainTy env (TcPatLinearEnv (tpenv, Map.empty, takenNames)) synSimplePats
 
@@ -8072,7 +8080,7 @@ and TcForEachExpr cenv overallTy env tpenv (seqExprOnly, isFromSource, synPat, s
 
     let pat, _, vspecs, envinner, tpenv =
         let env = { env with eIsControlFlow = false }
-        TcMatchPattern cenv enumElemTy env tpenv synPat None
+        TcMatchPattern cenv enumElemTy env tpenv synPat None TcTrueMatchClause.No
 
     let elemVar, pat =
         // nice: don't introduce awful temporary for r.h.s. in the 99% case where we know what we're binding it to
@@ -10602,10 +10610,15 @@ and TcAndPatternCompileMatchClauses mExpr mMatch actionOnFailure cenv inputExprO
     let matchVal, expr = CompilePatternForMatchClauses cenv env mExpr mMatch true actionOnFailure inputExprOpt inputTy resultTy.Commit clauses
     matchVal, expr, tpenv
 
-and TcMatchPattern cenv inputTy env tpenv (synPat: SynPat) (synWhenExprOpt: SynExpr option) =
+and TcMatchPattern (cenv: cenv) inputTy env tpenv (synPat: SynPat) (synWhenExprOpt: SynExpr option) (tcTrueMatchClause: TcTrueMatchClause) =
     let g = cenv.g
     let m = synPat.Range
-    let patf', (TcPatLinearEnv (tpenv, names, _)) = cenv.TcPat WarnOnUpperCase cenv env None (TcPatValFlags (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, false)) (TcPatLinearEnv (tpenv, Map.empty, Set.empty)) inputTy synPat
+    let warnOnUpperFlag =
+        match tcTrueMatchClause with
+        | TcTrueMatchClause.Yes -> WarnOnUpperUnionCaseLabel
+        | TcTrueMatchClause.No -> WarnOnUpperVariablePatterns
+
+    let patf', (TcPatLinearEnv (tpenv, names, _)) = cenv.TcPat warnOnUpperFlag cenv env None (TcPatValFlags (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, false)) (TcPatLinearEnv (tpenv, Map.empty, Set.empty)) inputTy synPat
     let envinner, values, vspecMap = MakeAndPublishSimpleValsForMergedScope cenv env m names
 
     let whenExprOpt, tpenv =
@@ -10626,9 +10639,15 @@ and TcMatchClauses cenv inputTy (resultTy: OverallTy) env tpenv clauses =
     resultList,tpEnv
 
 and TcMatchClause cenv inputTy (resultTy: OverallTy) env isFirst tpenv synMatchClause =
-    let (SynMatchClause(synPat, synWhenExprOpt, synResultExpr, patm, spTgt, _)) = synMatchClause
+    let (SynMatchClause(synPat, synWhenExprOpt, synResultExpr, patm, spTgt, trivia)) = synMatchClause
 
-    let pat, whenExprOpt, vspecs, envinner, tpenv = TcMatchPattern cenv inputTy env tpenv synPat synWhenExprOpt
+    let isTrueMatchClause =
+        if synMatchClause.IsTrueMatchClause then
+            TcTrueMatchClause.Yes
+        else
+            TcTrueMatchClause.No
+
+    let pat, whenExprOpt, vspecs, envinner, tpenv = TcMatchPattern cenv inputTy env tpenv synPat synWhenExprOpt isTrueMatchClause
 
     let resultEnv =
         if isFirst then envinner

src/Compiler/Checking/Expressions/CheckExpressions.fsi

@@ -351,6 +351,13 @@ type TcCanFail =
     | IgnoreAllErrors
     | ReportAllErrors
 
+/// Represents a pattern  that is used in a true match clause e.g. | pat -> expr
+[<RequireQualifiedAccess>]
+[<Struct>]
+type TcTrueMatchClause =
+    | Yes
+    | No
+
 /// Represents a recursive binding after it has been both checked and generalized, but
 /// before initialization recursion has been rewritten
 type PreInitializationGraphEliminationBinding =
@@ -703,6 +710,7 @@ val TcMatchPattern:
     tpenv: UnscopedTyparEnv ->
     synPat: SynPat ->
     synWhenExprOpt: SynExpr option ->
+    tcTrueMatchClause: TcTrueMatchClause ->
         Pattern * Expr option * Val list * TcEnv * UnscopedTyparEnv
 
 [<return: Struct>]

src/Compiler/Checking/Expressions/CheckSequenceExpressions.fs

@@ -59,7 +59,7 @@ let TcSequenceExpression (cenv: TcFileState) env tpenv comp (overallTy: OverallT
                 ConvertArbitraryExprToEnumerable cenv arbitraryTy env pseudoEnumExpr
 
             let patR, _, vspecs, envinner, tpenv =
-                TcMatchPattern cenv enumElemTy env tpenv pat None
+                TcMatchPattern cenv enumElemTy env tpenv pat None TcTrueMatchClause.No
 
             let innerExpr, tpenv =
                 let envinner = { envinner with eIsControlFlow = true }
@@ -241,7 +241,7 @@ let TcSequenceExpression (cenv: TcFileState) env tpenv comp (overallTy: OverallT
             let inputExprTy = NewInferenceType g
 
             let pat', _, vspecs, envinner, tpenv =
-                TcMatchPattern cenv bindPatTy env tpenv pat None
+                TcMatchPattern cenv bindPatTy env tpenv pat None TcTrueMatchClause.No
 
             UnifyTypes cenv env m inputExprTy bindPatTy
 
@@ -270,9 +270,15 @@ let TcSequenceExpression (cenv: TcFileState) env tpenv comp (overallTy: OverallT
 
             let tclauses, tpenv =
                 (tpenv, clauses)
-                ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, _, sp, _)) ->
+                ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, _, sp, trivia) as clause) ->
+                    let isTrueMatchClause =
+                        if clause.IsTrueMatchClause then
+                            TcTrueMatchClause.Yes
+                        else
+                            TcTrueMatchClause.No
+
                     let patR, condR, vspecs, envinner, tpenv =
-                        TcMatchPattern cenv inputTy env tpenv pat cond
+                        TcMatchPattern cenv inputTy env tpenv pat cond isTrueMatchClause
 
                     let envinner =
                         match sp with
@@ -313,9 +319,15 @@ let TcSequenceExpression (cenv: TcFileState) env tpenv comp (overallTy: OverallT
             // Compile the pattern twice, once as a filter with all succeeding targets returning "1", and once as a proper catch block.
             let clauses, tpenv =
                 (tpenv, withList)
-                ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, m, sp, _)) ->
+                ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, m, sp, trivia) as clause) ->
+                    let isTrueMatchClause =
+                        if clause.IsTrueMatchClause then
+                            TcTrueMatchClause.Yes
+                        else
+                            TcTrueMatchClause.No
+
                     let patR, condR, vspecs, envinner, tpenv =
-                        TcMatchPattern cenv g.exn_ty env tpenv pat cond
+                        TcMatchPattern cenv g.exn_ty env tpenv pat cond isTrueMatchClause
 
                     let envinner =
                         match sp with