From c465043cee140fed5c1257b3b3a1aaaa16075ed1 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Fri, 15 Apr 2022 19:07:47 +0300 Subject: [PATCH] Remove getting needless list length --- src/fsharp/AugmentWithHashCompare.fs | 20 +++++++++++--- src/fsharp/CheckComputationExpressions.fs | 16 ++++++++---- src/fsharp/CheckDeclarations.fs | 9 ++++--- src/fsharp/CheckExpressions.fs | 5 ++-- src/fsharp/ConstraintSolver.fs | 10 ++++--- src/fsharp/MethodOverrides.fs | 2 +- src/fsharp/NameResolution.fs | 2 +- src/fsharp/Optimizer.fs | 2 +- src/fsharp/QuotationTranslator.fs | 2 +- src/fsharp/TypedTreeOps.fs | 32 ++++++++++++++--------- src/fsharp/infos.fs | 5 ++-- src/fsharp/symbols/Exprs.fs | 6 ++--- 12 files changed, 70 insertions(+), 41 deletions(-) diff --git a/src/fsharp/AugmentWithHashCompare.fs b/src/fsharp/AugmentWithHashCompare.fs index fd8a38a0d67..494eebacba3 100644 --- a/src/fsharp/AugmentWithHashCompare.fs +++ b/src/fsharp/AugmentWithHashCompare.fs @@ -377,7 +377,10 @@ let mkUnionCompare g tcref (tycon: Tycon) = mbuilder.Close(dtree, m, g.int_ty) let expr = - if ucases.Length = 1 then expr else + match ucases with + | [_] -> expr + | _ -> + let tagsEqTested = mkCond DebugPointAtBinding.NoneAtSticky m g.int_ty (mkILAsmCeq g m thistage thattage) @@ -438,7 +441,10 @@ let mkUnionCompareWithComparer g tcref (tycon: Tycon) (_thisv, thise) (_thatobjv mbuilder.Close(dtree, m, g.int_ty) let expr = - if ucases.Length = 1 then expr else + match ucases with + | [_] -> expr + | _ -> + let tagsEqTested = mkCond DebugPointAtBinding.NoneAtSticky m g.int_ty (mkILAsmCeq g m thistage thattage) @@ -498,7 +504,10 @@ let mkUnionEquality g tcref (tycon: Tycon) = mbuilder.Close(dtree, m, g.bool_ty) let expr = - if ucases.Length = 1 then expr else + match ucases with + | [_] -> expr + | _ -> + let tagsEqTested = mkCond DebugPointAtBinding.NoneAtSticky m g.bool_ty (mkILAsmCeq g m thistage thattage) @@ -560,7 +569,10 @@ let mkUnionEqualityWithComparer g tcref (tycon: Tycon) (_thisv, thise) thatobje mbuilder.Close(dtree, m, g.bool_ty) let expr = - if ucases.Length = 1 then expr else + match ucases with + | [_] -> expr + | _ -> + let tagsEqTested = mkCond DebugPointAtBinding.NoneAtSticky m g.bool_ty (mkILAsmCeq g m thistage thattage) diff --git a/src/fsharp/CheckComputationExpressions.fs b/src/fsharp/CheckComputationExpressions.fs index 621bd0f5e42..dba398db360 100644 --- a/src/fsharp/CheckComputationExpressions.fs +++ b/src/fsharp/CheckComputationExpressions.fs @@ -326,9 +326,15 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol |> dict /// Decide if the identifier represents a use of a custom query operator - let tryGetDataForCustomOperation (nm: Ident) = + let tryGetDataForCustomOperation (nm: Ident) = + let isOpDataCountAllowed opDatas = + match opDatas with + | [_] -> true + | _ :: _ -> cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations + | _ -> false + match customOperationMethodsIndexedByKeyword.TryGetValue nm.idText with - | true, opDatas when (opDatas.Length = 1 || (opDatas.Length > 0 && cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations)) -> + | true, opDatas when isOpDataCountAllowed opDatas -> for opData in opDatas do let opName, maintainsVarSpaceUsingBind, maintainsVarSpace, _allowInto, isLikeZip, isLikeJoin, isLikeGroupJoin, _joinConditionWord, methInfo = opData if (maintainsVarSpaceUsingBind && maintainsVarSpace) || (isLikeZip && isLikeJoin) || (isLikeZip && isLikeGroupJoin) || (isLikeJoin && isLikeGroupJoin) then @@ -1907,10 +1913,10 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = // // This transformation is visible in quotations and thus needs to remain. | (TPat_as (TPat_wild _, PBind (v, _), _), - vs, + [_], DebugPoints(Expr.App (Expr.Val (vf, _, _), _, [genEnumElemTy], [yieldExpr], _mYield), recreate)) - when vs.Length = 1 && valRefEq cenv.g vf cenv.g.seq_singleton_vref -> - + when valRefEq cenv.g vf cenv.g.seq_singleton_vref -> + // The debug point mFor is attached to the 'map' // The debug point mIn is attached to the lambda // Note: the 'yield' part of the debug point for 'yield expr' is currently lost in debug points. diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs index 888119cddb1..35d15e1ce17 100644 --- a/src/fsharp/CheckDeclarations.fs +++ b/src/fsharp/CheckDeclarations.fs @@ -4655,13 +4655,14 @@ 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 ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.NameEnv ad longPath resInfo PermitDirectReferenceToGeneratedType.No with - | Result res -> res - | res when inSig && longPath.Length = 1 -> + match res, inSig, longPath with + | Result res, _, _ -> res + | res, true, [_] -> errorR(Deprecated(FSComp.SR.tcReservedSyntaxForAugmentation(), m)) ForceRaise res - | res -> ForceRaise res + | res, _, _ -> ForceRaise res tcref let isInterfaceOrDelegateOrEnum = diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index f3cbaddab51..e2d09f84062 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -903,9 +903,10 @@ let TcFieldInit (_m: range) lit = ilFieldToTastConst lit // Adjust the arities that came from the parsing of the toptyp (arities) to be a valSynData. // This means replacing the "[unitArg]" arising from a "unit -> ty" with a "[]". let AdjustValSynInfoInSignature g ty (SynValInfo(argsData, retData) as sigMD) = - if argsData.Length = 1 && argsData.Head.Length = 1 && isFunTy g ty && typeEquiv g g.unit_ty (domainOfFunTy g ty) then + match argsData with + | [[_]] when isFunTy g ty && typeEquiv g g.unit_ty (domainOfFunTy g ty) -> SynValInfo(argsData.Head.Tail :: argsData.Tail, retData) - else + | _ -> sigMD /// The ValReprInfo for a value, except the number of typars is not yet inferred diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 931b2537375..1b5a9e4d743 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -1699,11 +1699,13 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | "?>=" | "?>" | "?<=" | "?<" | "?=" | "?<>" | ">=?" | ">?" | "<=?" | "?" | "?>=?" | "?>?" | "?<=?" | "??" -> - if tys.Length = 1 then FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, opName) - else FSComp.SR.csTypesDoNotSupportOperatorNullable(tyString, opName) + match tys with + | [_] -> FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, opName) + | _ -> FSComp.SR.csTypesDoNotSupportOperatorNullable(tyString, opName) | _ -> - if tys.Length = 1 then FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) - else FSComp.SR.csTypesDoNotSupportOperator(tyString, opName) + match tys with + | [_] -> FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) + | _ -> FSComp.SR.csTypesDoNotSupportOperator(tyString, opName) return! ErrorD(ConstraintSolverError(err, m, m2)) | _ -> diff --git a/src/fsharp/MethodOverrides.fs b/src/fsharp/MethodOverrides.fs index 5aab9f4f0f2..56d31c184de 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 = if vs.Length = 1 && argInfos.IsEmpty then [] else vs + let vs = match vs, argInfos with | [_], [] -> [] | _ -> vs let implKind = if isInterfaceTy g implty then CanImplementAnyInterfaceSlot diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index d77c6c11f41..6771695d870 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1246,7 +1246,7 @@ and private CanAutoOpenTyconRef (g: TcGlobals) m (tcref: TyconRef) = g.langVersion.SupportsFeature LanguageFeature.OpenTypeDeclaration && not tcref.IsILTycon && TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true && - tcref.Typars(m).Length = 0 + tcref.Typars(m) |> List.isEmpty /// Add any implied contents of a type definition to the environment. and private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap ad m nenv (tcref: TyconRef) = diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 2218204575d..4e5fb4312fa 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 (newExprs.Length = 1)); List.head newExprs) + [f], (fun newExprs -> (assert (match newExprs with [_] -> true | _ -> false)); List.head newExprs) match strip f0 with | [f], remake -> diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 11a0bf38b75..5f76d9bd930 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -722,7 +722,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | Some witnessArgIdx -> let witnessR = QP.mkVar witnessArgIdx - let args = if args.Length = 0 then [ mkUnit g m ] else args + let args = if List.isEmpty args then [ mkUnit g m ] else args let argsR = ConvExprs cenv env args (witnessR, argsR) ||> List.fold (fun fR argR -> QP.mkApp (fR, argR)) diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index f9c4c5c9a0b..13638405cc0 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -2851,7 +2851,7 @@ module SimplifyTypes = simplify && isTTyparCoercesToType tpc && Zset.contains tp singletons && - tp.Constraints.Length = 1) + match tp.Constraints with [_] -> true | _ -> false) let inplace = inplace |> List.map (function tp, TyparConstraint.CoercesTo(ty, _) -> tp, ty | _ -> failwith "not isTTyparCoercesToType") { singletons = singletons @@ -9269,23 +9269,29 @@ type Entity with tycon.TypeContents.tcaug_adhoc |> NameMultiMap.find nm |> List.exists (fun vref -> - match vref.MemberInfo with - | None -> false - | Some membInfo -> - let argInfos = ArgInfosOfMember g vref - argInfos.Length = 1 && - List.lengthsEqAndForall2 (typeEquiv g) (List.map fst (List.head argInfos)) argtys && - membInfo.MemberFlags.IsOverrideOrExplicitImpl) + match vref.MemberInfo with + | None -> false + | Some membInfo -> + + let argInfos = ArgInfosOfMember g vref + match argInfos with + | [argInfo] -> + List.lengthsEqAndForall2 (typeEquiv g) (List.map fst argInfo) argtys && + membInfo.MemberFlags.IsOverrideOrExplicitImpl + | _ -> false) member tycon.HasMember g nm argtys = tycon.TypeContents.tcaug_adhoc |> NameMultiMap.find nm |> List.exists (fun vref -> - match vref.MemberInfo with - | None -> false - | _ -> let argInfos = ArgInfosOfMember g vref - argInfos.Length = 1 && - List.lengthsEqAndForall2 (typeEquiv g) (List.map fst (List.head argInfos)) argtys) + match vref.MemberInfo with + | None -> false + | _ -> + + let argInfos = ArgInfosOfMember g vref + match argInfos with + | [argInfo] -> List.lengthsEqAndForall2 (typeEquiv g) (List.map fst argInfo) argtys + | _ -> false) type EntityRef with diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index 79c3688b8b1..45e40fcdaf9 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -2158,8 +2158,9 @@ type PropInfo = | FSProp(g, _, Some vref, _) -> // A getter has signature { OptionalObjectType } -> Unit -> PropertyType // A getter indexer has signature { OptionalObjectType } -> TupledIndexerArguments -> PropertyType - let arginfos = ArgInfosOfMember g vref - arginfos.Length = 1 && arginfos.Head.Length >= 1 + match ArgInfosOfMember g vref with + | [_ :: _] -> true + | _ -> false | FSProp(g, _, _, Some vref) -> // A setter has signature { OptionalObjectType } -> PropertyType -> Void // A setter indexer has signature { OptionalObjectType } -> TupledIndexerArguments -> PropertyType -> Void diff --git a/src/fsharp/symbols/Exprs.fs b/src/fsharp/symbols/Exprs.fs index 23613604258..ca1dd9818e6 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 with + match ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcValF g cenv.amap m tps tyargs, 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" && tyargs.Length = 1 -> [] - | res -> CommitOperationResult res + | ErrorResult _, [_] when vref.LogicalName = "op_LeftShift" -> [] + | res, _ -> CommitOperationResult res let env = { env with suppressWitnesses = true } witnessExprs |> List.map (fun arg -> match arg with