Skip to content

Commit 1122aa6

Browse files
safesparrowsafesparrow
authored
Merge branch 'main' into otel
2 parents b71bf73 + 26bc85e commit 1122aa6

34 files changed

Lines changed: 439 additions & 49 deletions

‎src/Compiler/AbstractIL/il.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4629,7 +4629,7 @@ let rec encodeCustomAttrElemTypeForObject x =
46294629
| ILAttribElem.UInt64 _ -> [| et_U8 |]
46304630
| ILAttribElem.Type _ -> [| 0x50uy |]
46314631
| ILAttribElem.TypeRef _ -> [| 0x50uy |]
4632-
| ILAttribElem.Null _ -> [| et_STRING |] // yes, the 0xe prefix is used when passing a "null" to a property or argument of type "object" here
4632+
| ILAttribElem.Null -> [| et_STRING |] // yes, the 0xe prefix is used when passing a "null" to a property or argument of type "object" here
46334633
| ILAttribElem.Single _ -> [| et_R4 |]
46344634
| ILAttribElem.Double _ -> [| et_R8 |]
46354635
| ILAttribElem.Array (elemTy, _) -> [| yield et_SZARRAY; yield! encodeCustomAttrElemType elemTy |]

‎src/Compiler/AbstractIL/ilreflect.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -505,7 +505,7 @@ let convTypeRefAux (cenv: cenv) (tref: ILTypeRef) =
505505
match tref.Scope with
506506
| ILScopeRef.Assembly asmref -> convResolveAssemblyRef cenv asmref qualifiedName
507507
| ILScopeRef.Module _
508-
| ILScopeRef.Local _ ->
508+
| ILScopeRef.Local ->
509509
let typT = Type.GetType qualifiedName
510510

511511
match typT with

