Don't call length if not needed (#2989)

* Don't call length if not needed

* Use hasLengthGreaterThen

* Use isNilOrSingleton

* Use isNilOrSingleton

* no double negations are not bad

src/absil/illib.fs

@@ -23,6 +23,20 @@ let (>>>&) (x:int32) (n:int32) = int32 (uint32 x >>> n)
 let notlazy v = Lazy<_>.CreateFromValue v
 
 let inline isNil l = List.isEmpty l
+
+/// Returns true if the list has less than 2 elements. Otherwise false.
+let inline isNilOrSingleton l =
+    match l with
+    | [] 
+    | [_] -> true
+    | _ -> false
+
+/// Returns true if the list contains exactly 1 element. Otherwise false.
+let inline isSingleton l =
+    match l with
+    | [_] -> true
+    | _ -> false
+
 let inline isNonNull x = not (isNull x)
 let inline nonNull msg x = if isNull x then failwith ("null: " ^ msg) else x
 let (===) x y = LanguagePrimitives.PhysicalEquality x y

src/absil/ilreflect.fs

@@ -301,7 +301,7 @@ module Zmap =
     let force x m str = match Zmap.tryFind x m with Some y -> y | None -> failwithf "Zmap.force: %s: x = %+A" str x
 
 let equalTypes (s:Type) (t:Type) = s.Equals(t)
-let equalTypeLists ss tt =  List.lengthsEqAndForall2 equalTypes ss tt
+let equalTypeLists ss tt = List.lengthsEqAndForall2 equalTypes ss tt
 
 let getGenericArgumentsOfType (typT : Type) = 
     if typT.IsGenericType   then typT.GetGenericArguments() else [| |]

src/fsharp/IlxGen.fs

@@ -4383,7 +4383,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau
         | DecisionTreeTest.ArrayLength _
         | DecisionTreeTest.IsNull 
         | DecisionTreeTest.Const(Const.Zero) -> 
-            if List.length cases <> 1 || Option.isNone defaultTargetOpt then failwith "internal error: GenDecisionTreeSwitch: DecisionTreeTest.IsInst/isnull/query"
+            if not (isSingleton cases) || Option.isNone defaultTargetOpt then failwith "internal error: GenDecisionTreeSwitch: DecisionTreeTest.IsInst/isnull/query"
             let bi = 
               match firstDiscrim with 
               | DecisionTreeTest.Const(Const.Zero) ->
@@ -6808,7 +6808,7 @@ and GenExnDef cenv mgbuf eenv m (exnc:Tycon) =
 
 
 let CodegenAssembly cenv eenv mgbuf fileImpls = 
-    if List.length fileImpls > 0 then 
+    if not (isNil fileImpls) then 
       let a,b = List.frontAndBack fileImpls
       let eenv = List.fold (GenTopImpl cenv mgbuf None) eenv a
       let _eenv = GenTopImpl cenv mgbuf cenv.opts.mainMethodInfo eenv b

src/fsharp/MethodOverrides.fs

@@ -305,12 +305,13 @@ module DispatchSlotChecking =
                         | [] -> 
                             noimpl()
                         | [ Override(_,_,_,(mtps,_),argTys,_,_,_) as overrideBy ] ->
-                            let possibleDispatchSlots =
+                            let moreThanOnePossibleDispatchSlot =
                                 dispatchSlots
                                 |> List.filter (fun (RequiredSlot(dispatchSlot,_)) -> IsNameMatch dispatchSlot overrideBy && IsImplMatch g dispatchSlot overrideBy)
-                                |> List.length
+                                |> isNilOrSingleton
+                                |> not
                            
-                            if possibleDispatchSlots > 1 then
+                            if moreThanOnePossibleDispatchSlot then
                                 // Error will be reported below in CheckOverridesAreAllUsedOnce 
                                 ()
 

src/fsharp/NicePrint.fs

@@ -1468,7 +1468,7 @@ module private TastDefinitionPrinting =
     let breakTypeDefnEqn repr =
         match repr with 
         | TFSharpObjectRepr _ -> true
-        | TUnionRepr r    -> r.CasesTable.UnionCasesAsList.Length > 1
+        | TUnionRepr r -> not (isNilOrSingleton r.CasesTable.UnionCasesAsList)
         | TRecdRepr _ -> true
         | TAsmRepr _ 
         | TILObjectRepr _  

src/fsharp/TastOps.fs

@@ -3342,7 +3342,7 @@ module DebugPrint = begin
             | argtys -> (prefixL ^^ nmL ^^ wordL(tagText "of")) --- layoutUnionCaseArgTypes argtys
 
         let layoutUnionCases ucases =
