diff --git a/src/fsharp/AugmentWithHashCompare.fs b/src/fsharp/AugmentWithHashCompare.fs index 494eebacba34..a2fa331ca82d 100644 --- a/src/fsharp/AugmentWithHashCompare.fs +++ b/src/fsharp/AugmentWithHashCompare.fs @@ -376,10 +376,8 @@ let mkUnionCompare g tcref (tycon: Tycon) = let dtree = TDSwitch(thise, cases, dflt, m) mbuilder.Close(dtree, m, g.int_ty) - let expr = - match ucases with - | [_] -> expr - | _ -> + let expr = + if List.isSingleItem ucases then expr else let tagsEqTested = mkCond DebugPointAtBinding.NoneAtSticky m g.int_ty @@ -440,10 +438,8 @@ let mkUnionCompareWithComparer g tcref (tycon: Tycon) (_thisv, thise) (_thatobjv let dtree = TDSwitch(thise, cases, dflt, m) mbuilder.Close(dtree, m, g.int_ty) - let expr = - match ucases with - | [_] -> expr - | _ -> + let expr = + if List.isSingleItem ucases then expr else let tagsEqTested = mkCond DebugPointAtBinding.NoneAtSticky m g.int_ty @@ -503,10 +499,8 @@ let mkUnionEquality g tcref (tycon: Tycon) = let dtree = TDSwitch(thise, cases, dflt, m) mbuilder.Close(dtree, m, g.bool_ty) - let expr = - match ucases with - | [_] -> expr - | _ -> + let expr = + if List.isSingleItem ucases then expr else let tagsEqTested = mkCond DebugPointAtBinding.NoneAtSticky m g.bool_ty @@ -568,10 +562,8 @@ let mkUnionEqualityWithComparer g tcref (tycon: Tycon) (_thisv, thise) thatobje let dtree = TDSwitch(thise, cases, dflt, m) mbuilder.Close(dtree, m, g.bool_ty) - let expr = - match ucases with - | [_] -> expr - | _ -> + let expr = + if List.isSingleItem ucases then expr else let tagsEqTested = mkCond DebugPointAtBinding.NoneAtSticky m g.bool_ty diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs index 35d15e1ce171..0bc7a68a535c 100644 --- a/src/fsharp/CheckDeclarations.fs +++ b/src/fsharp/CheckDeclarations.fs @@ -4655,14 +4655,13 @@ module TcDeclarations = | _ -> let resInfo = TypeNameResolutionStaticArgsInfo.FromTyArgs synTypars.Length - let res = ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.NameEnv ad longPath resInfo PermitDirectReferenceToGeneratedType.No let _, tcref = - match res, inSig, longPath with - | Result res, _, _ -> res - | res, true, [_] -> + match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.NameEnv ad longPath resInfo PermitDirectReferenceToGeneratedType.No with + | Result res -> res + | res when inSig && List.isSingleItem longPath -> errorR(Deprecated(FSComp.SR.tcReservedSyntaxForAugmentation(), m)) ForceRaise res - | res, _, _ -> ForceRaise res + | res -> ForceRaise res tcref let isInterfaceOrDelegateOrEnum = diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 1b5a9e4d743b..d7d45dac3f68 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -1699,13 +1699,11 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | "?>=" | "?>" | "?<=" | "?<" | "?=" | "?<>" | ">=?" | ">?" | "<=?" | "?" | "?>=?" | "?>?" | "?<=?" | "??" -> - match tys with - | [_] -> FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, opName) - | _ -> FSComp.SR.csTypesDoNotSupportOperatorNullable(tyString, opName) - | _ -> - match tys with - | [_] -> FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) - | _ -> FSComp.SR.csTypesDoNotSupportOperator(tyString, opName) + if List.isSingleItem tys then FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, opName) + else FSComp.SR.csTypesDoNotSupportOperatorNullable(tyString, opName) + | _ -> + if List.isSingleItem tys then FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) + else FSComp.SR.csTypesDoNotSupportOperator(tyString, opName) return! ErrorD(ConstraintSolverError(err, m, m2)) | _ -> diff --git a/src/fsharp/MethodOverrides.fs b/src/fsharp/MethodOverrides.fs index 56d31c184dec..f7db203c1b59 100644 --- a/src/fsharp/MethodOverrides.fs +++ b/src/fsharp/MethodOverrides.fs @@ -164,7 +164,7 @@ module DispatchSlotChecking = match vsl with | [thisv] :: vs -> // Check for empty variable list from a () arg - let vs = match vs, argInfos with | [_], [] -> [] | _ -> vs + let vs = if List.isSingleItem vs && argInfos.IsEmpty then [] else vs let implKind = if isInterfaceTy g implty then CanImplementAnyInterfaceSlot diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 4e5fb4312fac..c35033cf8135 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -3314,7 +3314,7 @@ and StripPreComputationsFromComputedFunction g f0 args mkApp = fs, (remake >> (fun innerExprR -> Expr.DebugPoint (dp, innerExprR))) | _ -> - [f], (fun newExprs -> (assert (match newExprs with [_] -> true | _ -> false)); List.head newExprs) + [f], (fun newExprs -> (assert (List.isSingleItem newExprs)); List.head newExprs) match strip f0 with | [f], remake -> diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 13638405cc05..4d78510470bc 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -2851,7 +2851,7 @@ module SimplifyTypes = simplify && isTTyparCoercesToType tpc && Zset.contains tp singletons && - match tp.Constraints with [_] -> true | _ -> false) + List.isSingleItem tp.Constraints) let inplace = inplace |> List.map (function tp, TyparConstraint.CoercesTo(ty, _) -> tp, ty | _ -> failwith "not isTTyparCoercesToType") { singletons = singletons @@ -9275,8 +9275,8 @@ type Entity with let argInfos = ArgInfosOfMember g vref match argInfos with - | [argInfo] -> - List.lengthsEqAndForall2 (typeEquiv g) (List.map fst argInfo) argtys && + | [argInfos] -> + List.lengthsEqAndForall2 (typeEquiv g) (List.map fst argInfos) argtys && membInfo.MemberFlags.IsOverrideOrExplicitImpl | _ -> false) @@ -9290,7 +9290,7 @@ type Entity with let argInfos = ArgInfosOfMember g vref match argInfos with - | [argInfo] -> List.lengthsEqAndForall2 (typeEquiv g) (List.map fst argInfo) argtys + | [argInfos] -> List.lengthsEqAndForall2 (typeEquiv g) (List.map fst argInfos) argtys | _ -> false) diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index 999c677859b1..cc31aa064414 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -473,6 +473,11 @@ module List = | [] -> true | h::t -> t |> List.forall (fun h2 -> h = h2) + let isSingleItem l = + match l with + | [_] -> true + | _ -> false + module ResizeArray = /// Split a ResizeArray into an array of smaller chunks. diff --git a/src/fsharp/absil/illib.fsi b/src/fsharp/absil/illib.fsi index b9f86798fd2c..3c8894347546 100644 --- a/src/fsharp/absil/illib.fsi +++ b/src/fsharp/absil/illib.fsi @@ -206,6 +206,8 @@ module internal List = val internal allEqual: xs:'T list -> bool when 'T: equality + val isSingleItem: xs: 'T list -> bool + module internal ResizeArray = /// Split a ResizeArray into an array of smaller chunks. diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index 45e40fcdaf95..b2e1e4fe3240 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -2159,7 +2159,7 @@ type PropInfo = // A getter has signature { OptionalObjectType } -> Unit -> PropertyType // A getter indexer has signature { OptionalObjectType } -> TupledIndexerArguments -> PropertyType match ArgInfosOfMember g vref with - | [_ :: _] -> true + | [argInfos] -> not (List.isEmpty argInfos) | _ -> false | FSProp(g, _, _, Some vref) -> // A setter has signature { OptionalObjectType } -> PropertyType -> Void diff --git a/src/fsharp/symbols/Exprs.fs b/src/fsharp/symbols/Exprs.fs index ca1dd9818e61..709231f2412b 100644 --- a/src/fsharp/symbols/Exprs.fs +++ b/src/fsharp/symbols/Exprs.fs @@ -512,13 +512,13 @@ module FSharpExprConvert = let g = cenv.g if g.langVersion.SupportsFeature(Features.LanguageFeature.WitnessPassing) && not env.suppressWitnesses then let witnessExprs = - match ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcValF g cenv.amap m tps tyargs, tyargs with + match ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcValF g cenv.amap m tps tyargs with // There is a case where optimized code makes expressions that do a shift-left on the 'char' // type. There is no witness for this case. This is due to the code // let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #) // in FSharp.Core. - | ErrorResult _, [_] when vref.LogicalName = "op_LeftShift" -> [] - | res, _ -> CommitOperationResult res + | ErrorResult _ when vref.LogicalName = "op_LeftShift" && List.isSingleItem tyargs -> [] + | res -> CommitOperationResult res let env = { env with suppressWitnesses = true } witnessExprs |> List.map (fun arg -> match arg with