‎src/Compiler/Checking/CheckExpressions.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9905,7 +9905,7 @@ and TcMethodArg cenv env (lambdaPropagationInfo, tpenv) (lambdaPropagationInfoFo
99059905
let lambdaPropagationInfo =
99069906
[| for info, argInfo in Array.zip lambdaPropagationInfo lambdaPropagationInfoForArg do
99079907
match argInfo with
9908-
| ArgDoesNotMatch _ -> ()
9908+
| ArgDoesNotMatch -> ()
99099909
| NoInfo | CallerLambdaHasArgTypes _ ->
99109910
yield info
99119911
| CalledArgMatchesType (adjustedCalledArgTy, noEagerConstraintApplication) ->

‎src/Compiler/Checking/CheckPatterns.fs‎

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -604,7 +604,15 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m
604604

605605
let args, extraPatternsFromNames =
606606
match args with
607-
| SynArgPats.Pats args -> args, []
607+
| SynArgPats.Pats args ->
608+
if g.langVersion.SupportsFeature(LanguageFeature.MatchNotAllowedForUnionCaseWithNoData) then
609+
match args with
610+
| [ SynPat.Wild _ ] | [ SynPat.Named _ ] when argNames.IsEmpty ->
611+
warning(Error(FSComp.SR.matchNotAllowedForUnionCaseWithNoData(), m))
612+
args, []
613+
| _ -> args, []
614+
else
615+
args, []
608616
| SynArgPats.NamePatPairs (pairs, m, _) ->
609617
// rewrite patterns from the form (name-N = pat-N; ...) to (..._, pat-N, _...)
610618
// so type T = Case of name: int * value: int
@@ -661,10 +669,12 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m
661669
// note: we allow both 'C _' and 'C (_)' regardless of number of argument of the pattern
662670
| [SynPatErrorSkip(SynPat.Wild _ as e) | SynPatErrorSkip(SynPat.Paren(SynPatErrorSkip(SynPat.Wild _ as e), _))] -> List.replicate numArgTys e, []
663671

664-
665672
| args when numArgTys = 0 ->
666-
errorR (Error (FSComp.SR.tcUnionCaseDoesNotTakeArguments (), m))
667-
[], args
673+
if g.langVersion.SupportsFeature(LanguageFeature.MatchNotAllowedForUnionCaseWithNoData) then
674+
[], args
675+
else
676+
errorR (Error (FSComp.SR.tcUnionCaseDoesNotTakeArguments (), m))
677+
[], args
668678

669679
| arg :: rest when numArgTys = 1 ->
670680
if numArgTys = 1 && not (List.isEmpty rest) then

‎src/Compiler/Checking/PatternMatchCompilation.fs‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -648,9 +648,9 @@ let isDiscrimSubsumedBy g amap m discrim taken =
648648
match taken, discrim with
649649
| DecisionTreeTest.IsInst (_, tgtTy1), DecisionTreeTest.IsInst (_, tgtTy2) ->
650650
computeWhatFailingTypeTestImpliesAboutTypeTest g amap m tgtTy1 tgtTy2 = Implication.Fails
651-
| DecisionTreeTest.IsNull _, DecisionTreeTest.IsInst (_, tgtTy2) ->
651+
| DecisionTreeTest.IsNull, DecisionTreeTest.IsInst (_, tgtTy2) ->
652652
computeWhatFailingNullTestImpliesAboutTypeTest g tgtTy2 = Implication.Fails
653-
| DecisionTreeTest.IsInst (_, tgtTy1), DecisionTreeTest.IsNull _ ->
653+
| DecisionTreeTest.IsInst (_, tgtTy1), DecisionTreeTest.IsNull ->
654654
computeWhatFailingTypeTestImpliesAboutNullTest g tgtTy1 = Implication.Fails
655655
| _ ->
656656
false
@@ -690,15 +690,15 @@ let discrimWithinSimultaneousClass g amap m discrim prev =
690690
// Check that each previous test in the set, if successful, gives some information about this test
691691
prev |> List.forall (fun edge ->
692692
match edge with
693-
| DecisionTreeTest.IsNull _ -> true
693+
| DecisionTreeTest.IsNull -> true
694694
| DecisionTreeTest.IsInst (_, tgtTy1) -> computeWhatSuccessfulTypeTestImpliesAboutNullTest g tgtTy1 <> Implication.Nothing
695695
| _ -> false)
696696

697697
| DecisionTreeTest.IsInst (_, tgtTy2), _ ->
698698
// Check that each previous test in the set, if successful, gives some information about this test
699699
prev |> List.forall (fun edge ->
700700
match edge with
701-
| DecisionTreeTest.IsNull _ -> true
701+
| DecisionTreeTest.IsNull -> true
702702
| DecisionTreeTest.IsInst (_, tgtTy1) -> computeWhatSuccessfulTypeTestImpliesAboutTypeTest g amap m tgtTy1 tgtTy2 <> Implication.Nothing
703703
| _ -> false)
704704

@@ -1501,7 +1501,7 @@ let CompilePatternBasic
15011501
// F# exception definitions are sealed.
15021502
[]
15031503

1504-
| DecisionTreeTest.IsNull _ ->
1504+
| DecisionTreeTest.IsNull ->
15051505
match computeWhatSuccessfulNullTestImpliesAboutTypeTest g tgtTy1 with
15061506
| Implication.Succeeds -> [Frontier (i, newActives, valMap)]
15071507
| Implication.Fails -> []
@@ -1537,7 +1537,7 @@ let CompilePatternBasic
15371537
| Implication.Nothing ->
15381538
[frontier]
15391539

1540-
| DecisionTreeTest.IsNull _ ->
1540+
| DecisionTreeTest.IsNull ->
15411541
match computeWhatSuccessfulNullTestImpliesAboutTypeTest g tgtTy1 with
15421542
| Implication.Succeeds -> [Frontier (i, newActives, valMap)]
15431543
| Implication.Fails -> []

‎src/Compiler/Checking/PostInferenceChecks.fs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -685,7 +685,7 @@ let CheckTypeInstNoInnerByrefs cenv env m tyargs =
685685
/// Applied functions get wrapped in coerce nodes for subsumption coercions
686686
let (|OptionalCoerce|) expr =
687687
match stripDebugPoints expr with
688-
| Expr.Op (TOp.Coerce _, _, [DebugPoints(Expr.App (f, _, _, [], _), _)], _) -> f
688+
| Expr.Op (TOp.Coerce, _, [DebugPoints(Expr.App (f, _, _, [], _), _)], _) -> f
689689
| _ -> expr
690690

691691
/// Check an expression doesn't contain a 'reraise'
@@ -1539,7 +1539,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
15391539
else
15401540
{ scope = 1; flags = LimitFlags.None }
15411541

1542-
| TOp.LValueOp (LSet _, vref), _, [arg] ->
1542+
| TOp.LValueOp (LSet, vref), _, [arg] ->
15431543
let isVrefLimited = not (HasLimitFlag LimitFlags.StackReferringSpanLike (GetLimitVal cenv env m vref.Deref))
15441544
let isArgLimited = HasLimitFlag LimitFlags.StackReferringSpanLike (CheckExprPermitByRefLike cenv env arg)
15451545
if isVrefLimited && isArgLimited then
@@ -1901,7 +1901,7 @@ and CheckAttribArgExpr cenv env expr =
19011901
| Const.Double _
19021902
| Const.Single _
19031903
| Const.Char _
1904-
| Const.Zero _
1904+
| Const.Zero
19051905
| Const.String _ -> ()
19061906
| _ ->
19071907
if cenv.reportErrors then

‎src/Compiler/CodeGen/IlxGen.fs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4148,7 +4148,7 @@ and GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel =
41484148
| Expr.Val (v, _, m), _, [ arg ] when valRefEq g v g.methodhandleof_vref ->
41494149
let (|OptionalCoerce|) x =
41504150
match stripDebugPoints x with
4151-
| Expr.Op (TOp.Coerce _, _, [ arg ], _) -> arg
4151+
| Expr.Op (TOp.Coerce, _, [ arg ], _) -> arg
41524152
| x -> x
41534153

41544154
let (|OptionalTyapp|) x =
@@ -4693,7 +4693,7 @@ and eligibleForFilter (cenv: cenv) expr =
46934693
| Expr.Op (TOp.UnionCaseFieldGet _, _, _, _) -> true
46944694
| Expr.Op (TOp.ValFieldGet _, _, _, _) -> true
46954695
| Expr.Op (TOp.TupleFieldGet _, _, _, _) -> true
4696-
| Expr.Op (TOp.Coerce _, _, _, _) -> true
4696+
| Expr.Op (TOp.Coerce, _, _, _) -> true
46974697
| Expr.Val _ -> true
46984698
| _ -> false
46994699

@@ -7574,7 +7574,7 @@ and GenDecisionTreeSwitch
75747574

75757575
// Use GenDecisionTreeTest to generate a single test for null (when no box required) where the success
75767576
// is going to the immediate first node in the tree
7577-
| TCase (DecisionTreeTest.IsNull _, (TDSuccess ([], 0) as successTree)) :: rest when
7577+
| TCase (DecisionTreeTest.IsNull, (TDSuccess ([], 0) as successTree)) :: rest when
75787578
rest.Length = (match defaultTargetOpt with
75797579
| None -> 1
75807580
| Some _ -> 0)

‎src/Compiler/Driver/CompilerDiagnostics.fs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -240,6 +240,7 @@ type Exception with
240240
// 24 cannot be reused
241241
| PatternMatchCompilation.MatchIncomplete _ -> 25
242242
| PatternMatchCompilation.RuleNeverMatched _ -> 26
243+
243244
| ValNotMutable _ -> 27
244245
| ValNotLocal _ -> 28
245246
| MissingFields _ -> 29
@@ -1083,7 +1084,7 @@ type Exception with
10831084
| Parser.TOKEN_BAR_RBRACK -> SR.GetString("Parser.TOKEN.BAR.RBRACK")
10841085
| Parser.TOKEN_BAR_RBRACE -> SR.GetString("Parser.TOKEN.BAR.RBRACE")
10851086
| Parser.TOKEN_GREATER_RBRACK -> SR.GetString("Parser.TOKEN.GREATER.RBRACK")
1086-
| Parser.TOKEN_RQUOTE_DOT _
1087+
| Parser.TOKEN_RQUOTE_DOT
10871088
| Parser.TOKEN_RQUOTE -> SR.GetString("Parser.TOKEN.RQUOTE")
10881089
| Parser.TOKEN_RBRACK -> SR.GetString("Parser.TOKEN.RBRACK")
10891090
| Parser.TOKEN_RBRACE
@@ -1110,8 +1111,8 @@ type Exception with
11101111
| Parser.TOKEN_OTHEN -> SR.GetString("Parser.TOKEN.OTHEN")
11111112
| Parser.TOKEN_ELSE
11121113
| Parser.TOKEN_OELSE -> SR.GetString("Parser.TOKEN.OELSE")
1113-
| Parser.TOKEN_LET _
1114-
| Parser.TOKEN_OLET _ -> SR.GetString("Parser.TOKEN.OLET")
1114+
| Parser.TOKEN_LET
1115+
| Parser.TOKEN_OLET -> SR.GetString("Parser.TOKEN.OLET")
11151116
| Parser.TOKEN_OBINDER
11161117
| Parser.TOKEN_BINDER -> SR.GetString("Parser.TOKEN.BINDER")
11171118
| Parser.TOKEN_OAND_BANG

‎src/Compiler/FSComp.txt‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1554,6 +1554,7 @@ featureSelfTypeConstraints,"self type constraints"
15541554
featureRequiredProperties,"support for required properties"
15551555
featureInitProperties,"support for consuming init properties"
15561556
featureLowercaseDUWhenRequireQualifiedAccess,"Allow lowercase DU when RequireQualifiedAccess attribute"
1557+
featureMatchNotAllowedForUnionCaseWithNoData,"Pattern match discard is not allowed for union case that takes no data."
15571558
3353,fsiInvalidDirective,"Invalid directive '#%s %s'"
15581559
3354,tcNotAFunctionButIndexerNamedIndexingNotYetEnabled,"This value supports indexing, e.g. '%s.[index]'. The syntax '%s[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."
15591560
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"
16541655
3545,tcMissingRequiredMembers,"The following required properties have to be initalized:%s"
16551656
3546,parsExpectingPatternInTuple,"Expecting pattern"
16561657
3547,parsExpectedPatternAfterToken,"Expected a pattern after this point"
1658+
3548,matchNotAllowedForUnionCaseWithNoData,"Pattern discard is not allowed for union case that takes no data."

‎src/Compiler/Facilities/LanguageFeatures.fs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -54,6 +54,7 @@ type LanguageFeature =
5454
| LowercaseDUWhenRequireQualifiedAccess
5555
| InterfacesWithAbstractStaticMembers
5656
| SelfTypeConstraints
57+
| MatchNotAllowedForUnionCaseWithNoData
5758

5859
/// LanguageVersion management
5960
type LanguageVersion(versionText) =
@@ -124,6 +125,7 @@ type LanguageVersion(versionText) =
124125

125126
// F# preview
126127
LanguageFeature.FromEndSlicing, previewVersion
128+
LanguageFeature.MatchNotAllowedForUnionCaseWithNoData, previewVersion
127129
]
128130

129131
static let defaultLanguageVersion = LanguageVersion("default")
@@ -230,6 +232,7 @@ type LanguageVersion(versionText) =
230232
| LanguageFeature.LowercaseDUWhenRequireQualifiedAccess -> FSComp.SR.featureLowercaseDUWhenRequireQualifiedAccess ()
231233
| LanguageFeature.InterfacesWithAbstractStaticMembers -> FSComp.SR.featureInterfacesWithAbstractStaticMembers ()
232234
| LanguageFeature.SelfTypeConstraints -> FSComp.SR.featureSelfTypeConstraints ()
235+
| LanguageFeature.MatchNotAllowedForUnionCaseWithNoData -> FSComp.SR.featureMatchNotAllowedForUnionCaseWithNoData ()
233236

234237
/// Get a version string associated with the given feature.
235238
static member GetFeatureVersionString feature =

0 commit comments

Comments
 (0)