-            let prefixL = if List.length ucases > 1 then wordL(tagText "|") else emptyL
+            let prefixL = if not (isNilOrSingleton ucases) then wordL(tagText "|") else emptyL
             List.map (ucaseL prefixL) ucases
             
         let layoutRecdField (fld:RecdField) =
@@ -7457,7 +7457,7 @@ let mkChoiceTy (g:TcGlobals) m tinst =
      match List.length tinst with 
      | 0 -> g.unit_ty
      | 1 -> List.head tinst
-     | _ -> mkAppTy (mkChoiceTyconRef g m (List.length tinst)) tinst
+     | length -> mkAppTy (mkChoiceTyconRef g m length) tinst
 
 let mkChoiceCaseRef g m n i = 
      mkUnionCaseRef (mkChoiceTyconRef g m n) ("Choice"+string (i+1)+"Of"+string n)
@@ -8004,7 +8004,7 @@ let rec mkCompiledTuple g isStruct (argtys,args,m) =
     elif n < maxTuple then (mkCompiledTupleTyconRef g isStruct n, argtys, args, m)
     else
         let argtysA,argtysB = List.splitAfter goodTupleFields argtys
-        let argsA,argsB = List.splitAfter (goodTupleFields) args
+        let argsA,argsB = List.splitAfter goodTupleFields args
         let ty8, v8 = 
             match argtysB,argsB with 
             | [ty8],[arg8] -> 

src/fsharp/TypeChecker.fs

@@ -701,7 +701,7 @@ let UnifyRefTupleType contextInfo cenv denv m ty ps =
     let ptys = 
         if isRefTupleTy cenv.g ty then 
             let ptys = destRefTupleTy cenv.g ty
-            if (List.length ps) = (List.length ptys) then ptys 
+            if List.length ps = List.length ptys then ptys 
             else NewInferenceTypes ps
         else NewInferenceTypes ps
 
@@ -719,7 +719,7 @@ let UnifyStructTupleType contextInfo cenv denv m ty ps =
     let ptys = 
         if isStructTupleTy cenv.g ty then 
             let ptys = destStructTupleTy cenv.g ty
-            if (List.length ps) = (List.length ptys) then ptys 
+            if List.length ps = List.length ptys then ptys 
             else NewInferenceTypes ps
         else NewInferenceTypes ps
     AddCxTypeEqualsType contextInfo denv cenv.css m ty (TType_tuple (tupInfoStruct, ptys))
@@ -2026,8 +2026,9 @@ let TcUnionCaseOrExnField cenv (env: TcEnv) ty1 m c n funcs =
       | (Item.UnionCase _ | Item.ExnCase _) as item ->
         ApplyUnionCaseOrExn funcs m cenv env ty1 item
       | _ -> error(Error(FSComp.SR.tcUnknownUnion(),m))
-    if n >= List.length argtys then 
-      error (UnionCaseWrongNumberOfArgs(env.DisplayEnv,List.length argtys,n,m))
+    let argstysLength = List.length argtys
+    if n >= argstysLength then
+      error (UnionCaseWrongNumberOfArgs(env.DisplayEnv,argstysLength,n,m))
     let ty2 = List.item n argtys
     mkf,ty2
 
@@ -5562,7 +5563,7 @@ and TcExprThen cenv overallTy env tpenv synExpr delayed =
             PropagateThenTcDelayed cenv overallTy env tpenv synExpr.Range (MakeApplicableExprNoFlex cenv expr) exprty ExprAtomicFlag.NonAtomic delayed
 
 and TcExprs cenv env m tpenv flexes argtys args = 
-    if (List.length args  <> List.length argtys) then error(Error(FSComp.SR.tcExpressionCountMisMatch((List.length argtys), (List.length args)),m))
+    if List.length args <> List.length argtys then error(Error(FSComp.SR.tcExpressionCountMisMatch((List.length argtys), (List.length args)),m))
     (tpenv, List.zip3 flexes argtys args) ||> List.mapFold (fun tpenv (flex,ty,e) -> 
          TcExprFlex cenv flex ty env tpenv e)
 
@@ -9948,7 +9949,7 @@ and TcMethodArg  cenv env  (lambdaPropagationInfo,tpenv) (lambdaPropagationInfoF
                         if lambdaVarNum < numLambdaVars then
                             let col = [ for row in prefixOfLambdaArgsForEachOverload -> row.[lambdaVarNum] ]
                             // Check if all the rows give the same argument type
-                            if col |> ListSet.setify (typeEquiv cenv.g) |> List.length |> ((=) 1) then 
+                            if col |> ListSet.setify (typeEquiv cenv.g) |> isSingleton then 
                                 let calledLambdaArgTy = col.[0]
                                 // Force the caller to be a function type. 
                                 match UnifyFunctionTypeUndoIfFailed cenv env.DisplayEnv mArg callerLambdaTy with 
@@ -10786,7 +10787,7 @@ and ApplyAbstractSlotInference (cenv:cenv) (envinner:TcEnv) (bindingTy,m,synTypa
 
                  | slots -> 
                      match dispatchSlotsArityMatch with 
-                     | meths when meths |> makeUniqueBySig |> List.length = 1 -> meths
+                     | meths when meths |> makeUniqueBySig |> isSingleton -> meths
                      | [] -> 
                          let details =
                              slots
@@ -14182,8 +14183,8 @@ module TcExceptionDeclarations =
               match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.eNameResEnv TypeNameResolutionInfo.Default longId with
               | Item.ExnCase exnc, [] -> 
                   CheckTyconAccessible cenv.amap m env.eAccessRights exnc |> ignore
-                  if List.length args' <> 0 then 
-                    errorR (Error(FSComp.SR.tcExceptionAbbreviationsShouldNotHaveArgumentList(),m))
+                  if not (isNil args') then 
+                      errorR (Error(FSComp.SR.tcExceptionAbbreviationsShouldNotHaveArgumentList(),m))
                   TExnAbbrevRepr exnc
               | Item.CtorGroup(_,meths) , [] -> 
                   // REVIEW: check this really is an exception type 

src/fsharp/TypeRelations.fs

@@ -285,7 +285,7 @@ let IteratedAdjustArityOfLambda g amap topValInfo e =
     let tps,ctorThisValOpt,baseValOpt,vsl,body,bodyty = destTopLambda g amap topValInfo (e, tyOfExpr g e)
     let arities = topValInfo.AritiesOfArgs
     if arities.Length <> vsl.Length then 
-        errorR(InternalError(sprintf "IteratedAdjustArityOfLambda, List.length arities = %d, List.length vsl = %d" (List.length arities) (List.length vsl), body.Range))
+        errorR(InternalError(sprintf "IteratedAdjustArityOfLambda, List.length arities = %d, List.length vsl = %d" arities.Length vsl.Length, body.Range))
     let vsl,body = IteratedAdjustArityOfLambdaBody g arities vsl body
     tps,ctorThisValOpt,baseValOpt,vsl,body,bodyty
 

src/fsharp/fsc.fs

@@ -247,7 +247,7 @@ let ProcessCommandLineFlags (tcConfigB: TcConfigBuilder, setProcessThreadLocals,
     ParseCompilerOptions (collect, GetCoreFscCompilerOptions tcConfigB, List.tail (PostProcessCompilerArgs abbrevArgs argv))
 
     if not (tcConfigB.portablePDB || tcConfigB.embeddedPDB) then
-        if tcConfigB.embedAllSource || (tcConfigB.embedSourceList |> List.length <> 0) then
+        if tcConfigB.embedAllSource || (tcConfigB.embedSourceList |> isNil |> not) then
             error(Error(FSComp.SR.optsEmbeddedSourceRequirePortablePDBs(), rangeCmdArgs))
         if not (String.IsNullOrEmpty(tcConfigB.sourceLink)) then
             error(Error(FSComp.SR.optsSourceLinkRequirePortablePDBs(), rangeCmdArgs))

src/fsharp/pars.fsy

@@ -734,15 +734,15 @@ moduleSpfn:
       { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2))
         let isRec, path, xml, vis = $3 
         if isRec then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsInvalidUseOfRec())
-        if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleAbbreviationMustBeSimpleName())
-        if List.length $1 <> 0   then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreAttributesOnModuleAbbreviation())
+        if not (isSingleton path) then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleAbbreviationMustBeSimpleName())
+        if not (isNil $1) then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreAttributesOnModuleAbbreviation())
         match vis with
         | Some vis -> raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreVisibilityOnModuleAbbreviationAlwaysPrivate(vis.ToString()))
         | _ -> SynModuleSigDecl.ModuleAbbrev(List.head path,$5,rhs2 parseState 3 5) } 
 
   | opt_attributes opt_declVisibility  moduleIntro colonOrEquals moduleSpecBlock
       { let isRec, path, xml, vis = $3 
-        if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleDefnMustBeSimpleName())
+        if not (isSingleton path) then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleDefnMustBeSimpleName())
         if isRec then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsInvalidUseOfRec())
         let info = ComponentInfo($1,[],[],path,xml,false,vis,rhs parseState 3)
         if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2))
@@ -1238,14 +1238,14 @@ moduleDefn:
         | Choice1Of2 eqn -> 
             if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(),rhs parseState 2))
             if isRec then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsInvalidUseOfRec())
-            if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleAbbreviationMustBeSimpleName())
-            if List.length $1 <> 0   then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreAttributesOnModuleAbbreviation())
+            if not (isSingleton path) then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleAbbreviationMustBeSimpleName())
+            if not (isNil $1) then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreAttributesOnModuleAbbreviation())
             match vis with
             | Some vis -> raiseParseErrorAt (rhs parseState 1) (FSComp.SR.parsIgnoreAttributesOnModuleAbbreviationAlwaysPrivate(vis.ToString()))
             | _ -> ()
             [ SynModuleDecl.ModuleAbbrev(List.head path,eqn,(rhs parseState 3, eqn) ||> unionRangeWithListBy (fun id -> id.idRange) ) ]
         | Choice2Of2 def -> 
-            if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleAbbreviationMustBeSimpleName())
+            if not (isSingleton path) then raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsModuleAbbreviationMustBeSimpleName())
             let info = ComponentInfo(attribs,[],[],path,xml,false,vis,rhs parseState 3)
             [ SynModuleDecl.NestedModule(info, isRec, def, false,(rhs2 parseState 3 4, def) ||> unionRangeWithListBy (fun d -> d.Range) ) ] }
 
@@ -1706,7 +1706,10 @@ memberCore:
                    let memFlags = memFlagsBuilder memberKind
 
                    let valSynInfo = 
-                       let adjustValueArg valueArg = if List.length valueArg = 1 then valueArg else SynInfo.unnamedTopArg
+                       let adjustValueArg valueArg = 
+                           match valueArg with
+                           | [_] -> valueArg
+                           | _ -> SynInfo.unnamedTopArg
 
                        match memberKind, valSynInfo, memFlags.IsInstance with 
                        | MemberKind.PropertyGet,SynValInfo ([],_ret),         false
@@ -2375,9 +2378,9 @@ defnBindings:
         BindingSetPreAttrs(mLetKwd,isRec,isUse,
             (fun attrs vis -> 
                 // apply the builder
-                let binds = localBindingsBuilder attrs vis mLetKwd 
-                if not isRec && List.length binds > 1 then 
-                      reportParseErrorAt mLetKwd (FSComp.SR.parsLetAndForNonRecBindings()) 
+                let binds = localBindingsBuilder attrs vis mLetKwd
+                if not isRec && not (isNilOrSingleton binds) then 
+                      reportParseErrorAt mLetKwd (FSComp.SR.parsLetAndForNonRecBindings())
                 [],binds), 
             bindingSetRange) }
 
@@ -2414,10 +2417,10 @@ hardwhiteLetBindings:
 
         // the first binding swallow any attributes prior to the 'let' 
         BindingSetPreAttrs(mLetKwd,isRec,isUse,
-          (fun attrs vis -> 
-            let binds = localBindingsBuilder attrs vis mLetKwd 
-            if not isRec && List.length binds > 1 then 
-                    reportParseErrorAt mLetKwd (FSComp.SR.parsLetAndForNonRecBindings()) 
+          (fun attrs vis ->
+            let binds = localBindingsBuilder attrs vis mLetKwd
+            if not isRec && not (isNilOrSingleton binds) then
+                reportParseErrorAt mLetKwd (FSComp.SR.parsLetAndForNonRecBindings())
             [],binds),
           bindingSetRange), (unionRanges mLetKwd bindingSetRange) }
 
@@ -2823,7 +2826,7 @@ atomicPattern:
       { SynPat.OptionalVal($2,lhs parseState) } 
   | atomicPatternLongIdent %prec prec_atompat_pathop 
       { let vis,lidwd = $1 
-        if List.length lidwd.Lid > 1 || (let c = (List.head lidwd.Lid).idText.[0] in Char.IsUpper(c) && not (Char.IsLower c)) 
+        if not (isNilOrSingleton lidwd.Lid) || (let c = (List.head lidwd.Lid).idText.[0] in Char.IsUpper(c) && not (Char.IsLower c)) 
         then mkSynPatMaybeVar lidwd vis (lhs parseState)
         else mkSynPatVar vis (List.head lidwd.Lid) }
   | constant